chiark / gitweb /
Test suite: Fix entirely-broken tstunt PERLLIB arrangements
[dgit.git] / tests / tstunt / Dpkg / Changelog / Parse.pm
1 # -*- perl -*-
2 #
3 # Copyright (C) 2015-2016  Ian Jackson
4 #
5 # Some bits stolen from the proper Dpkg::Changelog::Parse
6 # (from dpkg-dev 1.16.16):
7 #
8 # Copyright (C) 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
9 # Copyright (C) 2009       Raphael Hertzog <hertzog@debian.org>
10 #
11 #    This program is free software; you can redistribute it and/or modify
12 #    it under the terms of the GNU General Public License as published by
13 #    the Free Software Foundation; either version 3 of the License, or
14 #    (at your option) any later version.
15 #
16 #    This program is distributed in the hope that it will be useful,
17 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
18 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 #    GNU General Public License for more details.
20 #
21 #    You should have received a copy of the GNU General Public License
22 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
23
24 package Dpkg::Changelog::Parse;
25
26 use strict;
27 use warnings;
28
29 our $VERSION = "1.00";
30
31 use Dpkg::Control::Changelog;
32
33 use base qw(Exporter);
34 our @EXPORT = qw(changelog_parse);
35
36 die +(join " ", %ENV)." ?" if $ENV{'DGIT_NO_TSTUNT_CLPARSE'};
37
38 sub changelog_parse {
39     my (%options) = @_; # largely ignored
40
41 #use Data::Dumper;
42 #print STDERR "CLOG PARSE ", Dumper(\%options);
43 #
44 # We can't do this because lots of things use `since' which
45 # we don't implement, and it's the test cases that arrange that
46 # the since value happens to be such that we are to print one output.
47 #
48 #    foreach my $k (keys %options) {
49 #       my $v = $options{$k};
50 #       if ($k eq 'file') { }
51 #       elsif ($k eq 'offset') { die "$v ?" unless $v <= 1; } # wtf, 1==0 ?
52 #       elsif ($k eq 'count') { die "$v ?" unless $v == 1; }
53 #       else { die "$k ?"; }
54 #    }
55
56     $options{'file'} //= 'debian/changelog';
57
58     open P, "dpkg-parsechangelog -l$options{'file'} |" or die $!;
59
60     my $fields = Dpkg::Control::Changelog->new();
61     $fields->parse(\*P, "output of stunt changelog parser");
62
63     close P or die "$! $?";
64
65     return $fields;
66 }
67
68 1;