Ver código fonte

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.
Raphaël Hertzog 16 anos atrás
pai
commit
825656afe3

+ 63 - 97
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__
 

+ 30 - 92
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;
 }
 

+ 4 - 4
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 <frank@lichtenheld.de>
 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
  .