The following commit has been merged in the master branch:
commit bb4611eb5cb1571af9886f33c61dc6305284c6cc
Author: Raphaël Hertzog <[email protected]>
Date: Sun Oct 25 23:19:42 2009 +0100
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.
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 03b43d9..3fdb87e 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -1,6 +1,3 @@
-#
-# Dpkg::Changelog
-#
# Copyright © 2005, 2007 Frank Lichtenheld <[email protected]>
# Copyright © 2009 Raphaël Hertzog <[email protected]>
#
@@ -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>[email protected]<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>[email protected]<gt>
=cut
+1;
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
index d6a35c0..1e3acf2 100644
--- a/scripts/Dpkg/Changelog/Debian.pm
+++ b/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;
diff --git a/scripts/Dpkg/Changelog/Entry.pm b/scripts/Dpkg/Changelog/Entry.pm
index c67d456..29ecd0f 100644
--- a/scripts/Dpkg/Changelog/Entry.pm
+++ b/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
diff --git a/scripts/changelog/debian.pl b/scripts/changelog/debian.pl
index cedcb7b..c5ec4ae 100755
--- a/scripts/changelog/debian.pl
+++ b/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", $@);
}
diff --git a/scripts/t/600_Dpkg_Changelog.t b/scripts/t/600_Dpkg_Changelog.t
index 16731ee..67d26ed 100644
--- a/scripts/t/600_Dpkg_Changelog.t
+++ b/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' );
}
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
