The following commit has been merged in the master branch:
commit 825656afe3e9856dc846c225df8af73d2376fa3e
Author: Raphaël Hertzog <[email protected]>
Date: Sun Oct 18 23:07:03 2009 +0200
Update Dpkg::Changelog to use new ::Entry modules
Drop the Dpkg::Changelog::Entry embedded in Dpkg::Changelog.
Update Dpkg::Changelog and Dpkg::Changelog::Debian to use the
new modules.
Some (undocumented) features have been removed with this rewrite.
The entries are not parsed item by item anymore. The Urgency field
will no longer receive the comment that can follow the urgency.
The content of “Closes” is exported by Dpkg::Changelog::Entry::Debian
as an optional field.
The test-suite also had to be updated to cope with the API changes
and the fact that bugs are no longer duplicated in the “Closes” field.
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 4433722..57898bd 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -41,7 +41,8 @@ use English;
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(:DEFAULT report);
-use Dpkg::Control;
+use Dpkg::Control::Changelog;
+use Dpkg::Control::Fields;
use Dpkg::Version;
use Dpkg::Vendor qw(run_vendor_hook);
@@ -250,8 +251,8 @@ sub __sanity_check_range {
# Handle non-existing versions
my (%versions, @versions);
foreach my $entry (@{$data}) {
- $versions{$entry->{Version}} = 1;
- push @versions, $entry->{Version};
+ $versions{$entry->get_version()->as_string()} = 1;
+ push @versions, $entry->get_version()->as_string();
}
if ((length($$since) and not exists $versions{$$since})) {
warning(_g("'%s' option specifies non-existing version"), "since");
@@ -317,11 +318,11 @@ sub __sanity_check_range {
}
}
- if (length($$since) && ($data->[0]{Version} eq $$since)) {
+ if (length($$since) && ($data->[0]->get_version() eq $$since)) {
warning(_g( "'since' option specifies most recent version, ignoring" ));
$$since = '';
}
- if (length($$until) && ($data->[$#{$data}]{Version} eq $$until)) {
+ if (length($$until) && ($data->[$#{$data}]->get_version() eq $$until)) {
warning(_g( "'until' option specifies oldest version, ignoring" ));
$$until = '';
}
@@ -374,14 +375,14 @@ sub _data_range {
my $include = 1;
$include = 0 if length($to) or length($until);
foreach (@$data) {
- my $v = $_->{Version};
- $include = 1 if $v eq $to;
- last if $v eq $since;
+ my $v = $_->get_version();
+ $include = 1 if $to and $v eq $to;
+ last if $since and $v eq $since;
push @result, $_ if $include;
- $include = 1 if $v eq $until;
- last if $v eq $from;
+ $include = 1 if $until and $v eq $until;
+ last if $from and $v eq $from;
}
return \...@result if scalar(@result);
@@ -427,7 +428,7 @@ sub _abort_early {
return unless length($since) or length($from);
foreach (@$data) {
- my $v = $_->{Version};
+ my $v = $_->get_version();
return 1 if $v eq $since;
return 1 if $v eq $from;
@@ -494,17 +495,8 @@ See L<dpkg>.
=cut
-our ( @CHANGELOG_FIELDS, $CHANGELOG_FIELDS );
our ( @URGENCIES, %URGENCIES );
BEGIN {
- @CHANGELOG_FIELDS = qw(Source Version Distribution
- Urgency Maintainer Date Closes Changes
- Timestamp Header Items Trailer
- BlankAfterHeader BlankAfterChanges
- BlankAfterTrailer
- Urgency_comment Urgency_lc);
- $CHANGELOG_FIELDS = Dpkg::Control->new(type => CTRL_CHANGELOG);
- %$CHANGELOG_FIELDS = map { $_ => 1 } @CHANGELOG_FIELDS;
@URGENCIES = qw(low medium high critical emergency);
my $i = 1;
%URGENCIES = map { $_ => $i++ } @URGENCIES;
@@ -518,44 +510,53 @@ sub dpkg {
$config = $self->{config}{DPKG} || {};
my $data = $self->_data_range( $config ) or return undef;
- my $f = new Dpkg::Changelog::Entry;
- foreach my $field (qw( Urgency Source Version
- Distribution Maintainer Date )) {
- $f->{$field} = $data->[0]{$field};
- }
- # handle unknown fields
- foreach my $field (keys %{$data->[0]}) {
- next if $CHANGELOG_FIELDS->{$field};
- $f->{$field} = $data->[0]{$field};
+ 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]);
+
+ # handle optional fields
+ my $opts = $data->[0]->get_optional_fields();
+ my %closes;
+ foreach (keys %$opts) {
+ if (/^Urgency$/i) { # Already dealt
+ } elsif (/^Closes$/i) {
+ $closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes}));
+ } else {
+ field_transfer_single($opts, $f);
+ }
}
- $f->{Changes} = get_dpkg_changes( $data->[0] );
- $f->{Closes} = [ @{$data->[0]{Closes}} ];
-
my $first = 1; my $urg_comment = '';
foreach my $entry (@$data) {
$first = 0, next if $first;
my $oldurg = $f->{Urgency} || '';
my $oldurgn = $URGENCIES{$f->{Urgency}} || -1;
- my $newurg = $entry->{Urgency_lc} || '';
- my $newurgn = $URGENCIES{$entry->{Urgency_lc}} || -1;
+ my $newurg = $entry->get_urgency() || '';
+ my $newurgn = $URGENCIES{$newurg} || -1;
$f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
- $urg_comment .= $entry->{Urgency_comment};
- $f->{Changes} .= "\n .".get_dpkg_changes( $entry );
- push @{$f->{Closes}}, @{$entry->{Closes}};
+ $f->{Changes} .= "\n ." . get_dpkg_changes($entry);
- # handle unknown fields
- foreach my $field (keys %$entry) {
- next if $CHANGELOG_FIELDS->{$field};
- next if exists $f->{$field};
- $f->{$field} = $entry->{$field};
+ # handle optional fields
+ $opts = $entry->get_optional_fields();
+ foreach (keys %$opts) {
+ if (/^Closes$/i) {
+ $closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes}));
+ } elsif (not exists $f->{$_}) { # Don't overwrite an existing field
+ field_transfer_single($opts, $f);
+ }
}
}
- $f->{Closes} = join " ", sort { $a <=> $b } @{$f->{Closes}};
- $f->{Urgency} .= $urg_comment;
+ if (scalar keys %closes) {
+ $f->{Closes} = join " ", sort { $a <=> $b } keys %closes;
+ }
run_vendor_hook("post-process-changelog-entry", $f);
return %$f if wantarray;
@@ -599,20 +600,19 @@ sub rfc822 {
my @out_data;
foreach my $entry (@$data) {
- my $f = new Dpkg::Changelog::Entry;
- foreach my $field (qw( Urgency Source Version
- Distribution Maintainer Date )) {
- $f->{$field} = $entry->{$field};
- }
-
- $f->{Urgency} .= $entry->{Urgency_Comment};
- $f->{Changes} = get_dpkg_changes( $entry );
- $f->{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
-
- # handle unknown fields
- foreach my $field (keys %$entry) {
- next if $CHANGELOG_FIELDS->{$field};
- $f->{$field} = $entry->{$field};
+ my $f = Dpkg::Control::Changelog->new();
+ $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} = get_dpkg_changes($entry);
+
+ # handle optional fields
+ my $opts = $entry->get_optional_fields();
+ foreach (keys %$opts) {
+ field_transfer_single($opts, $f) unless exists $f->{$_};
}
run_vendor_hook("post-process-changelog-entry", $f);
@@ -774,9 +774,10 @@ in the output format of C<dpkg-parsechangelog>.
sub get_dpkg_changes {
my $entry = shift;
- $entry->{Header} =~ s/\s+$// if defined $entry->{Header};
- my $changes = "\n " . ($entry->{Header} || '') . "\n .\n";
- foreach my $line (@{$entry->{Changes}}) {
+ 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";
@@ -900,7 +901,7 @@ sub parse_changelog {
# Get the output into several Dpkg::Control objects
my (@res, $fields);
while (1) {
- $fields = Dpkg::Control->new(type => CTRL_CHANGELOG);
+ $fields = Dpkg::Control::Changelog->new();
last unless $fields->parse_fh(\*P, _g("output of changelog parser"));
push @res, $fields;
}
@@ -913,41 +914,6 @@ sub parse_changelog {
}
}
-=head1 NAME
-
-Dpkg::Changelog::Entry - represents one entry in a Debian changelog
-
-=head1 SYNOPSIS
-
-FIXME: to be written
-
-=head1 DESCRIPTION
-
-=cut
-
-package Dpkg::Changelog::Entry;
-
-use Dpkg::Control;
-use base qw(Dpkg::Control);
-
-sub new {
- my ($classname) = @_;
-
- my $entry = Dpkg::Control->new(type => CTRL_CHANGELOG);
- $entry->set_output_order(@CHANGELOG_FIELDS);
- bless $entry, $classname;
-}
-
-sub is_empty {
- my ($self) = @_;
-
- return !($self->{Changes}
- || $self->{Source}
- || $self->{Version}
- || $self->{Maintainer}
- || $self->{Date});
-}
-
1;
__END__
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
index 3b7df30..f1af47f 100644
--- a/scripts/Dpkg/Changelog/Debian.pm
+++ b/scripts/Dpkg/Changelog/Debian.pm
@@ -61,14 +61,15 @@ package Dpkg::Changelog::Debian;
use strict;
use warnings;
-use Fcntl qw( :flock );
+use Fcntl qw(:flock);
use English;
use Date::Parse;
use Dpkg;
use Dpkg::Gettext;
-use Dpkg::Changelog qw( :util );
+use Dpkg::Changelog qw(:util);
use base qw(Dpkg::Changelog);
+use Dpkg::Changelog::Entry::Debian qw($regex_header $regex_trailer);
=pod
@@ -127,45 +128,28 @@ sub parse {
# based on /usr/lib/dpkg/parsechangelog/debian
my $expect='first heading';
- my $entry = new Dpkg::Changelog::Entry;
+ my $entry = Dpkg::Changelog::Entry::Debian->new();
my @blanklines = ();
my $unknowncounter = 1; # to make version unique, e.g. for using as id
while (<$fh>) {
chomp;
-# printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
- my $name_chars = qr/[-+0-9a-z.]/i;
- if (m/^(\w$name_chars*) \(([^\(\) \t]+)\)((\s+$name_chars+)+)\;/i) {
+ if ($_ =~ $regex_header) {
+ (my $options = $4) =~ s/^\s+//;
unless ($expect eq 'first heading'
|| $expect eq 'next heading or eof') {
- $entry->{ERROR} = [ $file, $NR,
- sprintf(_g("found start of entry where
expected %s"),
- $expect), "$_" ];
- $self->_do_parse_error(@{$entry->{ERROR}});
+ $self->_do_parse_error($file, $NR,
+ sprintf(_g("found start of entry where expected %s"),
+ $expect), "$_");
}
unless ($entry->is_empty) {
- $entry->{'Closes'} = find_closes(join("\n",
@{$entry->{Changes}}));
-# print STDERR, Dumper($entry);
push @{$self->{data}}, $entry;
- $entry = new Dpkg::Changelog::Entry;
+ $entry = Dpkg::Changelog::Entry::Debian->new();
last if $self->_abort_early;
}
- {
- $entry->{'Source'} = "$1";
- $entry->{'Version'} = "$2";
- $entry->{'Header'} = "$_";
- ($entry->{'Distribution'} = "$3") =~ s/^\s+//;
- $entry->{'Changes'} = [];
- $entry->{'BlankAfterHeader'} = [];
- $entry->{'BlankAfterChanges'} = [];
- $entry->{'BlankAfterTrailer'} = [];
- $entry->{'Urgency_comment'} = '';
- $entry->{'Urgency'} = $entry->{'Urgency_lc'} = 'unknown';
- }
- (my $rhs = $POSTMATCH) =~ s/^\s+//;
+ $entry->set_part('header', $_);
my %kvdone;
-# print STDERR "RHS: $rhs\n";
- for my $kv (split(/\s*,\s*/,$rhs)) {
+ for my $kv (split(/\s*,\s*/, $options)) {
$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
$self->_do_parse_error($file, $NR,
sprintf(_g("bad key-value after
\`;': \`%s'"), $kv));
@@ -178,17 +162,10 @@ sub parse {
$self->_do_parse_error($file, $NR,
_g("badly formatted urgency
value"),
$v);
- $entry->{'Urgency'} = "$1";
- $entry->{'Urgency_lc'} = lc("$1");
- $entry->{'Urgency_comment'} = "$2";
} elsif ($k =~ m/^X[BCS]+-/i) {
- # Extensions - XB for putting in Binary,
- # XC for putting in Control, XS for putting in Source
- $entry->{$k}= $v;
} else {
$self->_do_parse_error($file, $NR,
sprintf(_g("unknown key-value key %s
- copying to XS-%s"), $k, $k));
- $entry->{"XS-$k"} = $v;
}
}
$expect= 'start of change data';
@@ -219,7 +196,7 @@ sub parse {
} elsif (m/^\S/) {
$self->_do_parse_error($file, $NR,
_g("badly formatted heading line"), "$_");
- } elsif (m/^ \-\- (.*) <(.*)>(
?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)\s*$/o)
{
+ } elsif ($_ =~ $regex_trailer) {
$expect eq 'more change data or trailer' ||
$self->_do_parse_error($file, $NR,
sprintf(_g("found trailer where expected
%s"),
@@ -229,24 +206,19 @@ sub parse {
_g( "badly formatted trailer line" ),
"$_");
}
- push @{$entry->{BlankAfterChanges}}, @blanklines;
+ $entry->set_part("trailer", $_);
+ $entry->extend_part("blank_after_changes", [ @blanklines ]);
@blanklines = ();
- $entry->{'Trailer'} = $_;
- $entry->{'Maintainer'} = "$1 <$2>" unless $entry->{'Maintainer'};
- unless($entry->{'Date'} && defined $entry->{'Timestamp'}) {
- $entry->{'Date'} = "$4";
- $entry->{'Timestamp'} = str2time($4);
- unless (defined $entry->{'Timestamp'}) {
- $self->_do_parse_error( $file, $NR,
- sprintf(_g("couldn't parse date
%s"),
- "$4"));
- }
+ $entry->{'Timestamp'} = str2time($4);
+ unless (defined $entry->{'Timestamp'}) {
+ $self->_do_parse_error( $file, $NR,
+ sprintf(_g("couldn't parse date %s"),
+ "$4"));
}
$expect = 'next heading or eof';
} elsif (m/^ \-\-/) {
- $entry->{ERROR} = [ $file, $NR,
- _g( "badly formatted trailer line" ), "$_" ];
- $self->_do_parse_error(@{$entry->{ERROR}});
+ $self->_do_parse_error($file, $NR,
+ _g( "badly formatted trailer line" ), "$_");
# $expect = 'next heading or eof'
# if $expect eq 'more change data or trailer';
} elsif (m/^\s{2,}(\S)/) {
@@ -259,38 +231,21 @@ sub parse {
if (($expect eq 'next heading or eof')
&& !$entry->is_empty) {
# lets assume we have missed the actual header line
- $entry->{'Closes'} = find_closes(join("\n",
@{$entry->{Changes}}));
-# print STDERR, Dumper($entry);
push @{$self->{data}}, $entry;
- $entry = new Dpkg::Changelog::Entry;
- $entry->{Source} =
- $entry->{Distribution} = $entry->{Urgency} =
- $entry->{Urgency_LC} = 'unknown';
- $entry->{Version} = 'unknown'.($unknowncounter++);
- $entry->{Urgency_Comment} = '';
- $entry->{ERROR} = [ $file, $NR,
- sprintf(_g("found change data where
expected %s"),
- $expect), "$_" ];
+ $entry = Dpkg::Changelog::Entry::Debian->new();
+ $entry->set_part('header', "unknown (unknown" .
($unknowncounter++) . ") unknown; urgency=unknown");
}
};
# Keep raw changes
- push @{$entry->{'Changes'}}, @blanklines, $_;
- if (!$entry->{'Items'} || ($1 eq '*')) {
- $entry->{'Items'} ||= [];
- push @{$entry->{'Items'}}, "$_\n";
- } else {
- my $blank = '';
- $blank = join("\n", @blanklines) . "\n" if scalar @blanklines;
- $entry->{'Items'}[-1] .= "$blank$_\n";
- }
+ $entry->extend_part('changes', [ @blanklines, $_ ]);
@blanklines = ();
$expect = 'more change data or trailer';
} elsif (!m/\S/) {
if ($expect eq 'start of change data') {
- push @{$entry->{BlankAfterHeader}}, $_;
+ $entry->extend_part("blank_after_header", $_);
next;
} elsif ($expect eq 'next heading or eof') {
- push @{$entry->{BlankAfterTrailer}}, $_;
+ $entry->extend_part("blank_after_trailer", $_);
next;
} elsif ($expect ne 'more change data or trailer') {
$self->_do_parse_error($file, $NR,
@@ -304,33 +259,19 @@ sub parse {
|| $expect eq 'more change data or trailer')
&& do {
# lets assume change data if we expected it
- push @{$entry->{'Changes'}}, @blanklines, $_;
- if (!$entry->{'Items'}) {
- $entry->{'Items'} ||= [];
- push @{$entry->{'Items'}}, "$_\n";
- } else {
- my $blank = '';
- $blank = join("\n", @blanklines) . "\n"
- if scalar @blanklines;
- $entry->{'Items'}[-1] .= "$blank$_\n";
- }
+ $entry->extend_part("changes", [ @blanklines, $_]);
@blanklines = ();
$expect = 'more change data or trailer';
- $entry->{ERROR} = [ $file, $NR, _g( "unrecognised line" ),
- "$_" ];
};
}
}
$expect eq 'next heading or eof'
|| do {
- $entry->{ERROR} = [ $file, $NR,
- sprintf(_g("found eof where expected %s"),
- $expect) ];
- $self->_do_parse_error( @{$entry->{ERROR}} );
+ $self->_do_parse_error($file, $NR,
+ sprintf(_g("found eof where expected %s"), $expect));
};
unless ($entry->is_empty) {
- $entry->{'Closes'} = find_closes(join("\n", @{$entry->{Changes}}));
push @{$self->{data}}, $entry;
}
@@ -342,9 +283,6 @@ sub parse {
};
}
-# use Data::Dumper;
-# print STDERR Dumper( $self );
-
return $self;
}
diff --git a/scripts/t/600_Dpkg_Changelog.t b/scripts/t/600_Dpkg_Changelog.t
index eed9fc5..16731ee 100644
--- a/scripts/t/600_Dpkg_Changelog.t
+++ b/scripts/t/600_Dpkg_Changelog.t
@@ -43,7 +43,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow",
"$srcdir/fields",
# use Data::Dumper;
# diag(Dumper($changes));
- ok( !$errors, "Parse example changelog $file without errors" );
+ is($errors, '', "Parse example changelog $file without errors" );
my @data = $changes->data;
@@ -59,7 +59,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow",
"$srcdir/fields",
# test range options
cmp_ok( @data, '==', 7, "no options -> count" );
- my $all_versions = join( '/', map { $_->{Version} } @data);
+ my $all_versions = join( '/', map { $_->get_version() } @data);
sub check_options {
my ($changes, $data, $options, $count, $versions,
@@ -71,7 +71,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow",
"$srcdir/fields",
is_deeply( \...@cnt, $data, "$check_name -> returns all" );
} else {
- is( join( "/", map { $_->{Version} } @cnt),
+ is( join( "/", map { $_->get_version() } @cnt),
$versions, "$check_name -> versions" );
}
}
@@ -173,7 +173,7 @@ Distribution: stable
Urgency: high
Maintainer: Frank Lichtenheld <[email protected]>
Date: Sun, 13 Jan 2008 15:49:19 +0100
-Closes: 1000000 1111111 1111111 2222222 2222222
+Closes: 1000000 1111111 2222222
Changes:
fields (2.0-0etch1) stable; urgency=low
.
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
