Dpkg::Changelog: Use Dpkg::Fields for field handling

* scripts/Dpkg/Changelog.pm: Replace all field hashes
with Dpkg::Changelog::Entry objects.
(Dpkg::Changelog::Entry): Base on Dpkg::Fields::Object.
(data2rfc822): Use Dpkg::Fields::Object->output and fix
handling of user-defined fields.
(data2rfc822_mult): Merge into data2rfc822 (autodetect
whether the argument is an object or an array of object).
* scripts/Dpkg/Changelog/Debian.pm: Adapt for
Dpkg::Changelog::Entry changes.
* scripts/t/600_Dpkg_Changelog.t: Likewise.

ChangeLog

@@ -1,3 +1,16 @@
+2008-01-13  Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/Dpkg/Changelog.pm: Replace all field hashes
+	with Dpkg::Changelog::Entry objects.
+	(Dpkg::Changelog::Entry): Base on Dpkg::Fields::Object.
+	(data2rfc822): Use Dpkg::Fields::Object->output and fix
+	handling of user-defined fields.
+	(data2rfc822_mult): Merge into data2rfc822 (autodetect
+	whether the argument is an object or an array of object).
+	* scripts/Dpkg/Changelog/Debian.pm: Adapt for
+	Dpkg::Changelog::Entry changes.
+	* scripts/t/600_Dpkg_Changelog.t: Likewise.
+
 2008-01-12  Raphael hertzog  <hertzog@debian.org>
 
 	* scripts/Dpkg/Fields.pm, scripts/dpkg-source.pl: Add support of

scripts/Dpkg/Changelog.pm

@@ -35,12 +35,14 @@ package Dpkg::Changelog;
 use strict;
 use warnings;
 
+use v5.8.0; # for open $fh, '>', \$scalar
 use English;
 
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(warning report syserr subprocerr);
 use Dpkg::Cdata;
+use Dpkg::Fields qw(set_field_importance);
 
 use base qw(Exporter);
 
@@ -408,15 +410,19 @@ See L<dpkg>.
 
 =cut
 
-our ( %FIELDIMPS, %URGENCIES );
+our ( @CHANGELOG_FIELDS, %CHANGELOG_FIELDS );
+our ( @URGENCIES, %URGENCIES );
 BEGIN {
-    my $i=100;
-    grep($FIELDIMPS{$_}=$i--,
-	 qw(Source Version Distribution Urgency Maintainer Date Closes
-	    Changes));
-    $i=1;
-    grep($URGENCIES{$_}=$i++,
-	 qw(low medium high critical emergency));
+    @CHANGELOG_FIELDS = qw(Source Version Distribution
+                           Urgency Maintainer Date Closes Changes
+                           Timestamp Header Items Trailer
+                           Urgency_comment Urgency_lc);
+    tie %CHANGELOG_FIELDS, 'Dpkg::Fields::Object';
+    %CHANGELOG_FIELDS = map { $_ => 1 } @CHANGELOG_FIELDS;
+    set_field_importance(@CHANGELOG_FIELDS);
+    @URGENCIES = qw(low medium high critical emergency);
+    my $i = 1;
+    %URGENCIES = map { $_ => $i++ } @URGENCIES;
 }
 
 sub dpkg {
@@ -427,39 +433,51 @@ sub dpkg {
     $config = $self->{config}{DPKG} || {};
     my $data = $self->_data_range( $config ) or return undef;
 
-    my %f;
+    my $f = new Dpkg::Changelog::Entry;
     foreach my $field (qw( Urgency Source Version
 			   Distribution Maintainer Date )) {
-	$f{$field} = $data->[0]{$field};
+	$f->{$field} = $data->[0]{$field};
+    }
+    # handle unknown fields
+    foreach my $field (keys %{$data->[0]}) {
+	next if $CHANGELOG_FIELDS{$field};
+	$f->{$field} = $data->[0]{$field};
     }
 
-    $f{Changes} = get_dpkg_changes( $data->[0] );
-    $f{Closes} = [ @{$data->[0]{Closes}} ];
+    $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;
-	$f{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
-	$urg_comment .= $entry->{Urgency_Comment};
-
-	$f{Changes} .= "\n .".get_dpkg_changes( $entry );
-	push @{$f{Closes}}, @{$entry->{Closes}};
+	my $oldurg = $f->{Urgency} || '';
+	my $oldurgn = $URGENCIES{$f->{Urgency}} || -1;
+	my $newurg = $entry->{Urgency_lc} || '';
+	my $newurgn = $URGENCIES{$entry->{Urgency_lc}} || -1;
+	$f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
+	$urg_comment .= $entry->{Urgency_comment};
+
+	$f->{Changes} .= "\n .".get_dpkg_changes( $entry );
+	push @{$f->{Closes}}, @{$entry->{Closes}};
+
+	# handle unknown fields
+	foreach my $field (keys %$entry) {
+	    next if $CHANGELOG_FIELDS{$field};
+	    next if exists $f->{$field};
+	    $f->{$field} = $entry->{$field};
+	}
     }
 
-    $f{Closes} = join " ", sort { $a <=> $b } @{$f{Closes}};
-    $f{Urgency} .= $urg_comment;
+    $f->{Closes} = join " ", sort { $a <=> $b } @{$f->{Closes}};
+    $f->{Urgency} .= $urg_comment;
 
-    return %f if wantarray;
-    return \%f;
+    return %$f if wantarray;
+    return $f;
 }
 
 sub dpkg_str {
-    return data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
+    return data2rfc822(scalar dpkg(@_));
 }
 
 =pod
@@ -495,16 +513,23 @@ sub rfc822 {
     my @out_data;
 
     foreach my $entry (@$data) {
-	my %f;
+	my $f = new Dpkg::Changelog::Entry;
 	foreach my $field (qw( Urgency Source Version
-			   Distribution Maintainer Date )) {
-	    $f{$field} = $entry->{$field};
+			       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}};
-	push @out_data, \%f;
+	$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};
+	}
+
+	push @out_data, $f;
     }
 
     return @out_data if wantarray;
@@ -512,7 +537,7 @@ sub rfc822 {
 }
 
 sub rfc822_str {
-    return data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
+    return data2rfc822(scalar rfc822(@_));
 }
 
 =pod
@@ -621,59 +646,34 @@ sub find_closes {
 
 =head3 data2rfc822
 
-Takes two hash references as arguments. The first should contain the
-data to output in RFC822 format. The second can contain a sorting order
-for the fields. The higher the numerical value of the hash value, the
-earlier the field is printed if it exists.
+Takes a single argument, either a Dpkg::Changelog::Entry object
+or a reference to an array of such objects.
 
-Return the data in RFC822 format as string.
+Returns the data in RFC822 format as string.
 
 =cut
 
 sub data2rfc822 {
-    my ($data, $fieldimps) = @_;
-    my $rfc822_str = '';
-
-# based on /usr/lib/dpkg/controllib.pl
-    for my $f (sort { $fieldimps->{$b} <=> $fieldimps->{$a} } keys %$data) {
-	my $v= $data->{$f} or next;
-	$v =~ m/\S/o || next; # delete whitespace-only fields
-	$v =~ m/\n\S/o
-	    && warning(_g("field %s has newline then non whitespace >%s<"),
-			  $f, $v);
-	$v =~ m/\n[ \t]*\n/o && warning(_g("field %s has blank lines >%s<"),
-					   $f, $v);
-	$v =~ m/\n$/o && warning(_g("field %s has trailing newline >%s<"),
-				    $f, $v);
-	$v =~ s/\$\{\}/\$/go;
-	$rfc822_str .= "$f: $v\n";
-    }
-
-    return $rfc822_str;
-}
-
-=pod
+    my ($data) = @_;
 
-=head3 data2rfc822_mult
+    if (ref($data) eq "ARRAY") {
+	my @rfc822 = ();
 
-The first argument should be an array ref to an array of hash references.
-The second argument is a hash reference and has the same meaning as
-the second argument of L<data2rfc822>.
-
-Calls L<data2rfc822> for each element of the array given as first
-argument and returns the concatenated results.
+	foreach my $entry (@$data) {
+	    push @rfc822, data2rfc822($entry);
+	}
 
-=cut
+	return join "\n", @rfc822;
+    } else {
+	my $rfc822_str = "";
 
-sub data2rfc822_mult {
-    my ($data, $fieldimps) = @_;
-    my @rfc822 = ();
+	open my $fh, '>', \$rfc822_str
+	    or warning("couldn't open filehandle for string");
+	$data->output($fh);
+	close $fh;
 
-    foreach my $entry (@$data) {
-	push @rfc822, data2rfc822($entry,$fieldimps);
+	return $rfc822_str;
     }
-
-    return join "\n", @rfc822;
 }
 
 =pod
@@ -688,7 +688,7 @@ in the output format of C<dpkg-parsechangelog>.
 =cut
 
 sub get_dpkg_changes {
-    my $changes = "\n ".($_[0]->Header||'')."\n .\n".($_[0]->Changes||'');
+    my $changes = "\n ".($_[0]->{Header}||'')."\n .\n".($_[0]->{Changes}||'');
     chomp $changes;
     $changes =~ s/^ $/ ./mgo;
     return $changes;
@@ -724,107 +724,16 @@ Dpkg::Changelog::Entry - represents one entry in a Debian changelog
 
 =head1 DESCRIPTION
 
-=head2 Methods
-
-=head3 init
-
-Creates a new object, no options.
-
-=head3 new
-
-Alias for init.
-
-=head3 is_empty
-
-Checks if the object is actually initialized with data. This
-currently simply checks if one of the fields Source, Version,
-Maintainer, Date, or Changes is initalized.
-
-=head2 Accessors
-
-The following fields are available via accessor functions (all
-fields are string values unless otherwise noted):
-
-=over 4
-
-=item *
-
-Source
-
-=item *
-
-Version
-
-=item *
-
-Distribution
-
-=item *
-
-Urgency
-
-=item *
-
-ExtraFields (all fields except for urgency as hash)
-
-=item *
-
-Header (the whole header in verbatim form)
-
-=item *
-
-Changes (the actual content of the bug report, in verbatim form)
-
-=item *
-
-Trailer (the whole trailer in verbatim form)
-
-=item *
-
-Closes (Array of bug numbers)
-
-=item *
-
-Maintainer (name B<and> email address)
-
-=item *
-
-Date
-
-=item *
-
-Timestamp (Date expressed in seconds since the epoche)
-
-=item *
-
-ERROR (last parse error related to this entry in the format described
-at Dpkg::Changelog::get_parse_errors.
-
-=back
-
 =cut
 
 package Dpkg::Changelog::Entry;
 
-use base qw( Class::Accessor );
-
-Dpkg::Changelog::Entry->mk_accessors(qw( Closes Changes Maintainer
-					 MaintainerEmail Date
-					 Urgency Distribution
-					 Source Version ERROR
-					 ExtraFields Header
-					 Trailer Timestamp ));
-
 sub new {
-    return init(@_);
-}
+    my ($classname) = @_;
 
-sub init {
-    my $classname = shift;
-    my $self = {};
-    bless( $self, $classname );
-
-    return $self;
+    tie my %entry, 'Dpkg::Fields::Object';
+    my $entry = \%entry;
+    bless $entry, $classname;
 }
 
 sub is_empty {
@@ -837,6 +746,11 @@ sub is_empty {
 	     || $self->{Date});
 }
 
+sub output {
+    my $self = shift;
+    return tied(%$self)->output(@_);
+}
+
 1;
 __END__
 

scripts/Dpkg/Changelog/Debian.pm

@@ -119,7 +119,7 @@ sub parse {
 
 # based on /usr/lib/dpkg/parsechangelog/debian
     my $expect='first heading';
-    my $entry = Dpkg::Changelog::Entry->init();
+    my $entry = new Dpkg::Changelog::Entry;
     my $blanklines = 0;
     my $unknowncounter = 1; # to make version unique, e.g. for using as id
 
@@ -138,7 +138,7 @@ sub parse {
 		$entry->{'Closes'} = find_closes( $entry->{Changes} );
 #		    print STDERR, Dumper($entry);
 		push @{$self->{data}}, $entry;
-		$entry = Dpkg::Changelog::Entry->init();
+		$entry = new Dpkg::Changelog::Entry;
 		last if $self->_abort_early;
 	    }
 	    {
@@ -146,8 +146,8 @@ sub parse {
 		$entry->{'Version'} = "$2";
 		$entry->{'Header'} = "$_";
 		($entry->{'Distribution'} = "$3") =~ s/^\s+//;
-		$entry->{'Changes'} = $entry->{'Urgency_Comment'} = '';
-		$entry->{'Urgency'} = $entry->{'Urgency_LC'} = 'unknown';
+		$entry->{'Changes'} = $entry->{'Urgency_comment'} = '';
+		$entry->{'Urgency'} = $entry->{'Urgency_lc'} = 'unknown';
 	    }
 	    (my $rhs = $POSTMATCH) =~ s/^\s+//;
 	    my %kvdone;
@@ -166,8 +166,8 @@ sub parse {
 					      _g("badly formatted urgency value"),
 					      $v);
 		    $entry->{'Urgency'} = "$1";
-		    $entry->{'Urgency_LC'} = lc("$1");
-		    $entry->{'Urgency_Comment'} = "$2";
+		    $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

scripts/t/600_Dpkg_Changelog.t

@@ -56,7 +56,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow") {
 
 	# test range options
 	cmp_ok( @data, '==', 7, "no options -> count" );
-	my $all_versions = join( '/', map { $_->Version } @data);
+	my $all_versions = join( '/', map { $_->{Version} } @data);
 
 	sub check_options {
 	    my ($changes, $data, $options, $count, $versions,
@@ -68,7 +68,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow") {
 		is_deeply( \@cnt, $data, "$check_name -> returns all" );
 
 	    } else {
-		is( join( "/", map { $_->Version } @cnt),
+		is( join( "/", map { $_->{Version} } @cnt),
 		    $versions, "$check_name -> versions" );
 	    }
 	}
@@ -165,7 +165,7 @@ foreach my $file ("$srcdir/countme", "$srcdir/shadow") {
 # 		'version numbers in module and Changes match' );
 #     }
 
-    my $oldest_version = $data[-1]->Version;
+    my $oldest_version = $data[-1]->{Version};
     $str = $changes->dpkg_str({ since => $oldest_version });
 
 #    is( $str, `dpkg-parsechangelog -v$oldest_version -l$file`,
@@ -185,7 +185,7 @@ open CHANGES, '<', "$srcdir/countme";
 my $string = join('',<CHANGES>);
 
 my $str_changes = Dpkg::Changelog::Debian->init( { instring => $string,
-						 quiet => 1 } );
+						   quiet => 1 } );
 my $errors = $str_changes->get_parse_errors();
 ok( !$errors,
     "Parse example changelog $srcdir/countme without errors from string" );