Dpkg::Changelog: completely update the API

The previous API was too different from the other modules inside dpkg-dev.

Dpkg::Changelog now behaves as an array of Dpkg::Changelog::Entry
and the documentation explains how it can be derived to create a new
changelog parser.

The non-regression tests as well as the official Debian
changelog parser script had to be updated to cope with the new API.

scripts/Dpkg/Changelog.pm

@@ -1,6 +1,3 @@
-#
-# Dpkg::Changelog
-#
 # Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
 # Copyright © 2009       Raphaël Hertzog <hertzog@debian.org>
 #
@@ -21,13 +18,16 @@
 
 =head1 NAME
 
-Dpkg::Changelog
+Dpkg::Changelog - base class to implement a changelog parser
 
 =head1 DESCRIPTION
 
-FIXME: to be written
+Dpkg::Changelog is a class representing a changelog file
+as an array of changelog entries (Dpkg::Changelog::Entry).
+By deriving this object and implementing its parse method, you
+add the ability to fill this object with changelog entries.
 
-=head2 Functions
+=head2 FUNCTIONS
 
 =cut
 
@@ -39,90 +39,102 @@ use warnings;
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(:DEFAULT report);
+use Dpkg::Control;
 use Dpkg::Control::Changelog;
 use Dpkg::Control::Fields;
+use Dpkg::Index;
 use Dpkg::Version;
 use Dpkg::Vendor qw(run_vendor_hook);
 
-use base qw(Exporter);
+use overload
+    '""'  => sub { return $_[0]->output() },
+    '@{}' => sub { return $_[0]->{data} };
+
+=over 4
+
+=item my $c = Dpkg::Changelog->new(%options)
 
-our %EXPORT_TAGS = ( 'util' => [ qw(
-                data2rfc822
-                data2rfc822_mult
-                get_dpkg_changes
-) ] );
-our @EXPORT_OK = @{$EXPORT_TAGS{util}};
+Creates a new changelog object.
 
-=pod
+=cut
 
-=head3 init
+sub new {
+    my ($this, %opts) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	verbose => 1,
+	parse_errors => []
+    };
+    bless $self, $class;
+    $self->set_options(%opts);
+    return $self;
+}
 
-Creates a new object instance. Takes a reference to a hash as
-optional argument, which is interpreted as configuration options.
-There are currently no supported general configuration options, but
-see the other methods for more specific configuration options which
-can also specified to C<init>.
+=item $c->load($filename)
 
-If C<infile>, C<inhandle>, or C<instring> are specified, C<parse()>
-is called from C<init>. If a fatal error is encountered during parsing
-(e.g. the file can't be opened), C<init> will not return a
-valid object but C<undef>!
+Parse $filename as a changelog.
 
 =cut
 
-sub init {
-    my $classname = shift;
-    my $config = shift || {};
-    my $self = {};
-    bless( $self, $classname );
+sub load {
+    my ($self, $file) = @_;
+    open(my $fh, "<", $file) or syserr(_g("cannot read %s"), $file);
+    my $ret = $self->parse($fh, $file);
+    close($fh);
+    return $ret;
+}
 
-    $config->{verbose} = 1 if $config->{debug};
-    $self->{config} = $config;
+=item $c->set_options(%opts)
 
-    $self->reset_parse_errors;
+Change the value of some options. "verbose" (defaults to 1) defines
+whether parse errors are displayed as warnings by default. "reportfile"
+is a string to use instead of the name of the file parsed, in particular
+in error messages. "range" defines the range of entries that we want to
+parse, the parser will stop as soon as it has parsed enough data to
+satisfy $c->get_range($opts{'range'}).
 
-    if ($self->{config}{infile}
-	|| $self->{config}{inhandle}
-	|| $self->{config}{instring}) {
-	defined($self->parse) or return undef;
-    }
+=cut
 
-    return $self;
+sub set_options {
+    my ($self, %opts) = @_;
+    $self->{$_} = $opts{$_} foreach keys %opts;
 }
 
-=pod
-
-=head3 reset_parse_errors
+=item $c->reset_parse_errors()
 
 Can be used to delete all information about errors ocurred during
-previous L<parse> runs. Note that C<parse()> also calls this method.
+previous L<parse> runs.
 
 =cut
 
 sub reset_parse_errors {
     my ($self) = @_;
-
-    $self->{errors}{parser} = [];
+    $self->{parse_errors} = [];
 }
 
-sub _do_parse_error {
+=item $c->parse_error($line_nr, $error, [$line])
+
+Record a new parse error at line $line_nr. The error message is specified
+with $error and a copy of the line can be recorded in $line.
+
+=cut
+
+sub parse_error {
     my ($self, $file, $line_nr, $error, $line) = @_;
     shift;
 
-    push @{$self->{errors}{parser}}, [ @_ ];
+    push @{$self->{parse_errors}}, [ @_ ];
 
-    unless ($self->{config}{quiet}) {
+    if ($self->{verbose}) {
 	if ($line) {
-	    warning("%20s(l$.): $error\nLINE: $line", $file);
+	    warning("%20s(l$line_nr): $error\nLINE: $line", $file);
 	} else {
-	    warning("%20s(l$.): $error", $file);
+	    warning("%20s(l$line_nr): $error", $file);
 	}
     }
 }
 
-=pod
-
-=head3 get_parse_errors
+=item $c->get_parse_errors()
 
 Returns all error messages from the last L<parse> run.
 If called in scalar context returns a human readable
@@ -133,10 +145,8 @@ an array of arrays. Each of these arrays contains
 
 =item 1.
 
-the filename of the parsed file or C<FileHandle> or C<String>
-if the input came from a file handle or a string. If the
-reportfile configuration option was given, its value will be
-used instead
+a string describing the origin of the data (a filename usually). If the
+reportfile configuration option was given, its value will be used instead.
 
 =item 2.
 
@@ -152,19 +162,16 @@ the original line
 
 =back
 
-NOTE: This format isn't stable yet and may change in later versions
-of this module.
-
 =cut
 
 sub get_parse_errors {
     my ($self) = @_;
 
     if (wantarray) {
-	return @{$self->{errors}{parser}};
+	return @{$self->{parse_errors}};
     } else {
 	my $res = "";
-	foreach my $e (@{$self->{errors}{parser}}) {
+	foreach my $e (@{$self->{parse_errors}}) {
 	    if ($e->[3]) {
 		$res .= report(_g('warning'),_g("%s(l%s): %s\nLINE: %s"), @$e );
 	    } else {
@@ -175,74 +182,72 @@ sub get_parse_errors {
     }
 }
 
-sub _do_fatal_error {
-    my ($self, $msg, @msg) = @_;
-
-    $self->{errors}{fatal} = report(_g('fatal error'), $msg, @msg);
-    warning($msg, @msg) unless $self->{config}{quiet};
-}
+=item $c->set_unparsed_tail($tail)
 
-=pod
+Add a string representing unparsed lines after the changelog entries.
+Use undef as $tail to remove the unparsed lines currently set.
 
-=head3 get_error
+=item $c->get_unparsed_tail()
 
-Get the last non-parser error (e.g. the file to parse couldn't be opened).
+Return a string representing the unparsed lines after the changelog
+entries. Returns undef if there's no such thing.
 
 =cut
 
-sub get_error {
-    my ($self) = @_;
+sub set_unparsed_tail {
+    my ($self, $tail) = @_;
+    $self->{'unparsed_tail'} = $tail;
+}
 
-    return $self->{errors}{fatal};
+sub get_unparsed_tail {
+    my ($self) = @_;
+    return $self->{'unparsed_tail'};
 }
 
-=pod
+=item @{$c}
 
-=head3 data
+Returns all the Dpkg::Changelog::Entry objects contained in this changelog
+in the order in which they have been parsed.
 
-C<data> returns an array (if called in list context) or a reference
-to an array of Dpkg::Changelog::Entry objects which each
-represent one entry of the changelog.
+=item $c->get_range($range)
 
-This method supports the common output options described in
-section L<"COMMON OUTPUT OPTIONS">.
+Returns an array (if called in list context) or a reference to an array of
+Dpkg::Changelog::Entry objects which each represent one entry of the
+changelog. $range is a hash reference describing the range of entries
+to return. See section L<"RANGE SELECTION">.
 
 =cut
 
-sub data {
-    my ($self, $config) = @_;
-
+sub __sanity_check_range {
+    my ($self, $r) = @_;
     my $data = $self->{data};
-    if ($config) {
-	$self->{config}{DATA} = $config if $config;
-	$data = $self->_data_range( $config ) or return undef;
-    }
-    return @$data if wantarray;
-    return $data;
-}
 
-sub __sanity_check_range {
-    my ( $data, $from, $to, $since, $until, $start, $end ) = @_;
+    if (defined($r->{offset}) and not defined($r->{count})) {
+	warning(_g("'offset' without 'count' has no effect")) if $self->{verbose};
+	delete $r->{offset};
+    }
 
-    if (($$start || $$end) &&
-        (length($$from) || length($$since) || length($$to) || length($$until)))
+    if ((defined($r->{count}) || defined($r->{offset})) &&
+        (defined($r->{from}) || defined($r->{since}) ||
+	 defined($r->{to}) || defined($r->{'until'})))
     {
-	warning(_g( "you can't combine 'count' or 'offset' with any other range option" ));
-	$$from = $$since = $$to = $$until = '';
+	warning(_g("you can't combine 'count' or 'offset' with any other " .
+		   "range option")) if $self->{verbose};
+	delete $r->{from};
+	delete $r->{since};
+	delete $r->{to};
+	delete $r->{'until'};
     }
-    if (length($$from) && length($$since)) {
-	warning(_g( "you can only specify one of 'from' and 'since', using 'since'" ));
-	$$from = '';
+    if (defined($r->{from}) && defined($r->{since})) {
+	warning(_g("you can only specify one of 'from' and 'since', using " .
+		   "'since'")) if $self->{verbose};
+	delete $r->{from};
     }
-    if (length($$to) && length($$until)) {
-	warning(_g( "you can only specify one of 'to' and 'until', using 'until'" ));
-	$$to = '';
+    if (defined($r->{to}) && defined($r->{'until'})) {
+	warning(_g("you can only specify one of 'to' and 'until', using " .
+		   "'until'")) if $self->{verbose};
+	delete $r->{to};
     }
-    $$start = 0 if $$start < 0;
-    return if $$start > $#$data;
-    $$end = $#$data if $$end > $#$data;
-    return if $$end < 0;
-    $$end = $$start if $$end < $$start;
 
     # Handle non-existing versions
     my (%versions, @versions);
@@ -250,198 +255,217 @@ sub __sanity_check_range {
         $versions{$entry->get_version()->as_string()} = 1;
         push @versions, $entry->get_version()->as_string();
     }
-    if ((length($$since) and not exists $versions{$$since})) {
+    if ((defined($r->{since}) and not exists $versions{$r->{since}})) {
         warning(_g("'%s' option specifies non-existing version"), "since");
         warning(_g("use newest entry that is smaller than the one specified"));
         foreach my $v (@versions) {
-            if (version_compare_relation($v, REL_LT, $$since)) {
-                $$since = $v;
+            if (version_compare_relation($v, REL_LT, $r->{since})) {
+                $r->{since} = $v;
                 last;
             }
         }
-        if (not exists $versions{$$since}) {
+        if (not exists $versions{$r->{since}}) {
             # No version was smaller, include all
             warning(_g("none found, starting from the oldest entry"));
-            $$since = '';
-            $$from = $versions[-1];
+            delete $r->{since};
+            $r->{from} = $versions[-1];
         }
     }
-    if ((length($$from) and not exists $versions{$$from})) {
+    if ((defined($r->{from}) and not exists $versions{$r->{from}})) {
         warning(_g("'%s' option specifies non-existing version"), "from");
         warning(_g("use oldest entry that is bigger than the one specified"));
         my $oldest;
         foreach my $v (@versions) {
-            if (version_compare_relation($v, REL_GT, $$from)) {
+            if (version_compare_relation($v, REL_GT, $r->{from})) {
                 $oldest = $v;
             }
         }
         if (defined($oldest)) {
-            $$from = $oldest;
+            $r->{from} = $oldest;
         } else {
             warning(_g("no such entry found, ignoring '%s' parameter"), "from");
-            $$from = ''; # No version was bigger
+            delete $r->{from}; # No version was bigger
         }
     }
-    if ((length($$until) and not exists $versions{$$until})) {
+    if (defined($r->{'until'}) and not exists $versions{$r->{'until'}}) {
         warning(_g("'%s' option specifies non-existing version"), "until");
         warning(_g("use oldest entry that is bigger than the one specified"));
         my $oldest;
         foreach my $v (@versions) {
-            if (version_compare_relation($v, REL_GT, $$until)) {
+            if (version_compare_relation($v, REL_GT, $r->{'until'})) {
                 $oldest = $v;
             }
         }
         if (defined($oldest)) {
-            $$until = $oldest;
+            $r->{'until'} = $oldest;
         } else {
             warning(_g("no such entry found, ignoring '%s' parameter"), "until");
-            $$until = ''; # No version was bigger
+            delete $r->{'until'}; # No version was bigger
         }
     }
-    if ((length($$to) and not exists $versions{$$to})) {
+    if (defined($r->{to}) and not exists $versions{$r->{to}}) {
         warning(_g("'%s' option specifies non-existing version"), "to");
         warning(_g("use newest entry that is smaller than the one specified"));
         foreach my $v (@versions) {
-            if (version_compare_relation($v, REL_LT, $$to)) {
-                $$to = $v;
+            if (version_compare_relation($v, REL_LT, $r->{to})) {
+                $r->{to} = $v;
                 last;
             }
         }
-        if (not exists $versions{$$to}) {
+        if (not exists $versions{$r->{to}}) {
             # No version was smaller
             warning(_g("no such entry found, ignoring '%s' parameter"), "to");
-            $$to = '';
+            delete $r->{to};
         }
     }
 
-    if (length($$since) && ($data->[0]->get_version() eq $$since)) {
-	warning(_g( "'since' option specifies most recent version, ignoring" ));
-	$$since = '';
+    if (defined($r->{since}) and $data->[0]->get_version() eq $r->{since}) {
+	warning(_g("'since' option specifies most recent version, ignoring"));
+	delete $r->{since};
     }
-    if (length($$until) && ($data->[$#{$data}]->get_version() eq $$until)) {
-	warning(_g( "'until' option specifies oldest version, ignoring" ));
-	$$until = '';
+    if (defined($r->{'until'}) and $data->[-1]->get_version() eq $r->{'until'}) {
+	warning(_g("'until' option specifies oldest version, ignoring"));
+	delete $r->{'until'};
     }
-    return 1;
 }
 
-sub _data_range {
-    my ($self, $config) = @_;
+sub get_range {
+    my ($self, $range) = @_;
+    $range = {} unless defined $range;
+    my $res = $self->_data_range($range);
+    return undef unless defined $res;
+    return @$res if wantarray;
+    return $res;
+}
 
-    my $data = $self->data or return undef;
+sub _data_range {
+    my ($self, $range) = @_;
 
-    return [ @$data ] if $config->{all};
+    my $data = $self->{data} or return undef;
 
-    my ($since, $until, $from, $to, $count, $offset) = ('', '', '', '', 0, 0);
-    $since = $config->{since} if defined($config->{since});
-    $until = $config->{until} if defined($config->{until});
-    $from = $config->{from} if defined($config->{from});
-    $to = $config->{to} if defined($config->{to});
-    $count = $config->{count} if defined($config->{count});
-    $offset = $config->{offset} if defined($config->{offset});
+    return [ @$data ] if $range->{all};
 
-    return if $offset and not $count;
-    if ($offset > 0) {
-	$offset -= ($count < 0);
-    } elsif ($offset < 0) {
-	$offset = $#$data + ($count > 0) + $offset;
-    } else {
-	$offset = $#$data if $count < 0;
+    unless (grep { m/^(since|until|from|to|count|offset)$/ } keys %$range) {
+	return [ @$data ];
     }
-    my $start = my $end = $offset;
-    $start += $count+1 if $count < 0;
-    $end += $count-1 if $count > 0;
-
-    return unless __sanity_check_range( $data, \$from, \$to,
-					\$since, \$until,
-					\$start, \$end );
 
-
-    unless (length($from) or length($to) or length($since) or length($until)
-            or $start or $end)
-    {
-	return [ @$data ] if $config->{default_all} and not $count;
-	return [ $data->[0] ];
+    $self->__sanity_check_range($range);
+
+    my ($start, $end);
+    if (defined($range->{count})) {
+	my $offset = $range->{offset} || 0;
+	my $count = $range->{count};
+	# Convert count/offset in start/end
+	if ($offset > 0) {
+	    $offset -= ($count < 0);
+	} elsif ($offset < 0) {
+	    $offset = $#$data + ($count > 0) + $offset;
+	} else {
+	    $offset = $#$data if $count < 0;
+	}
+	$start = $end = $offset;
+	$start += $count+1 if $count < 0;
+	$end += $count-1 if $count > 0;
+	# Check limits
+	$start = 0 if $start < 0;
+	return if $start > $#$data;
+	$end = $#$data if $end > $#$data;
+	return if $end < 0;
+	$end = $start if $end < $start;
+	return [ @{$data}[$start .. $end] ];
     }
 
-    return [ @{$data}[$start .. $end] ] if $start or $end;
-
     my @result;
-
     my $include = 1;
-    $include = 0 if length($to) or length($until);
+    $include = 0 if defined($range->{to}) or defined($range->{'until'});
     foreach (@$data) {
 	my $v = $_->get_version();
-	$include = 1 if $to and $v eq $to;
-	last if $since and $v eq $since;
+	$include = 1 if defined($range->{to}) and $v eq $range->{to};
+	last if defined($range->{since}) and $v eq $range->{since};
 
 	push @result, $_ if $include;
 
-	$include = 1 if $until and $v eq $until;
-	last if $from and $v eq $from;
+	$include = 1 if defined($range->{'until'}) and $v eq $range->{'until'};
+	last if defined($range->{from}) and $v eq $range->{from};
     }
 
     return \@result if scalar(@result);
     return undef;
 }
 
-sub _abort_early {
-    my ($self) = @_;
+=item $c->abort_early()
 
-    my $data = $self->data or return;
-    my $config = $self->{config} or return;
+Returns true if enough data have been parsed to be able to return all
+entries selected by the range set at creation (or with set_options).
 
-#    use Data::Dumper;
-#    warn "Abort early? (\$# = $#$data)\n".Dumper($config);
+=cut
 
-    return if $config->{all};
+sub abort_early {
+    my ($self) = @_;
 
-    my ($since, $until, $from, $to, $count, $offset) = ('', '', '', '', 0, 0);
-    $since = $config->{since} if defined($config->{since});
-    $until = $config->{until} if defined($config->{until});
-    $from = $config->{from} if defined($config->{from});
-    $to = $config->{to} if defined($config->{to});
-    $count = $config->{count} if defined($config->{count});
-    $offset = $config->{offset} if defined($config->{offset});
+    my $data = $self->{data} or return;
+    my $r = $self->{range} or return;
+    my $count = $r->{count} || 0;
+    my $offset = $r->{offset} || 0;
 
-    return if $offset and not $count;
+    return if $r->{all};
+    return unless grep { m/^(since|until|from|to|count|offset)$/ } keys %$r;
     return if $offset < 0 or $count < 0;
-    if ($offset > 0) {
-	$offset -= ($count < 0);
-    }
-    my $start = my $end = $offset;
-    $end += $count-1 if $count > 0;
-
-    unless (length($from) or length($to) or length($since) or length($until)
-            or $start or $end)
-    {
-	return if not $count;
-	return 1 if @$data;
+    if (defined($r->{count})) {
+	if ($offset > 0) {
+	    $offset -= ($count < 0);
+	}
+	my $start = my $end = $offset;
+	$end += $count-1 if $count > 0;
+	return ($start < @$data and $end < @$data);
     }
 
-    return 1 if ($start or $end)
-	and $start < @$data and $end < @$data;
-
-    return unless length($since) or length($from);
+    return unless defined($r->{since}) or defined($r->{from});
     foreach (@$data) {
 	my $v = $_->get_version();
-
-	return 1 if $v eq $since;
-	return 1 if $v eq $from;
+	return 1 if defined($r->{since}) and $v eq $r->{since};
+	return 1 if defined($r->{from}) and $v eq $r->{from};
     }
 
     return;
 }
 
-=pod
+=item $c->output()
+
+=item "$c"
+
+Returns a string representation of the changelog (it's a concatenation of
+the string representation of the individual changelog entries).
+
+=item $c->output($fh)
+
+Output the changelog to the given filehandle.
+
+=cut
+
+sub output {
+    my ($self, $fh) = @_;
+    my $str = "";
+    foreach my $entry (@{$self}) {
+	my $text = $entry->output();
+	print $fh $text if defined $fh;
+	$str .= $text if defined wantarray;
+    }
+    my $text = $self->get_unparsed_tail();
+    if (defined $text) {
+	print $fh $text if defined $fh;
+	$str .= $text if defined wantarray;
+    }
+    return $str;
+}
 
-=head3 dpkg
+=item my $control = $c->dpkg($range)
 
-(and B<dpkg_str>)
+Returns a Dpkg::Control::Changelog object representing the entries selected
+by the optional range specifier (see L<"RANGE SELECTION"> for details).
+Returns undef in no entries are matched.
 
-C<dpkg> returns a hash (in list context) or a hash reference
-(in scalar context) where the keys are field names and the values are
-field values. The following fields are given:
+The following fields are contained in the object:
 
 =over 4
 
@@ -479,16 +503,6 @@ content of the the entry/entries
 
 =back
 
-C<dpkg_str> returns a stringified version of this hash. The fields are
-ordered like in the list above.
-
-Both methods support the common output options described in
-section L<"COMMON OUTPUT OPTIONS">.
-
-=head3 dpkg_str
-
-See L<dpkg>.
-
 =cut
 
 our ( @URGENCIES, %URGENCIES );
@@ -499,24 +513,22 @@ BEGIN {
 }
 
 sub dpkg {
-    my ($self, $config) = @_;
+    my ($self, $range) = @_;
 
-    $self->{config}{DPKG} = $config if $config;
-
-    $config = $self->{config}{DPKG} || {};
-    my $data = $self->_data_range( $config ) or return undef;
+    my @data = $self->get_range($range) or return undef;
+    my $entry = shift @data;
 
     my $f = Dpkg::Control::Changelog->new();
-    $f->{Urgency} = $data->[0]->get_urgency() || "unknown";
-    $f->{Source} = $data->[0]->get_source() || "unknown";
-    $f->{Version} = $data->[0]->get_version() || "unknown";
-    $f->{Distribution} = join(" ", $data->[0]->get_distributions());
-    $f->{Maintainer} = $data->[0]->get_maintainer() || '';
-    $f->{Date} = $data->[0]->get_timestamp() || '';
-    $f->{Changes} = get_dpkg_changes($data->[0]);
+    $f->{Urgency} = $entry->get_urgency() || "unknown";
+    $f->{Source} = $entry->get_source() || "unknown";
+    $f->{Version} = $entry->get_version() || "unknown";
+    $f->{Distribution} = join(" ", $entry->get_distributions());
+    $f->{Maintainer} = $entry->get_maintainer() || '';
+    $f->{Date} = $entry->get_timestamp() || '';
+    $f->{Changes} = $entry->get_dpkg_changes();
 
     # handle optional fields
-    my $opts = $data->[0]->get_optional_fields();
+    my $opts = $entry->get_optional_fields();
     my %closes;
     foreach (keys %$opts) {
 	if (/^Urgency$/i) { # Already dealt
@@ -527,17 +539,13 @@ sub dpkg {
 	}
     }
 
-    my $first = 1; my $urg_comment = '';
-    foreach my $entry (@$data) {
-	$first = 0, next if $first;
-
+    foreach $entry (@data) {
 	my $oldurg = $f->{Urgency} || '';
 	my $oldurgn = $URGENCIES{$f->{Urgency}} || -1;
 	my $newurg = $entry->get_urgency() || '';
 	my $newurgn = $URGENCIES{$newurg} || -1;
 	$f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
-
-	$f->{Changes} .= "\n ." . get_dpkg_changes($entry);
+	$f->{Changes} .= "\n ." . $entry->get_dpkg_changes();
 
 	# handle optional fields
 	$opts = $entry->get_optional_fields();
@@ -555,47 +563,26 @@ sub dpkg {
     }
     run_vendor_hook("post-process-changelog-entry", $f);
 
-    return %$f if wantarray;
     return $f;
 }
 
-sub dpkg_str {
-    return data2rfc822(scalar dpkg(@_));
-}
-
-=pod
-
-=head3 rfc822
-
-(and B<rfc822_str>)
+=item my @controls = $c->rfc822($range)
 
-C<rfc822> returns an array of hashes (in list context) or a reference
-to this array (in scalar context) where each hash represents one entry
-in the changelog. For the format of such a hash see the description
-of the L<"dpkg"> method (while ignoring the remarks about which
-values are taken from the first entry).
-
-C<rfc822_str> returns a stringified version of this array.
-
-Both methods support the common output options described in
-section L<"COMMON OUTPUT OPTIONS">.
-
-=head3 rfc822_str
-
-See L<rfc822>.
+Returns a Dpkg::Index containing Dpkg::Control::Changelog objects where
+each object represents one entry in the changelog that is part of the
+range requested (see L<"RANGE SELECTION"> for details). For the format of
+such an object see the description of the L<"dpkg"> method (while ignoring
+the remarks about which values are taken from the first entry).
 
 =cut
 
 sub rfc822 {
-    my ($self, $config) = @_;
+    my ($self, $range) = @_;
 
-    $self->{config}{RFC822} = $config if $config;
+    my @data = $self->get_range($range) or return undef;
+    my $index = Dpkg::Index->new(type => CTRL_CHANGELOG);
 
-    $config = $self->{config}{RFC822} || {};
-    my $data = $self->_data_range( $config ) or return undef;
-    my @out_data;
-
-    foreach my $entry (@$data) {
+    foreach my $entry (@data) {
 	my $f = Dpkg::Control::Changelog->new();
 	$f->{Urgency} = $entry->get_urgency() || "unknown";
 	$f->{Source} = $entry->get_source() || "unknown";
@@ -603,7 +590,7 @@ sub rfc822 {
 	$f->{Distribution} = join(" ", $entry->get_distributions());
 	$f->{Maintainer} = $entry->get_maintainer() || "";
 	$f->{Date} = $entry->get_timestamp() || "";
-	$f->{Changes} = get_dpkg_changes($entry);
+	$f->{Changes} = $entry->get_dpkg_changes();
 
 	# handle optional fields
 	my $opts = $entry->get_optional_fields();
@@ -613,23 +600,19 @@ sub rfc822 {
 
         run_vendor_hook("post-process-changelog-entry", $f);
 
-	push @out_data, $f;
+	$index->add($f);
     }
-
-    return @out_data if wantarray;
-    return \@out_data;
+    return $index;
 }
 
-sub rfc822_str {
-    return data2rfc822(scalar rfc822(@_));
-}
+=back
 
-=pod
+=head1 RANGE SELECTION
 
-=head1 COMMON OUTPUT OPTIONS
+A range selection is described by a hash reference where
+the allowed keys and values are described below.
 
-The following options are supported by all output methods,
-all take a version number as value:
+The following options take a version number as value.
 
 =over 4
 
@@ -655,8 +638,7 @@ specified B<version> itself.
 
 =back
 
-The following options are also supported by all output methods but
-don't take version numbers as values:
+The following options don't take version numbers as values:
 
 =over 4
 
@@ -683,109 +665,26 @@ wasn't given as well.
 Some examples for the above options. Imagine an example changelog with
 entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1.
 
-            Call                               Included entries
- C<E<lt>formatE<gt>({ since =E<gt> '2.0' })>  3.1, 3.0, 2.2
- C<E<lt>formatE<gt>({ until =E<gt> '2.0' })>  1.3, 1.2
- C<E<lt>formatE<gt>({ from =E<gt> '2.0' })>   3.1, 3.0, 2.2, 2.1, 2.0
- C<E<lt>formatE<gt>({ to =E<gt> '2.0' })>     2.0, 1.3, 1.2
- C<E<lt>formatE<gt>({ count =E<gt> 2 }>>      3.1, 3.0
- C<E<lt>formatE<gt>({ count =E<gt> -2 }>>     1.3, 1.2
- C<E<lt>formatE<gt>({ count =E<gt> 3,
-		      offset=E<gt> 2 }>>      2.2, 2.1, 2.0
- C<E<lt>formatE<gt>({ count =E<gt> 2,
-		      offset=E<gt> -3 }>>     2.0, 1.3
- C<E<lt>formatE<gt>({ count =E<gt> -2,
-		      offset=E<gt> 3 }>>      3.0, 2.2
- C<E<lt>formatE<gt>({ count =E<gt> -2,
-		      offset=E<gt> -3 }>>     2.2, 2.1
+            Range                           Included entries
+ C<{ since =E<gt> '2.0' }>                  3.1, 3.0, 2.2
+ C<{ until =E<gt> '2.0' }>                  1.3, 1.2
+ C<{ from =E<gt> '2.0' }>                   3.1, 3.0, 2.2, 2.1, 2.0
+ C<{ to =E<gt> '2.0' }>                     2.0, 1.3, 1.2
+ C<{ count =E<gt> 2 }>                      3.1, 3.0
+ C<{ count =E<gt> -2 }>	                    1.3, 1.2
+ C<{ count =E<gt> 3, offset=E<gt> 2 }>      2.2, 2.1, 2.0
+ C<{ count =E<gt> 2, offset=E<gt> -3 }>     2.0, 1.3
+ C<{ count =E<gt> -2, offset=E<gt> 3 }>     3.0, 2.2
+ C<{ count =E<gt> -2, offset=E<gt> -3 }>    2.2, 2.1
 
 Any combination of one option of C<since> and C<from> and one of
 C<until> and C<to> returns the intersection of the two results
 with only one of the options specified.
 
-=head1 UTILITY FUNCTIONS
-
-=head3 data2rfc822
-
-Takes a single argument, either a Dpkg::Changelog::Entry object
-or a reference to an array of such objects.
-
-Returns the data in RFC822 format as string.
-
-=cut
-
-sub data2rfc822 {
-    my ($data) = @_;
-
-    if (ref($data) eq "ARRAY") {
-	my @rfc822 = ();
-
-	foreach my $entry (@$data) {
-	    push @rfc822, data2rfc822($entry);
-	}
-
-	return join "\n", @rfc822;
-    } elsif (ref($data)) {
-	my $rfc822_str = $data->output;
-
-	return $rfc822_str;
-    } else {
-	return;
-    }
-}
-
-=pod
-
-=head3 get_dpkg_changes
-
-Takes a Dpkg::Changelog::Entry object as first argument.
-
-Returns a string that is suitable for using it in a C<Changes> field
-in the output format of C<dpkg-parsechangelog>.
-
-=cut
-
-sub get_dpkg_changes {
-    my $entry = shift;
-    my $header = $entry->get_part("header") || "";
-    $header =~ s/\s+$//;
-    my $changes = "\n $header\n .\n";
-    foreach my $line (@{$entry->get_part("changes")}) {
-	$line =~ s/\s+$//;
-	if ($line eq "") {
-	    $changes .= " .\n";
-	} else {
-	    $changes .= " $line\n";
-	}
-    }
-    chomp $changes;
-    return $changes;
-}
-
-1;
-__END__
-
 =head1 AUTHOR
 
 Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright E<copy> 2005, 2007 by Frank Lichtenheld
-Copyright E<copy> 2009 by Raphael Hertzog
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+Raphael Hertzog, E<lt>hertzog@debian.orgE<gt>
 
 =cut
+1;

scripts/Dpkg/Changelog/Debian.pm

@@ -57,58 +57,21 @@ use constant {
 
 =pod
 
-=head3 parse
+=head3 $c->parse($fh, $description)
 
-Parses either the file named in configuration item C<infile>, the content
-of the filehandle in configuration item C<inhandle>, or the string
-saved in configuration item C<instring> (the latter requires IO::String).
-You can set a filename to use for reporting errors with configuration
-item C<reportfile>.
-Accepts a hash ref as optional argument which can contain configuration
-items.
-
-Returns C<undef> in case of error (e.g. "file not found", B<not> parse
-errors) and the object if successful. If C<undef> was returned, you
-can get the reason for the failure by calling the L<get_error> method.
+Read the filehandle and parse a Debian changelog in it. Returns the number
+of changelog entries that have been parsed with success.
 
 =cut
 
 sub parse {
-    my ($self, $config) = @_;
-
-    foreach my $c (keys %$config) {
-	$self->{config}{$c} = $config->{$c};
-    }
-
-    my ($fh, $file);
-    if ($file = $self->{config}{infile}) {
-	open $fh, '<', $file or do {
-	    $self->_do_fatal_error( _g("can't open file %s: %s"),
-					$file, $! );
-	    return undef;
-	};
-    } elsif ($fh = $self->{config}{inhandle}) {
-	$file = 'FileHandle';
-    } elsif (my $string = $self->{config}{instring}) {
-	eval { require IO::String };
-	if ($@) {
-	    $self->_do_fatal_error( _g("can't load IO::String: %s"),
-					$@ );
-	    return undef;
-	}
-	$fh = IO::String->new( $string );
-	$file = 'String';
-    } else {
-	$self->_do_fatal_error(_g('no changelog file specified'));
-	return undef;
-    }
-    if (defined($self->{config}{reportfile})) {
-	$file = $self->{config}{reportfile};
-    }
+    my ($self, $fh, $file) = @_;
+    $file = $self->{reportfile} if exists $self->{reportfile};
 
     $self->reset_parse_errors;
 
     $self->{data} = [];
+    $self->set_unparsed_tail(undef);
 
     my $expect = FIRST_HEADING;
     my $entry = Dpkg::Changelog::Entry::Debian->new();
@@ -120,18 +83,18 @@ sub parse {
 	if ($_ =~ $regex_header) {
 	    (my $options = $4) =~ s/^\s+//;
 	    unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
-		$self->_do_parse_error($file, $.,
+		$self->parse_error($file, $.,
 		    sprintf(_g("found start of entry where expected %s"),
 		    $expect), "$_");
 	    }
 	    unless ($entry->is_empty) {
 		push @{$self->{data}}, $entry;
 		$entry = Dpkg::Changelog::Entry::Debian->new();
-		last if $self->_abort_early;
+		last if $self->abort_early();
 	    }
 	    $entry->set_part('header', $_);
 	    foreach my $error ($entry->check_header()) {
-		$self->_do_parse_error($file, $., $error, $_);
+		$self->parse_error($file, $., $error, $_);
 	    }
 	    $expect= START_CHANGES;
 	    @blanklines = ();
@@ -156,29 +119,26 @@ sub parse {
 	    # save entries on old changelog format verbatim
 	    # we assume the rest of the file will be in old format once we
 	    # hit it for the first time
-	    $self->{oldformat} = "$_\n";
-	    $self->{oldformat} .= join "", <$fh>;
+	    $self->set_unparsed_tail("$_\n" . join("", <$fh>));
 	} elsif (m/^\S/) {
-	    $self->_do_parse_error($file, $.,
-				  _g("badly formatted heading line"), "$_");
+	    $self->parse_error($file, $., _g("badly formatted heading line"), "$_");
 	} elsif ($_ =~ $regex_trailer) {
 	    unless ($expect eq CHANGES_OR_TRAILER) {
-		$self->_do_parse_error($file, $.,
+		$self->parse_error($file, $.,
 		    sprintf(_g("found trailer where expected %s"), $expect), "$_");
 	    }
 	    $entry->set_part("trailer", $_);
 	    $entry->extend_part("blank_after_changes", [ @blanklines ]);
 	    @blanklines = ();
 	    foreach my $error ($entry->check_header()) {
-		$self->_do_parse_error($file, $., $error, $_);
+		$self->parse_error($file, $., $error, $_);
 	    }
 	    $expect = NEXT_OR_EOF;
 	} elsif (m/^ \-\-/) {
-	    $self->_do_parse_error($file, $.,
-				   _g( "badly formatted trailer line" ), "$_");
+	    $self->parse_error($file, $., _g("badly formatted trailer line"), "$_");
 	} elsif (m/^\s{2,}(\S)/) {
 	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
-		$self->_do_parse_error($file, $., sprintf(_g("found change data" .
+		$self->parse_error($file, $., sprintf(_g("found change data" .
 		    " where expected %s"), $expect), "$_");
 		if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
 		    # lets assume we have missed the actual header line
@@ -199,12 +159,12 @@ sub parse {
 		$entry->extend_part("blank_after_trailer", $_);
 		next;
 	    } elsif ($expect ne CHANGES_OR_TRAILER) {
-		$self->_do_parse_error($file, $.,
-		      sprintf(_g("found blank line where expected %s"), $expect));
+		$self->parse_error($file, $.,
+		    sprintf(_g("found blank line where expected %s"), $expect));
 	    }
 	    push @blanklines, $_;
 	} else {
-	    $self->_do_parse_error($file, $., _g("unrecognised line"), "$_");
+	    $self->parse_error($file, $., _g("unrecognised line"), "$_");
 	    unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
 		# lets assume change data if we expected it
 		$entry->extend_part("changes", [ @blanklines, $_]);
@@ -215,22 +175,14 @@ sub parse {
     }
 
     unless ($expect eq NEXT_OR_EOF) {
-	$self->_do_parse_error($file, $.,
-	    sprintf(_g("found eof where expected %s"), $expect));
+	$self->parse_error($file, $., sprintf(_g("found eof where expected %s"),
+					      $expect));
     }
     unless ($entry->is_empty) {
 	push @{$self->{data}}, $entry;
     }
 
-    if ($self->{config}{infile}) {
-	close $fh or do {
-	    $self->_do_fatal_error( _g("can't close file %s: %s"),
-				    $file, $!);
-	    return undef;
-	};
-    }
-
-    return $self;
+    return scalar @{$self->{data}};
 }
 
 1;

scripts/Dpkg/Changelog/Entry.pm

@@ -24,7 +24,9 @@ use Dpkg::ErrorHandling;
 use Dpkg::Control::Changelog;
 
 use overload
-    '""' => \&output;
+    '""' => \&output,
+    'eq' => sub { defined($_[1]) and "$_[0]" eq "$_[1]" },
+    fallback => 1;
 
 =head1 NAME
 

scripts/changelog/debian.pl

@@ -99,8 +99,6 @@ if (@ARGV) {
     $file = $ARGV[0];
 }
 
-my $changes = Dpkg::Changelog::Debian->init();
-
 $file ||= $default_file;
 $label ||= $file;
 unless (defined($since) or defined($until) or defined($from) or
@@ -109,22 +107,25 @@ unless (defined($since) or defined($until) or defined($from) or
 {
     $count = 1;
 }
-my @all = $all ? ( all => $all ) : ();
-my $opts = { since => $since, until => $until,
-	     from => $from, to => $to,
-	     count => $count, offset => $offset,
-	     @all, reportfile => $label };
+my %all = $all ? ( all => $all ) : ();
+my $range = {
+    since => $since, until => $until, from => $from, to => $to,
+    count => $count, offset => $offset,
+    %all
+};
+
+my $changes = Dpkg::Changelog::Debian->new(reportfile => $label, range => $range);
 
 if ($file eq '-') {
-    $changes->parse({ inhandle => \*STDIN, %$opts })
+    $changes->parse(\*STDIN, _g("standard input"))
 	or error(_g('fatal error occured while parsing input'));
 } else {
-    $changes->parse({ infile => $file, %$opts })
+    $changes->load($file)
 	or error(_g('fatal error occured while parsing %s'), $file);
 }
 
 
-eval("print \$changes->${format}_str(\$opts)");
+eval("print \$changes->${format}(\$range)");
 if ($@) {
     error("%s", $@);
 }

scripts/t/600_Dpkg_Changelog.t

@@ -12,7 +12,7 @@ BEGIN {
 	+ $no_err_examples * 2
 	+ 26 # countme
 	+  2 # fields
-	+ 24;
+	+ 21;
 
     require Test::More;
     import Test::More tests => $no_tests;
@@ -27,16 +27,11 @@ $srcdir .= '/t/600_Dpkg_Changelog';
 
 #########################
 
-my $test = Dpkg::Changelog::Debian->init( { infile => '/nonexistant',
-					    quiet => 1 } );
-ok( !defined($test), "fatal parse errors lead to init() returning undef");
-
-my $save_data;
 foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields",
     "$srcdir/regressions") {
 
-    my $changes = Dpkg::Changelog::Debian->init( { infile => $file,
-						   quiet => 1 } );
+    my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
+    $changes->load($file);
     my $errors = $changes->get_parse_errors();
     my $basename = basename( $file );
 
@@ -45,18 +40,16 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields",
 
     is($errors, '', "Parse example changelog $file without errors" );
 
-    my @data = $changes->data;
+    my @data = @$changes;
 
     ok( @data, "data is not empty" );
 
-    my $str = $changes->dpkg_str();
+    my $str = $changes->dpkg();
 
 #    is( $str, `dpkg-parsechangelog -l$file`,
 #	'Output of dpkg_str equal to output of dpkg-parsechangelog' );
 
     if ($file eq "$srcdir/countme") {
-	$save_data = $changes->rfc822_str({ all => 1 });
-
 	# test range options
 	cmp_ok( @data, '==', 7, "no options -> count" );
 	my $all_versions = join( '/', map { $_->get_version() } @data);
@@ -65,7 +58,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields",
 	    my ($changes, $data, $options, $count, $versions,
 		$check_name) = @_;
 
-	    my @cnt = $changes->data( $options );
+	    my @cnt = $changes->get_range($options);
 	    cmp_ok( @cnt, '==', $count, "$check_name -> count" );
 	    if ($count == @$data) {
 		is_deeply( \@cnt, $data, "$check_name -> returns all" );
@@ -78,7 +71,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields",
 
 	check_options( $changes, \@data,
 		       { count => 3 }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
-		       'positve count' );
+		       'positive count' );
 	check_options( $changes, \@data,
 		       { count => -3 }, 3,
 		       '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
@@ -166,7 +159,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow", "$srcdir/fields",
 	#TODO: test combinations
     }
     if ($file eq "$srcdir/fields") {
-	my $str = $changes->dpkg_str({ all => 1 });
+	my $str = $changes->dpkg({ all => 1 });
 	my $expected = 'Source: fields
 Version: 2.0-0etch1
 Distribution: stable
@@ -194,7 +187,7 @@ Xc-Userfield: foobar
 ';
 	cmp_ok($str,'eq',$expected,"fields handling");
 
-	$str = $changes->dpkg_str({ offset => 1, count => 2 });
+	$str = $changes->dpkg({ offset => 1, count => 2 });
 	$expected = 'Source: fields
 Version: 2.0-1
 Distribution: unstable
@@ -224,43 +217,29 @@ Xc-Userfield: foobar
 #     }
 
     SKIP: {
-	skip("avoid spurios warning with only one entry", 2)
+	skip("avoid spurious warning with only one entry", 2)
 	    if @data == 1;
 
 	my $oldest_version = $data[-1]->{Version};
-	$str = $changes->dpkg_str({ since => $oldest_version });
+	$str = $changes->dpkg({ since => $oldest_version });
 
-	$str = $changes->rfc822_str();
+	$str = $changes->rfc822();
 
 	ok( 1 );
 
-	$str = $changes->rfc822_str({ since => $oldest_version });
+	$str = $changes->rfc822({ since => $oldest_version });
 
 	ok( 1 );
     }
 }
 
-open CHANGES, '<', "$srcdir/countme";
-my $string = join('',<CHANGES>);
-
-my $str_changes = Dpkg::Changelog::Debian->init( { instring => $string,
-						   quiet => 1 } );
-my $errors = $str_changes->get_parse_errors();
-ok( !$errors,
-    "Parse example changelog $srcdir/countme without errors from string" );
-
-my $str_data = $str_changes->rfc822_str({ all => 1 });
-is( $str_data, $save_data,
-    "Compare result of parse from string with result of parse from file" );
-
-
 foreach my $test (( [ "$srcdir/misplaced-tz", 6 ])) {
 
     my $file = shift @$test;
-    my $changes = Dpkg::Changelog::Debian->init( { infile => $file,
-						   quiet => 1 } );
+    my $changes = Dpkg::Changelog::Debian->new(verbose => 0);
+    $changes->load($file);
     my @errors = $changes->get_parse_errors();
 
-    ok( @errors, 'errors occoured' );
+    ok(@errors, 'errors occured');
     is_deeply( [ map { $_->[1] } @errors ], $test, 'check line numbers' );
 }