Merge branch 'controllib-removal'

Conflicts:

	ChangeLog
	scripts/dpkg-buildpackage.pl
	scripts/dpkg-checkbuilddeps.pl

ChangeLog

@@ -1,3 +1,55 @@
+2008-01-08  Frank Lichtenheld  <djpig@debian.org>
+
+	* scripts/dpkg-parsechangelog.pl: Make the
+	-L option actually work (it's only been eleven
+	years...)
+	
+	* scripts/Dpkg/ErrorHandling.pm (report): export.
+
+2007-01-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/Cdata.pm, scripts/Dpkg/Control.pm: Add two new
+	module to parse and manipulate files like debian/control.
+	* scripts/t/600_Dpkg_Control.t,
+	scripts/t/600_Dpkg_Control/control-1: Add non-regression tests for
+	Dpkg::Control and Dpkg::Cdata.
+	* scripts/dpkg-checkbuilddeps.pl, scripts/dpkg-genchanges.pl,
+	scripts/dpkg-gencontrol.pl, scripts/dpkg-gensymbols.pl,
+	scripts/dpkg-shlibdeps.pl, scripts/dpkg-source.pl: Update scripts
+	to use the new modules Dpkg::Cdata, Dpkg::Control,
+	Dpkg::Fields::Object and Dpkg::Substvars.
+
+	* scripts/Dpkg/Version.pm (check_version): New function replacing
+	checkversion of controllib.pl.
+	* scripts/dpkg-source.pl, scripts/dpkg-buildpackage.pl: Use the
+	new check_version.
+
+	* scripts/Dpkg/Vars.pm (set_source_package): New function to set
+	and check the global variable $sourcepackage (replacing
+	controllib's setsourcepackage).
+	* scripts/dpkg-genchanges.pl, scripts/dpkg-gencontrol.pl,
+	scripts/dpkg-source.pl: Use the new set_source_package.
+
+	* scripts/dpkg-distaddfile.pl, scripts/dpkg-gencontrol.pl: Delete
+	the chown(getfowner(), ...) on new files. It doesn't seem to do
+	anything useful anymore as it got dropped from several other
+	scripts over the years without problems.
+
+	* scripts/dpkg-source.pl: Integrate readmd5sum from controllib here
+	as it's the only user of that function.
+
+	* scripts/controllib.pl: Get rid of everything except
+	parsechangelog and its dependencies (parsecdata, syntax) that are
+	still needed.
+
+	* scripts/Makefile.am: Include all the new files in the
+	distributed tarball.
+
+2007-01-08  Raphael Hertzog  <hertzog@debian.org>
+
+	* scripts/Dpkg/ErrorHandling.pm (syntaxerr): New function to
+	replace the syntax() function in controllib.pl.
+
 2008-01-07  Guillem Jover  <guillem@debian.org>
 
 	* scripts/dpkg-genchanges.pl: Ignore Homepage field in binary package

debian/changelog

@@ -6,6 +6,17 @@ dpkg (1.14.16) UNRELEASED; urgency=low
   * Do not warn about unrecognized Homepage field in binary package stanzas
     in dpkg-genchanges and dpkg-source.
 
+  [ Frank Lichtenheld ]
+  * Make the -L option of dpkg-parsechangelog actually work (it's
+    only been eleven years...)
+  * Import the code from my external Parse::DebianChangelog as
+    Dpkg::Changelog and Dpkg::Changelog::Debian. Using this
+    from parsechangelog/debian adds the following requested
+    features:
+     - Option to use a non-lossy format. Closes: #95579
+     - Various options to better control how many entries
+       should be displayed. Closes: #226932
+
   [ Updated dpkg translations ]
   * Basque (Piarres Beobide). Closes: #459565
   * French (Christian Perrier).

debian/dpkg-dev.install

@@ -15,7 +15,6 @@ usr/bin/dpkg-scanpackages
 usr/bin/dpkg-scansources
 usr/bin/dpkg-shlibdeps
 usr/bin/dpkg-source
-usr/lib/dpkg/controllib.pl
 usr/lib/dpkg/parsechangelog
 usr/share/locale/*/LC_MESSAGES/dpkg-dev.mo
 usr/share/man/*/*/822-date.1
@@ -64,11 +63,17 @@ usr/share/man/*/*/dpkg-source.1
 usr/share/man/*/dpkg-source.1
 usr/share/perl5/Dpkg/Arch.pm
 usr/share/perl5/Dpkg/BuildOptions.pm
+usr/share/perl5/Dpkg/Cdata.pm
 usr/share/perl5/Dpkg/Compression.pm
-usr/share/perl5/Dpkg/ErrorHandling.pm
+usr/share/perl5/Dpkg/Control.pm
+usr/share/perl5/Dpkg/Changelog.pm
+usr/share/perl5/Dpkg/Changelog/Debian.pm
 usr/share/perl5/Dpkg/Deps.pm
+usr/share/perl5/Dpkg/ErrorHandling.pm
 usr/share/perl5/Dpkg/Fields.pm
 usr/share/perl5/Dpkg/Path.pm
 usr/share/perl5/Dpkg/Shlibs
 usr/share/perl5/Dpkg/Shlibs.pm
+usr/share/perl5/Dpkg/Substvars.pm
+usr/share/perl5/Dpkg/Vars.pm
 usr/share/perl5/Dpkg/Version.pm

scripts/Dpkg/Cdata.pm

@@ -0,0 +1,124 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Cdata;
+
+use strict;
+use warnings;
+
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(syntaxerr);
+use Dpkg::Fields;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(parsecdata);
+
+=head1 NAME
+
+Dpkg::Cdata - parse and manipulate a block of RFC822-like fields
+
+=head1 DESCRIPTION
+
+The Dpkg::Cdata module exports one function 'parsecdata' that reads a
+block of data (usually a block following the debian/control format)
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $obj = Dpkg::Cdata::parsecdata($input, $file, %options)
+
+$input is a filehandle, $file is the name of the file corresponding to
+$input. %options can contain two parameters: allow_pgp=>1 allows the parser
+to extrac the block of a data in a PGP-signed message (defaults to 0),
+and allow_duplicate=>1 ask the parser to not fail when it detects
+duplicate fields.
+
+The return value is a reference to a tied hash (Dpkg::Fields::Object) that
+can be used to access the various fields.
+
+=cut
+sub parsecdata {
+    my ($input, $file, %options) = @_;
+
+    $options{allow_pgp} = 0 unless exists $options{allow_pgp};
+    $options{allow_duplicate} = 0 unless exists $options{allow_duplicate};
+
+    my $paraborder = 1;
+    my $fields = undef;
+    my $cf = ''; # Current field
+    my $expect_pgp_sig = 0;
+    while (<$input>) {
+	s/\s*\n$//;
+	next if (m/^$/ and $paraborder);
+	next if (m/^#/);
+	$paraborder = 0;
+	if (m/^(\S+?)\s*:\s*(.*)$/) {
+	    unless (defined $fields) {
+		my %f;
+		tie %f, "Dpkg::Fields::Object";
+		$fields = \%f;
+	    }
+	    if (exists $fields->{$1}) {
+		unless ($options{allow_duplicate}) {
+		    syntaxerr($file, sprintf(_g("duplicate field %s found"), capit($1)));
+		}
+	    }
+	    $fields->{$1} = $2;
+	    $cf = $1;
+	} elsif (m/^\s+\S/) {
+	    length($cf) || syntaxerr($file, _g("continued value line not in field"));
+	    $fields->{$cf} .= "\n$_";
+	} elsif (m/^-----BEGIN PGP SIGNED MESSAGE/) {
+	    $expect_pgp_sig = 1;
+	    if ($options{allow_pgp}) {
+		# Skip PGP headers
+		while (<$input>) {
+		    last if m/^$/;
+		}
+	    } else {
+		syntaxerr($file, _g("PGP signature not allowed here"));
+	    }
+	} elsif (m/^$/) {
+	    if ($expect_pgp_sig) {
+		# Skip empty lines
+		$_ = <$input> while defined($_) && $_ =~ /^\s*$/;
+		length($_) ||
+                    syntaxerr($file, _g("expected PGP signature, found EOF after blank line"));
+		s/\n$//;
+		m/^-----BEGIN PGP SIGNATURE/ ||
+		    syntaxerr($file,
+			sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
+		# Skip PGP signature
+		while (<$input>) {
+		    last if m/^-----END PGP SIGNATURE/;
+		}
+		length($_) ||
+                    syntaxerr($file, _g("unfinished PGP signature"));
+	    }
+	    last; # Finished parsing one block
+	} else {
+	    syntaxerr($file, _g("line with unknown format (not field-colon-value)"));
+	}
+    }
+    return $fields;
+}
+
+=back
+
+=cut
+1;

scripts/Dpkg/Changelog.pm

@@ -0,0 +1,865 @@
+#
+# Dpkg::Changelog
+#
+# Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
+#
+#    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
+#
+
+=head1 NAME
+
+Dpkg::Changelog
+
+=head1 DESCRIPTION
+
+to be written
+
+=head2 Functions
+
+=cut
+
+package Dpkg::Changelog;
+
+use strict;
+use warnings;
+
+use English;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(warning report syserr subprocerr);
+use Dpkg::Cdata;
+
+use base qw(Exporter);
+
+our %EXPORT_TAGS = ( 'util' => [ qw(
+                find_closes
+                data2rfc822
+                data2rfc822_mult
+                get_dpkg_changes
+		parse_changelog
+) ] );
+our @EXPORT_OK = @{$EXPORT_TAGS{util}};
+
+=pod
+
+=head3 init
+
+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>.
+
+If C<infile> or C<instring> are specified (see L<parse>), 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>!
+
+=cut
+
+sub init {
+    my $classname = shift;
+    my $config = shift || {};
+    my $self = {};
+    bless( $self, $classname );
+
+    $config->{verbose} = 1 if $config->{debug};
+    $self->{config} = $config;
+
+    $self->reset_parse_errors;
+
+    if ($self->{config}{infile} || $self->{config}{instring}) {
+	defined($self->parse) or return undef;
+    }
+
+    return $self;
+}
+
+=pod
+
+=head3 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.
+
+=cut
+
+sub reset_parse_errors {
+    my ($self) = @_;
+
+    $self->{errors}{parser} = [];
+}
+
+sub _do_parse_error {
+    my ($self, $file, $line_nr, $error, $line) = @_;
+    shift;
+
+    push @{$self->{errors}{parser}}, [ @_ ];
+
+    unless ($self->{config}{quiet}) {
+	if ($line) {
+	    warning("%20s(l$NR): $error\nLINE: $line", $file);
+	} else {
+	    warning("%20s(l$NR): $error", $file);
+	}
+    }
+}
+
+=pod
+
+=head3 get_parse_errors
+
+Returns all error messages from the last L<parse> run.
+If called in scalar context returns a human readable
+string representation. If called in list context returns
+an array of arrays. Each of these arrays contains
+
+=over 4
+
+=item 1.
+
+the filename of the parsed file or C<String> if a string was
+parsed directly
+
+=item 2.
+
+the line number where the error occurred
+
+=item 3.
+
+an error description
+
+=item 4.
+
+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}};
+    } else {
+	my $res = "";
+	foreach my $e (@{$self->{errors}{parser}}) {
+	    if ($e->[3]) {
+		$res .= report(_g('warning'),_g("%s(l%s): %s\nLINE: %s"), @$e );
+	    } else {
+		$res .= report(_g('warning'),_g("%s(l%s): %s"), @$e );
+	    }
+	}
+	return $res;
+    }
+}
+
+sub _do_fatal_error {
+    my ($self, $msg, @msg) = @_;
+
+    $self->{errors}{fatal} = report(_g('fatal error'), $msg, @msg);
+    warning($msg, @msg) unless $self->{config}{quiet};
+}
+
+=pod
+
+=head3 get_error
+
+Get the last non-parser error (e.g. the file to parse couldn't be opened).
+
+=cut
+
+sub get_error {
+    my ($self) = @_;
+
+    return $self->{errors}{fatal};
+}
+
+=pod
+
+=head3 data
+
+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.
+
+This method supports the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=cut
+
+sub data {
+    my ($self, $config) = @_;
+
+    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 (($$start || $$end) && ($$from || $$since || $$to || $$until)) {
+	warning(_g( "you can't combine 'count' or 'offset' with any other range option" ));
+	$$from = $$since = $$to = $$until = '';
+    }
+    if ($$from && $$since) {
+	warning(_g( "you can only specify one of 'from' and 'since', using 'since'" ));
+	$$from = '';
+    }
+    if ($$to && $$until) {
+	warning(_g( "you can only specify one of 'to' and 'until', using 'until'" ));
+	$$to = '';
+    }
+    if ($$since && ($data->[0]{Version} eq $$since)) {
+	warning(_g( "'since' option specifies most recent version, ignoring" ));
+	$$since = '';
+    }
+    if ($$until && ($data->[$#{$data}]{Version} eq $$until)) {
+	warning(_g( "'until' option specifies oldest version, ignoring" ));
+	$$until = '';
+    }
+    $$start = 0 if $$start < 0;
+    return if $$start > $#$data;
+    $$end = $#$data if $$end > $#$data;
+    return if $$end < 0;
+    $$end = $$start if $$end < $$start;
+    #TODO: compare versions
+    return 1;
+}
+
+sub _data_range {
+    my ($self, $config) = @_;
+
+    my $data = $self->data or return undef;
+
+    return [ @$data ] if $config->{all};
+
+    my $since = $config->{since} || '';
+    my $until = $config->{until} || '';
+    my $from = $config->{from} || '';
+    my $to = $config->{to} || '';
+    my $count = $config->{count} || 0;
+    my $offset = $config->{offset} || 0;
+
+    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;
+    }
+    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 ($from or $to or $since or $until or $start or $end) {
+	return [ @$data ] if $config->{default_all} and not $count;
+	return [ $data->[0] ];
+    }
+
+    return [ @{$data}[$start .. $end] ] if $start or $end;
+
+    my @result;
+
+    my $include = 1;
+    $include = 0 if $to or $until;
+    foreach (@$data) {
+	my $v = $_->{Version};
+	$include = 1 if $v eq $to;
+	last if $v eq $since;
+
+	push @result, $_ if $include;
+
+	$include = 1 if $v eq $until;
+	last if $v eq $from;
+    }
+
+    return \@result;
+}
+
+sub _abort_early {
+    my ($self) = @_;
+
+    my $data = $self->data or return;
+    my $config = $self->{config} or return;
+
+#    use Data::Dumper;
+#    warn "Abort early? (\$# = $#$data)\n".Dumper($config);
+
+    return if $config->{all};
+
+    my $since = $config->{since} || '';
+    my $until = $config->{until} || '';
+    my $from = $config->{from} || '';
+    my $to = $config->{to} || '';
+    my $count = $config->{count} || 0;
+    my $offset = $config->{offset} || 0;
+
+    return if $offset and not $count;
+    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 ($from or $to or $since or $until or $start or $end) {
+	return if not $count;
+	return 1 if @$data;
+    }
+
+    return 1 if ($start or $end)
+	and $start < @$data and $end < @$data;
+
+    return unless $since or $from;
+    foreach (@$data) {
+	my $v = $_->{Version};
+
+	return 1 if $v eq $since;
+	return 1 if $v eq $from;
+    }
+
+    return;
+}
+
+=pod
+
+=head3 dpkg
+
+(and B<dpkg_str>)
+
+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:
+
+=over 4
+
+=item Source
+
+package name (in the first entry)
+
+=item Version
+
+packages' version (from first entry)
+
+=item Distribution
+
+target distribution (from first entry)
+
+=item Urgency
+
+urgency (highest of all printed entries)
+
+=item Maintainer
+
+person that created the (first) entry
+
+=item Date
+
+date of the (first) entry
+
+=item Closes
+
+bugs closed by the entry/entries, sorted by bug number
+
+=item Changes
+
+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 ( %FIELDIMPS, %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));
+}
+
+sub dpkg {
+    my ($self, $config) = @_;
+
+    $self->{config}{DPKG} = $config if $config;
+
+    $config = $self->{config}{DPKG} || {};
+    my $data = $self->_data_range( $config ) or return undef;
+
+    my %f;
+    foreach my $field (qw( Urgency Source Version
+			   Distribution Maintainer Date )) {
+	$f{$field} = $data->[0]{$field};
+    }
+
+    $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}};
+    }
+
+    $f{Closes} = join " ", sort { $a <=> $b } @{$f{Closes}};
+    $f{Urgency} .= $urg_comment;
+
+    return %f if wantarray;
+    return \%f;
+}
+
+sub dpkg_str {
+    return data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
+}
+
+=pod
+
+=head3 rfc822
+
+(and B<rfc822_str>)
+
+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>.
+
+=cut
+
+sub rfc822 {
+    my ($self, $config) = @_;
+
+    $self->{config}{RFC822} = $config if $config;
+
+    $config = $self->{config}{RFC822} || {};
+    my $data = $self->_data_range( $config ) or return undef;
+    my @out_data;
+
+    foreach my $entry (@$data) {
+	my %f;
+	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}};
+	push @out_data, \%f;
+    }
+
+    return @out_data if wantarray;
+    return \@out_data;
+}
+
+sub rfc822_str {
+    return data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
+}
+
+=pod
+
+=head1 COMMON OUTPUT OPTIONS
+
+The following options are supported by all output methods,
+all take a version number as value:
+
+=over 4
+
+=item since
+
+Causes changelog information from all versions strictly
+later than B<version> to be used.
+
+=item until
+
+Causes changelog information from all versions strictly
+earlier than B<version> to be used.
+
+=item from
+
+Similar to C<since> but also includes the information for the
+specified B<version> itself.
+
+=item to
+
+Similar to C<until> but also includes the information for the
+specified B<version> itself.
+
+=back
+
+The following options also supported by all output methods but
+don't take version numbers as values:
+
+=over 4
+
+=item all
+
+If set to a true value, all entries of the changelog are returned,
+this overrides all other options.
+
+=item count
+
+Expects a signed integer as value. Returns C<value> entries from the
+top of the changelog if set to a positive integer, and C<abs(value)>
+entries from the tail if set to a negative integer.
+
+=item offset
+
+Expects a signed integer as value. Changes the starting point for
+C<count>, either counted from the top (positive integer) or from
+the tail (negative integer). C<offset> has no effect if C<count>
+wasn't given as well.
+
+=back
+
+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
+
+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 find_closes
+
+Takes one string as argument and finds "Closes: #123456, #654321" statements
+as supported by the Debian Archive software in it. Returns all closed bug
+numbers in an array reference.
+
+=cut
+
+sub find_closes {
+    my $changes = shift;
+    my @closes = ();
+
+    while ($changes &&
+	   ($changes =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
+	push(@closes, $& =~ /\#?\s?(\d+)/g);
+    }
+
+    @closes = sort { $a <=> $b } @closes;
+    return \@closes;
+}
+
+=pod
+
+=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.
+
+Return 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
+
+=head3 data2rfc822_mult
+
+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.
+
+=cut
+
+sub data2rfc822_mult {
+    my ($data, $fieldimps) = @_;
+    my @rfc822 = ();
+
+    foreach my $entry (@$data) {
+	push @rfc822, data2rfc822($entry,$fieldimps);
+    }
+
+    return join "\n", @rfc822;
+}
+
+=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 $changes = "\n ".($_[0]->Header||'')."\n .\n".($_[0]->Changes||'');
+    chomp $changes;
+    $changes =~ s/^ $/ ./mgo;
+    return $changes;
+}
+
+=pod
+
+=head3 parse_changelog($file, $format, $since)
+
+Calls "dpkg-parsechangelog -l$file -F$format -v$since"  and returns a
+Dpkg::Cdata::Object with the values output by the program.
+
+=cut
+sub parse_changelog {
+    my ($changelogfile, $changelogformat, $since) = @_;
+
+    my @exec = ('dpkg-parsechangelog');
+    push(@exec, "-l$changelogfile");
+    push(@exec, "-F$changelogformat") if defined($changelogformat);
+    push(@exec, "-v$since") if defined($since);
+
+    open(PARSECH, "-|", @exec) || syserr(_g("fork for parse changelog"));
+    my $fields = parsecdata(\*PARSECH, _g("parsed version of changelog"));
+    close(PARSECH) || subprocerr(_g("parse changelog"));
+    return $fields;
+}
+
+=head1 NAME
+
+Dpkg::Changelog::Entry - represents one entry in a Debian changelog
+
+=head1 SYNOPSIS
+
+=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(@_);
+}
+
+sub init {
+    my $classname = shift;
+    my $self = {};
+    bless( $self, $classname );
+
+    return $self;
+}
+
+sub is_empty {
+    my ($self) = @_;
+
+    return !($self->{Changes}
+	     || $self->{Source}
+	     || $self->{Version}
+	     || $self->{Maintainer}
+	     || $self->{Date});
+}
+
+1;
+__END__
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright E<copy> 2005, 2007 by Frank Lichtenheld
+
+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
+
+=cut

scripts/Dpkg/Changelog/Debian.pm

@@ -0,0 +1,358 @@
+#
+# Dpkg::Changelog::Debian
+#
+# Copyright 1996 Ian Jackson
+# Copyright 2005 Frank Lichtenheld <frank@lichtenheld.de>
+#
+#    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
+#
+
+=head1 NAME
+
+Dpkg::Changelog::Debian - parse Debian changelogs
+
+=head1 SYNOPSIS
+
+    use Parse::DebianChangelog;
+
+    my $chglog = Parse::DebianChangelog->init( { infile => 'debian/changelog',
+                                                 HTML => { outfile => 'changelog.html' } );
+    $chglog->html;
+
+    # the following is semantically equivalent
+    my $chglog = Parse::DebianChangelog->init();
+    $chglog->parse( { infile => 'debian/changelog' } );
+    $chglog->html( { outfile => 'changelog.html' } );
+
+    my $changes = $chglog->dpkg_str( { since => '1.0-1' } );
+    print $changes;
+
+=head1 DESCRIPTION
+
+Dpkg::Changelog::Debian parses Debian changelogs as described in the Debian
+policy (version 3.6.2.1 at the time of this writing). See section
+L<"SEE ALSO"> for locations where to find this definition.
+
+The parser tries to ignore most cruft like # or /* */ style comments,
+CVS comments, vim variables, emacs local variables and stuff from
+older changelogs with other formats at the end of the file.
+NOTE: most of these are ignored silently currently, there is no
+parser error issued for them. This should become configurable in the
+future.
+
+=head2 METHODS
+
+=cut
+
+package Dpkg::Changelog::Debian;
+
+use strict;
+use warnings;
+
+use Fcntl qw( :flock );
+use English;
+use Date::Parse;
+
+use Dpkg;
+use Dpkg::Gettext;
+use Dpkg::Changelog qw( :util );
+use base qw(Dpkg::Changelog);
+
+=pod
+
+=head3 parse
+
+Parses either the file named in configuration item C<infile> or the string
+saved in configuration item C<instring>.
+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.
+
+=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 (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;
+    }
+
+    $self->reset_parse_errors;
+
+    $self->{data} = [];
+
+# based on /usr/lib/dpkg/parsechangelog/debian
+    my $expect='first heading';
+    my $entry = Dpkg::Changelog::Entry->init();
+    my $blanklines = 0;
+    my $unknowncounter = 1; # to make version unique, e.g. for using as id
+
+    while (<$fh>) {
+	s/\s*\n$//;
+#	printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
+	if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
+	    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}});
+	    }
+	    unless ($entry->is_empty) {
+		$entry->{'Closes'} = find_closes( $entry->{Changes} );
+#		    print STDERR, Dumper($entry);
+		push @{$self->{data}}, $entry;
+		$entry = Dpkg::Changelog::Entry->init();
+		last if $self->_abort_early;
+	    }
+	    {
+		$entry->{'Source'} = "$1";
+		$entry->{'Version'} = "$2";
+		$entry->{'Header'} = "$_";
+		($entry->{'Distribution'} = "$3") =~ s/^\s+//;
+		$entry->{'Changes'} = $entry->{'Urgency_Comment'} = '';
+		$entry->{'Urgency'} = $entry->{'Urgency_LC'} = 'unknown';
+	    }
+	    (my $rhs = $POSTMATCH) =~ s/^\s+//;
+	    my %kvdone;
+#	    print STDERR "RHS: $rhs\n";
+	    for my $kv (split(/\s*,\s*/,$rhs)) {
+		$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
+		    $self->_do_parse_error($file, $NR,
+					   sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
+		my $k = ucfirst $1;
+		my $v = $2;
+		$kvdone{$k}++ && $self->_do_parse_error($file, $NR,
+							sprintf(_g("repeated key-value %s"), $k));
+		if ($k eq 'Urgency') {
+		    $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
+			$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->{ExtraFields}{"XS-$k"} = $v;
+		}
+	    }
+	    $expect= 'start of change data';
+	    $blanklines = 0;
+	} elsif (m/^(;;\s*)?Local variables:/io) {
+	    last; # skip Emacs variables at end of file
+	} elsif (m/^vim:/io) {
+	    last; # skip vim variables at end of file
+	} elsif (m/^\$\w+:.*\$/o) {
+	    next; # skip stuff that look like a CVS keyword
+	} elsif (m/^\# /o) {
+	    next; # skip comments, even that's not supported
+	} elsif (m,^/\*.*\*/,o) {
+	    next; # more comments
+	} elsif (m/^(\w+\s+\w+\s+\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}\s+[\w\s]*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+		 || m/^(\w+\s+\w+\s+\d{1,2},?\s*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+		 || m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)\;?/io
+		 || m/^([\w.+-]+)(-| )(\S+) Debian (\S+)/io
+		 || m/^Changes from version (.*) to (.*):/io
+		 || m/^Changes for [\w.+-]+-[\w.+-]+:?$/io
+		 || m/^Old Changelog:$/io
+		 || m/^(?:\d+:)?\w[\w.+~-]*:?$/o) {
+	    # 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>;
+	} 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+\([^\\\(\)]\))?)$/o) {
+	    $expect eq 'more change data or trailer' ||
+		$self->_do_parse_error($file, $NR,
+				       sprintf(_g("found trailer where expected %s"),
+					       $expect), "$_");
+	    if ($3 ne '  ') {
+		$self->_do_parse_error($file, $NR,
+				       _g( "badly formatted trailer line" ),
+				       "$_");
+	    }
+	    $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"));
+		}
+	    }
+	    $expect = 'next heading or eof';
+	} elsif (m/^ \-\-/) {
+	    $entry->{ERROR} = [ $file, $NR,
+				_g( "badly formatted trailer line" ), "$_" ];
+	    $self->_do_parse_error(@{$entry->{ERROR}});
+#	    $expect = 'next heading or eof'
+#		if $expect eq 'more change data or trailer';
+	} elsif (m/^\s{2,}(\S)/) {
+	    $expect eq 'start of change data'
+		|| $expect eq 'more change data or trailer'
+		|| do {
+		    $self->_do_parse_error($file, $NR,
+					   sprintf(_g("found change data where expected %s"),
+						   $expect), "$_");
+		    if (($expect eq 'next heading or eof')
+			&& !$entry->is_empty) {
+			# lets assume we have missed the actual header line
+			$entry->{'Closes'} = find_closes( $entry->{Changes} );
+#		    print STDERR, Dumper($entry);
+			push @{$self->{data}}, $entry;
+			$entry = Dpkg::Changelog::Entry->init();
+			$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->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+	    if (!$entry->{'Items'} || ($1 eq '*')) {
+		$entry->{'Items'} ||= [];
+		push @{$entry->{'Items'}}, "$_\n";
+	    } else {
+		$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+	    }
+	    $blanklines = 0;
+	    $expect = 'more change data or trailer';
+	} elsif (!m/\S/) {
+	    next if $expect eq 'start of change data'
+		|| $expect eq 'next heading or eof';
+	    $expect eq 'more change data or trailer'
+		|| $self->_do_parse_error($file, $NR,
+					  sprintf(_g("found blank line where expected %s"),
+						  $expect));
+	    $blanklines++;
+	} else {
+	    $self->_do_parse_error($file, $NR, _g( "unrecognised line" ),
+				   "$_");
+	    ($expect eq 'start of change data'
+		|| $expect eq 'more change data or trailer')
+		&& do {
+		    # lets assume change data if we expected it
+		    $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+		    if (!$entry->{'Items'}) {
+			$entry->{'Items'} ||= [];
+			push @{$entry->{'Items'}}, "$_\n";
+		    } else {
+			$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+		    }
+		    $blanklines = 0;
+		    $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}} );
+	};
+    unless ($entry->is_empty) {
+	$entry->{'Closes'} = find_closes( $entry->{Changes} );
+	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;
+	};
+    }
+
+#    use Data::Dumper;
+#    print Dumper( $self );
+
+    return $self;
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Dpkg::Changelog
+
+Description of the Debian changelog format in the Debian policy:
+L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Frank Lichtenheld
+
+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
+
+=cut

scripts/Dpkg/Control.pm

@@ -0,0 +1,169 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Control;
+
+use strict;
+use warnings;
+
+use Dpkg::Cdata;
+use Dpkg::ErrorHandling qw(syserr syntaxerr);
+use Dpkg::Gettext;
+
+=head1 NAME
+
+Dpkg::Control - parse files like debian/control
+
+=head1 DESCRIPTION
+
+It provides an object to access data of files that follow the same
+syntax than debian/control.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $c = Dpkg::Control->new($file)
+
+Create a new Dpkg::Control object for $file. If $file is omitted, it parses
+debian/control.
+
+=cut
+sub new {
+    my ($this, $arg) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	'source' => undef,
+	'packages' => [],
+    };
+    bless $self, $class;
+    if ($arg) {
+	$self->parse($arg);
+    } else {
+	$self->parse("debian/control");
+    }
+    return $self;
+}
+
+=item $c->reset()
+
+Resets what got read.
+
+=cut
+sub reset {
+    my $self = shift;
+    $self->{source} = undef;
+    $self->{packages} = [];
+}
+
+=item $c->parse($file)
+
+Parse the content of $file. Exits in case of errors.
+
+=cut
+sub parse {
+    my ($self, $file) = @_;
+    $self->reset();
+    # Parse
+    open(CDATA, "<", $file) || syserr(_g("cannot read %s"), $file);
+    my $cdata = parsecdata(\*CDATA, $file);
+    return if not defined $cdata;
+    $self->{source} = $cdata;
+    unless (exists $cdata->{Source}) {
+	syntaxerr($file, _g("first block lacks a source field"));
+    }
+    while (1) {
+	$cdata = parsecdata(\*CDATA, $file);
+	last if not defined $cdata;
+	push @{$self->{packages}}, $cdata;
+	unless (exists $cdata->{Package}) {
+	    syntaxerr($file, _g("block lacks a package field"));
+	}
+    }
+    close(CDATA);
+}
+
+=item $c->get_source()
+
+Returns a reference to a hash containing the fields concerning the
+source package. The hash is tied to Dpkg::Cdata::Object.
+
+=cut
+sub get_source {
+    my $self = shift;
+    return $self->{source};
+}
+
+=item $c->get_pkg_by_idx($idx)
+
+Returns a reference to a hash containing the fields concerning the binary
+package numbered $idx (starting at 1). The hash is tied to
+Dpkg::Cdata::Object.
+
+=cut
+sub get_pkg_by_idx {
+    my ($self, $idx) = @_;
+    return $self->{packages}[--$idx];
+}
+
+=item $c->get_pkg_by_name($name)
+
+Returns a reference to a hash containing the fields concerning the binary
+package named $name. The hash is tied to Dpkg::Cdata::Object.
+
+=cut
+sub get_pkg_by_name {
+    my ($self, $name) = @_;
+    foreach my $pkg (@{$self->{packages}}) {
+	return $pkg if ($pkg->{Package} eq $name);
+    }
+    return undef;
+}
+
+
+=item $c->get_packages()
+
+Returns a list containing the hashes for all binary packages.
+
+=cut
+sub get_packages {
+    my $self = shift;
+    return @{$self->{packages}};
+}
+
+=item $c->dump($filehandle)
+
+Dump the content into a filehandle.
+
+=cut
+sub dump {
+    my ($self, $fh) = @_;
+    tied(%{$self->{source}})->dump($fh);
+    foreach my $pkg (@{$self->{packages}}) {
+	print $fh "\n";
+	tied(%{$pkg})->dump($fh);
+    }
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphael Hertzog <hertzog@debian.org>.
+
+=cut
+
+1;

scripts/Dpkg/ErrorHandling.pm

@@ -5,7 +5,8 @@ use Dpkg::Gettext;
 
 use base qw(Exporter);
 our @EXPORT_OK = qw(warning warnerror error failure unknown syserr internerr
-                    subprocerr usageerr $warnable_error $quiet_warnings);
+                    subprocerr usageerr syntaxerr report
+		    $warnable_error $quiet_warnings);
 
 our $warnable_error = 1;
 our $quiet_warnings = 0;
@@ -89,4 +90,9 @@ sub usageerr(@)
     exit(2);
 }
 
+sub syntaxerr {
+    my ($file, $msg) = @_;
+    error(_g("syntax error in %s at line %d: %s"), $file, $., $msg);
+}
+
 1;

scripts/Dpkg/Fields.pm

@@ -37,4 +37,142 @@ sub sort_field_by_importance($$)
     }
 }
 
+package Dpkg::Fields::Object;
+
+=head1 OTHER OBJECTS
+
+=head2 Dpkg::Fields::Object
+
+This object is used to tie a hash. It implements hash-like functions by
+normalizing the name of fields received in keys (using
+Dpkg::Fields::capit). It also stores the order in which fields have been
+added in order to be able to dump them in the same order.
+
+You can also dump the content of the hash with tied(%hash)->dump($fh).
+
+=cut
+use Tie::Hash;
+our @ISA = qw(Tie::ExtraHash Tie::Hash);
+
+use Dpkg::ErrorHandling qw(internerr syserr);
+
+# Import capit
+Dpkg::Fields->import('capit', 'sort_field_by_importance');
+
+# $self->[0] is the real hash
+# $self->[1] is an array containing the ordered list of keys
+
+=head2 Dpkg::Fields::Object->new()
+
+Return a reference to a tied hash implementing storage of simple
+"field: value" mapping as used in many Debian-specific files.
+
+=cut
+sub new {
+    my $hash = {};
+    tie %{$hash}, 'Dpkg::Fields::Object';
+    return $hash;
+}
+
+sub TIEHASH  {
+    my $class = shift;
+    return bless [{}, []], $class;
+}
+
+sub FETCH {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    return $self->[0]->{$key} if exists $self->[0]->{$key};
+    return undef;
+}
+
+sub STORE {
+    my ($self, $key, $value) = @_;
+    $key = capit($key);
+    if (not exists $self->[0]->{$key}) {
+	push @{$self->[1]}, $key;
+    }
+    $self->[0]->{$key} = $value;
+}
+
+sub EXISTS {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    return exists $self->[0]->{$key};
+}
+
+sub DELETE {
+    my ($self, $key) = @_;
+    $key = capit($key);
+    if (exists $self->[0]->{$key}) {
+	delete $self->[0]->{$key};
+	@{$self->[1]} = grep { $_ ne $key } @{$self->[1]};
+	return 1;
+    } else {
+	return 0;
+    }
+}
+
+sub FIRSTKEY {
+    my $self = shift;
+    foreach (@{$self->[1]}) {
+	return $_ if exists $self->[0]->{$_};
+    }
+}
+
+sub NEXTKEY {
+    my ($self, $last) = @_;
+    my $found = 0;
+    foreach (@{$self->[1]}) {
+	if ($found) {
+	    return $_ if exists $self->[0]->{$_};
+	} else {
+	    $found = 1 if $_ eq $last;
+	}
+    }
+    return undef;
+}
+
+sub dump {
+    my ($self, $fh) = @_;
+    foreach (@{$self->[1]}) {
+	if (exists $self->[0]->{$_}) {
+	    print $fh "$_: " . $self->[0]->{$_} . "\n";
+	}
+    }
+}
+
+sub output {
+    my ($self, $fh, $substvars) = @_;
+
+    # Add substvars to refer to other fields
+    if (defined($substvars)) {
+	foreach my $f (keys %{$self->[0]}) {
+	    $substvars->set("F:$f", $self->[0]->{$f});
+	}
+    }
+
+    for my $f (sort sort_field_by_importance keys %{$self->[0]}) {
+        my $v = $self->[0]->{$f};
+        if (defined($substvars)) {
+            $v = $substvars->substvars($v);
+        }
+        $v =~ m/\S/ || next; # delete whitespace-only fields
+        $v =~ m/\n\S/ &&
+            internerr(_g("field %s has newline then non whitespace >%s<"),
+                      $f, $v);
+        $v =~ m/\n[ \t]*\n/ &&
+            internerr(_g("field %s has blank lines >%s<"), $f, $v);
+        $v =~ m/\n$/ &&
+            internerr(_g("field %s has trailing newline >%s<"), $f, $v);
+        if (defined($substvars)) {
+           $v =~ s/,[\s,]*,/,/g;
+           $v =~ s/^\s*,\s*//;
+           $v =~ s/\s*,\s*$//;
+        }
+        $v =~ s/\$\{\}/\$/g;
+        print $fh "$f: $v\n" || syserr(_g("write error on control data"));
+    }
+}
+
 1;

scripts/Dpkg/Substvars.pm

@@ -0,0 +1,185 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Substvars;
+
+use strict;
+use warnings;
+
+use Dpkg qw($version);
+use Dpkg::Arch qw(get_host_arch);
+use Dpkg::ErrorHandling qw(error warning);
+use Dpkg::Gettext;
+
+use POSIX qw(:errno_h);
+use English;
+
+my $maxsubsts = 50;
+
+=head1 NAME
+
+Dpkg::Substvars - handle variable substitution in strings
+
+=head1 DESCRIPTION
+
+It provides some an object which is able to substitute variables in
+strings.
+
+=head1 METHODS
+
+=over 8
+
+=item my $s = Dpkg::Substvars->new($file)
+
+Create a new object that can do substitutions. By default it contains
+generic substitutions like ${Newline}, ${Space}, ${Tab}, ${dpkg:Version},
+${dpkg:Upstream-Version} and ${Arch}.
+
+Additional substitutions will be read from the $file passed as parameter.
+
+=cut
+sub new {
+    my ($this, $arg) = @_;
+    my $class = ref($this) || $this;
+    my $self = {
+	"Newline" => "\n",
+	"Space" => " ",
+	"Tab" => "\t",
+	"dpkg:Version" => $version,
+	"dpkg:Upstream-Version" => $version,
+	"Arch" => get_host_arch(),
+    };
+    $self->{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
+    bless $self, $class;
+    if ($arg) {
+        $self->parse($arg);
+    }
+    return $self;
+}
+
+=item $s->set($key, $value)
+
+Add/replace a substitution.
+
+=cut
+sub set {
+    my ($self, $key, $value) = @_;
+    $self->{$key} = $value;
+}
+
+=item $s->get($key)
+
+Get the value of a given substitution.
+
+=cut
+sub get {
+    my ($self, $key) = @_;
+    return $self->{$key};
+}
+
+=item $s->delete($key)
+
+Remove a given substitution.
+
+=cut
+sub delete {
+    my ($self, $key) = @_;
+    return delete $self->{$key};
+}
+
+=item $s->parse($file)
+
+Add new substitutions read from $file.
+
+=cut
+sub parse {
+    my ($self, $varlistfile) = @_;
+    $varlistfile="./$varlistfile" if $varlistfile =~ m/\s/;
+    if (open(SV, "<", $varlistfile)) {
+	binmode(SV);
+	while (<SV>) {
+	    next if m/^\#/ || !m/\S/;
+	    s/\s*\n$//;
+	    m/^(\w[-:0-9A-Za-z]*)\=/ ||
+		error(_g("bad line in substvars file %s at line %d"),
+		      $varlistfile, $.);
+	    $self->{$1} = $';
+	}
+	close(SV);
+    } elsif ($! != ENOENT ) {
+	error(_g("unable to open substvars file %s: %s"), $varlistfile, $!);
+    }
+}
+
+=item $s->set_version_substvars($version)
+
+Defines ${binary:Version}, ${source:Version} and
+${source:Upstream-Version} based on the given version string.
+
+=cut
+sub set_version_substvars {
+    my ($self, $version) = @_;
+
+    $self->{'binary:Version'} = $version;
+    $self->{'source:Version'} = $version;
+    $self->{'source:Version'} =~ s/\+b[0-9]+$//;
+    $self->{'source:Upstream-Version'} = $version;
+    $self->{'source:Upstream-Version'} =~ s/-[^-]*$//;
+
+    # XXX: Source-Version is now deprecated, remove in the future.
+    $self->{'Source-Version'} = $version;
+}
+
+=item $newstring = $s->substvars($string)
+
+Substitutes variables in $string and return the result in $newstring.
+
+=cut
+sub substvars {
+    my ($self, $v) = @_;
+    my $lhs;
+    my $vn;
+    my $rhs = '';
+    my $count = 0;
+
+    while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
+        # If we have consumed more from the leftover data, then
+        # reset the recursive counter.
+        $count = 0 if (length($POSTMATCH) < length($rhs));
+
+        $count < $maxsubsts ||
+            error(_g("too many substitutions - recursive ? - in \`%s'"), $v);
+        $lhs = $PREMATCH; $vn = $1; $rhs = $POSTMATCH;
+        if (defined($self->{$vn})) {
+            $v = $lhs . $self->{$vn} . $rhs;
+            $count++;
+        } else {
+            warning(_g("unknown substitution variable \${%s}"), $vn);
+            $v = $lhs . $rhs;
+        }
+    }
+    return $v;
+}
+
+=back
+
+=head1 AUTHOR
+
+Raphael Hertzog <hertzog@debian.org>.
+
+=cut
+
+1;

scripts/Dpkg/Vars.pm

@@ -0,0 +1,53 @@
+# Copyright 2007 Raphaël Hertzog <hertzog@debian.org>
+
+# 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package Dpkg::Vars;
+
+use strict;
+use warnings;
+
+use Dpkg::ErrorHandling qw(error);
+use Dpkg::Gettext;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw($sourcepackage set_source_package);
+
+our $sourcepackage;
+
+sub check_package_name {
+    my $name = shift || '';
+    $name =~ m/[^-+.0-9a-z]/o &&
+        error(_g("source package name `%s' contains illegal character `%s'"),
+              $name, $&);
+    $name =~ m/^[0-9a-z]/o ||
+        error(_g("source package name `%s' starts with non-alphanum"), $name);
+}
+
+sub set_source_package {
+    my $v = shift;
+
+    check_package_name($v);
+    if (defined($sourcepackage)) {
+        $v eq $sourcepackage ||
+            error(_g("source package has two conflicting values - %s and %s"),
+                  $sourcepackage, $v);
+    } else {
+        $sourcepackage = $v;
+    }
+}
+
+1;

scripts/Dpkg/Version.pm

@@ -21,9 +21,11 @@ package Dpkg::Version;
 use strict;
 use warnings;
 
+use Dpkg::ErrorHandling qw(error);
+
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(vercmp compare_versions);
+our @EXPORT_OK = qw(vercmp compare_versions check_version);
 
 =head1 NAME
 
@@ -192,6 +194,17 @@ sub compare_versions ($$$)
     }
 }
 
+=item check_version($version)
+
+Check the version string and fails it it's invalid.
+
+=cut
+sub check_version ($) {
+    my $version = shift || '';
+    $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
+        error(_g("version number contains illegal character `%s'"), $&);
+}
+
 =back
 
 =head1 AUTHOR

scripts/Makefile.am

@@ -69,7 +69,13 @@ EXTRA_DIST = \
 	t/200_Dpkg_Shlibs/objdump.ls \
 	t/300_Dpkg_BuildOptions.t \
 	t/400_Dpkg_Deps.t \
-	t/500_Dpkg_Path.t
+	t/500_Dpkg_Path.t \
+	t/600_Dpkg_Changelog.t \
+	t/600_Dpkg_Changelog/countme \
+	t/600_Dpkg_Changelog/misplaced-tz \
+	t/600_Dpkg_Changelog/shadow \
+	t/700_Dpkg_Control.t \
+	t/700_Dpkg_Control/control-1
 
 CLEANFILES = \
 	$(bin_SCRIPTS) $(sbin_SCRIPTS) $(changelog_SCRIPTS) \
@@ -79,22 +85,24 @@ perllibdir = $(PERL_LIBDIR)
 nobase_dist_perllib_DATA = \
 	Dpkg/Arch.pm \
 	Dpkg/BuildOptions.pm \
+	Dpkg/Cdata.pm \
+	Dpkg/Changelog.pm \
+	Dpkg/Changelog/Debian.pm \
 	Dpkg/Compression.pm \
-	Dpkg/ErrorHandling.pm \
+	Dpkg/Control.pm \
 	Dpkg/Deps.pm \
+	Dpkg/ErrorHandling.pm \
 	Dpkg/Fields.pm \
 	Dpkg/Gettext.pm \
 	Dpkg/Path.pm \
 	Dpkg/Shlibs.pm \
 	Dpkg/Shlibs/Objdump.pm \
 	Dpkg/Shlibs/SymbolFile.pm \
+	Dpkg/Substvars.pm \
+	Dpkg/Vars.pm \
 	Dpkg/Version.pm \
 	Dpkg.pm
 
-dist_pkglib_SCRIPTS = \
-	controllib.pl
-
-
 do_perl_subst = sed -e "s:^\#![:space:]*/usr/bin/perl:\#!$(PERL):" \
 		    -e "s:\$$dpkglibdir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$dpkglibdir=\"$(pkglibdir)\":" \
 		    -e "s:\$$pkgdatadir[[:space:]]*=[[:space:]]*['\"][^'\"]*['\"]:\$$pkgdatadir=\"$(pkgdatadir)\":" \

scripts/changelog/debian.pl

@@ -3,35 +3,24 @@
 use strict;
 use warnings;
 
+use Getopt::Long qw(:config gnu_getopt auto_help);
+use POSIX;
+
 use Dpkg;
 use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(error internerr usageerr);
-use Dpkg::Fields qw(set_field_importance);
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %f;
+use Dpkg::ErrorHandling qw(usageerr failure);
+use Dpkg::Changelog::Debian;
 
 textdomain("dpkg-dev");
 
-my $controlfile = 'debian/control';
-my $changelogfile = 'debian/changelog';
-my $fileslistfile = 'debian/files';
-my $since = '';
-my %mapkv = (); # XXX: for future use
-
-my @changelog_fields = qw(Source Version Distribution Urgency Maintainer
-                          Date Closes Changes);
-
 $progname = "parsechangelog/$progname";
 
-
 sub version {
     printf _g("Debian %s version %s.\n"), $progname, $version;
 
     printf _g("
-Copyright (C) 1996 Ian Jackson.");
+Copyright (C) 1996 Ian Jackson.
+Copyright (C) 2005,2007 Frank Lichtenheld.");
     printf _g("
 This is free software; see the GNU General Public Licence version 2 or
 later for copying conditions. There is NO warranty.
@@ -40,152 +29,95 @@ later for copying conditions. There is NO warranty.
 
 sub usage {
     printf _g(
-"Usage: %s [<option>]
+"Usage: %s [<option>...] [<changelogfile>]
 
 Options:
-  -l<changelog>       use <changelog> as the file name when reporting.
-  -v<versionsince>    print changes since <versionsince>.
-  -h, --help          print this help message.
-      --version       print program version.
+    --help, -h                  print usage information
+    --version, -V               print version information
+    --file, -l <file>           changelog file to parse, defaults
+                                to 'debian/changelog'
+    --format <outputformat>     see man page for list of available
+                                output formats, defaults to 'dpkg'
+                                for compatibility with dpkg-dev
+    --since, -s, -v <version>   include all changes later than version
+    --until, -u <version>       include all changes earlier than version
+    --from, -f <version>        include all changes equal or later
+                                than version
+    --to, -t <version>          include all changes up to or equal
+                                than version
+    --count, -c, -n <number>    include <number> entries from the top
+                                (or the tail if <number> is lower than 0)
+    --offset, -o <number>       change the starting point for --count,
+                                counted from the top (or the tail if
+                                <number> is lower than 0)
+    --all                       include all changes
 "), $progname;
 }
 
-while (@ARGV) {
-    $_=shift(@ARGV);
-    if (m/^-v(.+)$/) {
-        $since= $1;
-    } elsif (m/^-l(.+)$/) {
-        $changelogfile = $1;
-    } elsif (m/^-(h|-help)$/) {
-        &usage; exit(0);
-    } elsif (m/^--version$/) {
-        &version; exit(0);
-    } else {
-        &usageerr(sprintf(_g("unknown option \`%s'"), $_));
+my ( $since, $until, $from, $to, $all, $count, $offset, $file );
+my $default_file = 'debian/changelog';
+my $format = 'dpkg';
+my %allowed_formats = (
+    dpkg => 1,
+    rfc822 => 1,
+    );
+
+sub set_format {
+    my ($opt, $val) = @_;
+
+    unless ($allowed_formats{$val}) {
+	usageerr(_g('output format %s not supported'), $val );
     }
+
+    $format = $val;
 }
 
-my %urgencies;
-my $i = 1;
-grep($urgencies{$_} = $i++, qw(low medium high critical emergency));
-
-my $expect = 'first heading';
-my $blanklines;
-
-while (<STDIN>) {
-    s/\s*\n$//;
-#    printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
-    if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-+0-9a-z.]+)+)\;/i) {
-        if ($expect eq 'first heading') {
-            $f{'Source'}= $1;
-            $f{'Version'}= $2;
-            $f{'Distribution'}= $3;
-            &error(_g("-v<since> option specifies most recent version")) if
-                $2 eq $since;
-            $f{'Distribution'} =~ s/^\s+//;
-        } elsif ($expect eq 'next heading or eof') {
-            last if $2 eq $since;
-            $f{'Changes'}.= " .\n";
-        } else {
-            &clerror(sprintf(_g("found start of entry where expected %s"), $expect));
-        }
-	my $rhs = $';
-	$rhs =~ s/^\s+//;
-	my %kvdone;
-	for my $kv (split(/\s*,\s*/, $rhs)) {
-            $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
-                &clerror(sprintf(_g("bad key-value after \`;': \`%s'"), $kv));
-	    my $k = (uc substr($1, 0, 1)).(lc substr($1, 1));
-	    my $v = $2;
-            $kvdone{$k}++ && &clwarn(sprintf(_g("repeated key-value %s"), $k));
-            if ($k eq 'Urgency') {
-                $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                    &clerror(_g("badly formatted urgency value"));
-
-		my $newurg = lc $1;
-		my $oldurg;
-		my $newurgn = $urgencies{lc $1};
-		my $oldurgn;
-		my $newcomment = $2;
-		my $oldcomment;
-
-                $newurgn ||
-                    &clwarn(sprintf(_g("unknown urgency value %s - comparing very low"), $newurg));
-                if (defined($f{'Urgency'})) {
-                    $f{'Urgency'} =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
-                        &internerr(sprintf(_g("urgency >%s<"), $f{'Urgency'}));
-                    $oldurg= lc $1;
-                    $oldurgn= $urgencies{lc $1}; $oldcomment= $2;
-                } else {
-                    $oldurgn= -1;
-                    $oldcomment= '';
-                }
-                $f{'Urgency'}=
-                    (($newurgn > $oldurgn ? $newurg : $oldurg).
-                     $oldcomment.
-                     $newcomment);
-            } elsif (defined($mapkv{$k})) {
-                $f{$mapkv{$k}}= $v;
-            } elsif ($k =~ m/^X[BCS]+-/i) {
-                # Extensions - XB for putting in Binary,
-                # XC for putting in Control, XS for putting in Source
-                $f{$k}= $v;
-            } else {
-                &clwarn(sprintf(_g("unknown key-value key %s - copying to %s"), $k, "XS-$k"));
-                $f{"XS-$k"}= $v;
-            }
-        }
-        $expect= 'start of change data'; $blanklines=0;
-        $f{'Changes'}.= " $_\n .\n";
-    } elsif (m/^\S/) {
-        &clerror(_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+\([^\\\(\)]\))?)$/) {
-        $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found trailer where expected %s"), $expect));
-        $f{'Maintainer'}= "$1 <$2>" unless defined($f{'Maintainer'});
-        $f{'Date'}= $3 unless defined($f{'Date'});
-#        $f{'Changes'}.= " .\n $_\n";
-        $expect= 'next heading or eof';
-        last if $since eq '';
-    } elsif (m/^ \-\-/) {
-        &clerror(_g("badly formatted trailer line"));
-    } elsif (m/^\s{2,}\S/) {
-        $expect eq 'start of change data' || $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found change data where expected %s"), $expect));
-        $f{'Changes'}.= (" .\n"x$blanklines)." $_\n"; $blanklines=0;
-        $expect= 'more change data or trailer';
-    } elsif (!m/\S/) {
-        next if $expect eq 'start of change data' || $expect eq 'next heading or eof';
-        $expect eq 'more change data or trailer' ||
-            &clerror(sprintf(_g("found blank line where expected %s"), $expect));
-        $blanklines++;
-    } else {
-        &clerror(_g("unrecognised line"));
+GetOptions( "file|l=s" => \$file,
+	    "since|v=s" => \$since,
+	    "until|u=s" => \$until,
+	    "from|f=s" => \$from,
+	    "to|t=s" => \$to,
+	    "count|c|n=i" => \$count,
+	    "offset|o=i" => \$offset,
+	    "help|h" => sub{usage();exit(0)},
+	    "version|V" => sub{version();exit(0)},
+	    "format=s" => \&set_format,
+	    "all|a" => \$all,
+	    )
+    or do { usage(); exit(2) };
+
+usageerr('too many arguments') if @ARGV > 1;
+
+if (@ARGV) {
+    if ($file && ($file ne $ARGV[0])) {
+	usageerr(_g('more than one file specified (%s and %s)'),
+		 $file, $ARGV[0] );
     }
+    $file = $ARGV[0];
 }
 
-$expect eq 'next heading or eof' || die sprintf(_g("found eof where expected %s"), $expect);
-
-$f{'Changes'} =~ s/\n$//;
-$f{'Changes'} =~ s/^/\n/;
-
-my @closes;
+my $changes = Dpkg::Changelog::Debian->init();
 
-while ($f{'Changes'} =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
-  push(@closes, $& =~ /\#?\s?(\d+)/g);
+$file ||= $default_file;
+unless ($since or $until or $from or $to or
+	$offset or $count or $all) {
+    $count = 1;
 }
-$f{'Closes'} = join(' ',sort { $a <=> $b} @closes);
-
-set_field_importance(@changelog_fields);
-outputclose();
-
-sub clerror
-{
-    &error(sprintf(_g("%s, at file %s line %d"), $_[0], $changelogfile, $.));
+my @all = $all ? ( all => $all ) : ();
+my $opts = { since => $since, until => $until,
+	     from => $from, to => $to,
+	     count => $count, offset => $offset,
+	     @all };
+
+if ($file eq '-') {
+    my @input = <STDIN>;
+    $changes->parse({ instring => join('', @input), %$opts })
+	or failure(_g('fatal error occured while parsing input'));
+} else {
+    $changes->parse({ infile => $file, %$opts })
+	or failure(_g('fatal error occured while parsing %s'),
+		   $file );
 }
 
-sub clwarn
-{
-    &warn(sprintf(_g("%s, at file %s line %d"), $_[0], $changelogfile, $.));
-}
 
+eval("print \$changes->${format}_str(\$opts)");

scripts/controllib.pl

@@ -1,332 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use English;
-use POSIX qw(:errno_h);
-use Dpkg;
-use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(warning error failure internerr syserr subprocerr);
-use Dpkg::Arch qw(get_host_arch debarch_is);
-use Dpkg::Fields qw(capit sort_field_by_importance);
-
-textdomain("dpkg-dev");
-
-our $sourcepackage; # - name of sourcepackage
-our %f;             # - fields ???
-our %fi;            # - map of fields values. keys are of the form "S# key"
-                    #   where S is source (L is changelog, C is control)
-                    #   and # is an index
-our %p2i;           # - map from datafile+packagename to index in controlfile
-                    #   (used if multiple packages can be listed). Key is
-                    #   "S key" where S is the source and key is the packagename
-
-my $maxsubsts = 50;
-our %substvar;      # - map with substitution variables
-
-my $parsechangelog = 'dpkg-parsechangelog';
-
-sub getfowner
-{
-    my $getlogin = getlogin();
-    if (!defined($getlogin)) {
-	open(SAVEIN, "<&STDIN");
-	open(STDIN, "<&STDERR");
-
-	$getlogin = getlogin();
-
-	close(STDIN);
-	open(STDIN, "<&SAVEIN");
-	close(SAVEIN);
-    }
-    if (!defined($getlogin)) {
-	open(SAVEIN, "<&STDIN");
-	open(STDIN, "<&STDOUT");
-
-	$getlogin = getlogin();
-
-	close(STDIN);
-	open(STDIN, "<&SAVEIN");
-	close(SAVEIN);
-    }
-
-    my @fowner;
-    if (defined($ENV{'LOGNAME'})) {
-	@fowner = getpwnam($ENV{'LOGNAME'});
-	if (!@fowner) {
-	    die(sprintf(_g('unable to get login information for username "%s"'), $ENV{'LOGNAME'}));
-	}
-    } elsif (defined($getlogin)) {
-	@fowner = getpwnam($getlogin);
-	if (!@fowner) {
-	    die(sprintf(_g('unable to get login information for username "%s"'), $getlogin));
-	}
-    } else {
-	warning(_g('no utmp entry available and LOGNAME not defined; ' .
-	           'using uid of process (%d)'), $<);
-	@fowner = getpwuid($<);
-	if (!@fowner) {
-	    die (sprintf(_g('unable to get login information for uid %d'), $<));
-	}
-    }
-    @fowner = @fowner[2,3];
-
-    return @fowner;
-}
-
-sub substvars {
-    my ($v) = @_;
-    my $lhs;
-    my $vn;
-    my $rhs = '';
-    my $count = 0;
-
-    while ($v =~ m/\$\{([-:0-9a-z]+)\}/i) {
-        # If we have consumed more from the leftover data, then
-        # reset the recursive counter.
-        $count= 0 if (length($POSTMATCH) < length($rhs));
-
-        $count < $maxsubsts ||
-            error(_g("too many substitutions - recursive ? - in \`%s'"), $v);
-        $lhs=$`; $vn=$1; $rhs=$';
-        if (defined($substvar{$vn})) {
-            $v= $lhs.$substvar{$vn}.$rhs;
-            $count++;
-        } else {
-	    warning(_g("unknown substitution variable \${%s}"), $vn);
-            $v= $lhs.$rhs;
-        }
-    }
-    return $v;
-}
-
-sub outputclose {
-    my ($varlistfile) = @_;
-
-    for my $f (keys %f) {
-	$substvar{"F:$f"} = $f{$f};
-    }
-
-    &parsesubstvars($varlistfile) if (defined($varlistfile));
-
-    for my $f (sort sort_field_by_importance keys %f) {
-	my $v = $f{$f};
-	if (defined($varlistfile)) {
-	    $v= &substvars($v);
-	}
-        $v =~ m/\S/ || next; # delete whitespace-only fields
-	$v =~ m/\n\S/ &&
-	    internerr(_g("field %s has newline then non whitespace >%s<"),
-	              $f, $v);
-	$v =~ m/\n[ \t]*\n/ &&
-	    internerr(_g("field %s has blank lines >%s<"), $f, $v);
-	$v =~ m/\n$/ &&
-	    internerr(_g("field %s has trailing newline >%s<"), $f, $v);
-	if (defined($varlistfile)) {
-	   $v =~ s/,[\s,]*,/,/g;
-	   $v =~ s/^\s*,\s*//;
-	   $v =~ s/\s*,\s*$//;
-	}
-        $v =~ s/\$\{\}/\$/g;
-        print("$f: $v\n") || &syserr(_g("write error on control data"));
-    }
-
-    close(STDOUT) || &syserr(_g("write error on close control data"));
-}
-
-sub parsecontrolfile {
-    my $controlfile = shift;
-
-    $controlfile="./$controlfile" if $controlfile =~ m/^\s/;
-
-    open(CDATA, "< $controlfile") ||
-        error(_g("cannot read control file %s: %s"), $controlfile, $!);
-    binmode(CDATA);
-    my $indices = parsecdata(\*CDATA, 'C', 1,
-			     sprintf(_g("control file %s"), $controlfile));
-    $indices >= 2 || &error(_g("control file must have at least one binary package part"));
-
-    for (my $i = 1; $i < $indices; $i++) {
-        defined($fi{"C$i Package"}) ||
-            error(_g("per-package paragraph %d in control " .
-                     "info file is missing Package line"), $i);
-    }
-    defined($fi{"C Source"}) ||
-        &error(_g("source paragraph in control info file is ".
-                       "missing Source line"));
-
-}
-
-my $substvarsparsed = 0;
-sub parsesubstvars {
-    my $varlistfile = shift;
-
-    if (length($varlistfile) && !$substvarsparsed) {
-        $varlistfile="./$varlistfile" if $varlistfile =~ m/\s/;
-        if (open(SV,"< $varlistfile")) {
-            binmode(SV);
-            while (<SV>) {
-                next if m/^\#/ || !m/\S/;
-                s/\s*\n$//;
-                m/^(\w[-:0-9A-Za-z]*)\=/ ||
-                    error(_g("bad line in substvars file %s at line %d"),
-                          $varlistfile, $.);
-                $substvar{$1}= $';
-            }
-            close(SV);
-        } elsif ($! != ENOENT ) {
-            error(_g("unable to open substvars file %s: %s"), $varlistfile, $!);
-        }
-        $substvarsparsed = 1;
-    }
-}
-
-sub parsechangelog {
-    my ($changelogfile, $changelogformat, $since) = @_;
-
-    defined(my $c = open(CDATA, "-|")) || syserr(_g("fork for parse changelog"));
-    if ($c) {
-	binmode(CDATA);
-	parsecdata(\*CDATA, 'L', 0, _g("parsed version of changelog"));
-	close(CDATA);
-	$? && subprocerr(_g("parse changelog"));
-    } else {
-	binmode(STDOUT);
-	my @al = ($parsechangelog);
-        push(@al,"-l$changelogfile");
-        push(@al, "-F$changelogformat") if defined($changelogformat);
-        push(@al, "-v$since") if defined($since);
-        exec(@al) || &syserr("exec parsechangelog $parsechangelog");
-    }
-}
-
-sub init_substvars
-{
-    $substvar{'Format'} = 1.7;
-    $substvar{'Newline'} = "\n";
-    $substvar{'Space'} = " ";
-    $substvar{'Tab'} = "\t";
-
-    # XXX: Source-Version is now deprecated, remove in the future.
-    $substvar{'Source-Version'}= $fi{"L Version"};
-    $substvar{'binary:Version'} = $fi{"L Version"};
-    $substvar{'source:Version'} = $fi{"L Version"};
-    $substvar{'source:Version'} =~ s/\+b[0-9]+$//;
-    $substvar{'source:Upstream-Version'} = $fi{"L Version"};
-    $substvar{'source:Upstream-Version'} =~ s/-[^-]*$//;
-
-    $substvar{"dpkg:Version"} = $version;
-    $substvar{"dpkg:Upstream-Version"} = $version;
-    $substvar{"dpkg:Upstream-Version"} =~ s/-[^-]+$//;
-}
-
-sub init_substvar_arch()
-{
-    $substvar{'Arch'} = get_host_arch();
-}
-
-sub checkpackagename {
-    my $name = shift || '';
-    $name =~ m/[^-+.0-9a-z]/o &&
-        error(_g("source package name `%s' contains illegal character `%s'"),
-              $name, $&);
-    $name =~ m/^[0-9a-z]/o ||
-        error(_g("source package name `%s' starts with non-alphanum"), $name);
-}
-
-sub checkversion {
-    my $version = shift || '';
-    $version =~ m/[^-+:.0-9a-zA-Z~]/o &&
-        error(_g("version number contains illegal character `%s'"), $&);
-}
-
-sub setsourcepackage {
-    my $v = shift;
-
-    checkpackagename( $v );
-    if (defined($sourcepackage)) {
-        $v eq $sourcepackage ||
-            error(_g("source package has two conflicting values - %s and %s"),
-                  $sourcepackage, $v);
-    } else {
-        $sourcepackage= $v;
-    }
-}
-
-sub readmd5sum {
-    (my $md5sum = shift) or return;
-    $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
-        || failure(_g("md5sum gave bogus output `%s'"), $md5sum);
-    return $md5sum;
-}
-
-# XXX: Should not be a global!!
-my $whatmsg;
-
-sub parsecdata {
-    my ($cdata, $source, $many);
-    ($cdata, $source, $many, $whatmsg) = @_;
-
-    # many=0: ordinary control data like output from dpkg-parsechangelog
-    # many=1: many paragraphs like in source control file
-    # many=-1: single paragraph of control data optionally signed
-
-    my $index = '';
-    my $cf = '';
-    my $paraborder = 1;
-
-    while (<$cdata>) {
-        s/\s*\n$//;
-	next if (m/^$/ and $paraborder);
-	next if (m/^#/);
-	$paraborder=0;
-        if (m/^(\S+?)\s*:\s*(.*)$/) {
-	    $cf = $1;
-	    my $v = $2;
-            $cf= &capit($cf);
-            $fi{"$source$index $cf"}= $v;
-            $fi{"o:$source$index $cf"}= $1;
-            if (lc $cf eq 'package') { $p2i{"$source $v"}= $index; }
-        } elsif (m/^\s+\S/) {
-            length($cf) || &syntax(_g("continued value line not in field"));
-            $fi{"$source$index $cf"}.= "\n$_";
-        } elsif (m/^-----BEGIN PGP/ && $many<0) {
-            $many == -2 && syntax(_g("expected blank line before PGP signature"));
-	    while (<$cdata>) {
-		last if m/^$/;
-	    }
-            $many= -2;
-        } elsif (m/^$/) {
-	    $paraborder = 1;
-            if ($many>0) {
-                $index++; $cf='';
-            } elsif ($many == -2) {
-		$_ = <$cdata> while defined($_) && $_ =~ /^\s*$/;
-                length($_) ||
-                    &syntax(_g("expected PGP signature, found EOF after blank line"));
-                s/\n$//;
-                m/^-----BEGIN PGP/ ||
-                    &syntax(sprintf(_g("expected PGP signature, found something else \`%s'"), $_));
-                $many= -3; last;
-            } else {
-		while (<$cdata>) {
-		    /^\s*$/ ||
-			&syntax(_g("found several \`paragraphs' where only one expected"));
-		}
-            }
-        } else {
-            &syntax(_g("line with unknown format (not field-colon-value)"));
-        }
-    }
-    $many == -2 && &syntax(_g("found start of PGP body but no signature"));
-    if (length($cf)) { $index++; }
-    $index || &syntax(_g("empty file"));
-    return $index;
-}
-
-sub syntax {
-    error(_g("syntax error in %s at line %d: %s"), $whatmsg, $., $_[0]);
-}
-
-1;

scripts/dpkg-buildpackage.pl

@@ -12,9 +12,7 @@ use Dpkg::ErrorHandling qw(warning error failure syserr subprocerr usageerr
                            $warnable_error);
 use Dpkg::BuildOptions;
 use Dpkg::Compression;
-
-push (@INC, $dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Version qw(check_version);
 
 textdomain("dpkg-dev");
 
@@ -282,7 +280,7 @@ sub mustsetvar {
 
 my $pkg = mustsetvar($changes{source}, _g('source package'));
 my $version = mustsetvar($changes{version}, _g('source version'));
-checkversion($version);
+check_version($version);
 
 my $maintainer;
 if ($changedby) {

scripts/dpkg-checkbuilddeps.pl

@@ -10,11 +10,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(error);
 use Dpkg::Arch qw(get_host_arch);
 use Dpkg::Deps;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %fi;
+use Dpkg::Control;
 
 textdomain("dpkg-dev");
 
@@ -46,7 +42,8 @@ if ($want_help) {
 
 my $controlfile = shift || "debian/control";
 
-parsecontrolfile($controlfile);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = $control->get_source();
 
 my $facts = parse_status("$admindir/status");
 my (@unmet, @conflicts);
@@ -54,24 +51,24 @@ my (@unmet, @conflicts);
 push @unmet, build_depends('Implicit-Build-Depends',
                            Dpkg::Deps::parse('build-essential'), $facts);
 
-if (defined($fi{"C Build-Depends"})) {
+if (defined($fields->{"Build-Depends"})) {
 	push @unmet, build_depends('Build-Depends',
-                                   Dpkg::Deps::parse($fi{"C Build-Depends"},
+                                   Dpkg::Deps::parse($fields->{"Build-Depends"},
                                         reduce_arch => 1), $facts);
 }
-if (defined($fi{"C Build-Conflicts"})) {
+if (defined($fields->{"C Build-Conflicts"})) {
 	push @conflicts, build_conflicts('Build-Conflicts',
-                                         Dpkg::Deps::parse($fi{"C Build-Conflicts"},
+                                         Dpkg::Deps::parse($fields->{"Build-Conflicts"},
                                             reduce_arch => 1, union => 1), $facts);
 }
-if (! $binary_only && defined($fi{"C Build-Depends-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Depends-Indep"})) {
 	push @unmet, build_depends('Build-Depends-Indep',
-                                   Dpkg::Deps::parse($fi{"C Build-Depends-Indep"},
+                                   Dpkg::Deps::parse($fields->{"Build-Depends-Indep"},
                                         reduce_arch => 1), $facts);
 }
-if (! $binary_only && defined($fi{"C Build-Conflicts-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Conflicts-Indep"})) {
 	push @conflicts, build_conflicts('Build-Conflicts-Indep',
-                                         Dpkg::Deps::parse($fi{"C Build-Conflicts-Indep"},
+                                         Dpkg::Deps::parse($fields->{"Build-Conflicts-Indep"},
                                             reduce_arch => 1, union => 1), $facts);
 }
 

scripts/dpkg-distaddfile.pl

@@ -9,9 +9,6 @@ use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(error syserr usageerr);
 
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
 textdomain("dpkg-dev");
 
 my $fileslistfile = 'debian/files';
@@ -63,8 +60,6 @@ my ($file, $section, $priority) = @ARGV;
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
-chown(getfowner(), "$fileslistfile.new") 
-		|| &syserr(_g("chown new files list file"));
 if (open(X,"< $fileslistfile")) {
     while (<X>) {
         s/\n$//;

scripts/dpkg-genchanges.pl

@@ -13,14 +13,11 @@ use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
 use Dpkg::Fields qw(capit set_field_importance sort_field_by_importance);
 use Dpkg::Compression;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our %p2i;
-our %substvar;
-our $sourcepackage;
+use Dpkg::Control;
+use Dpkg::Cdata;
+use Dpkg::Substvars;
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
@@ -36,6 +33,8 @@ my $varlistfile = 'debian/substvars';
 my $uploadfilesdir = '..';
 my $sourcestyle = 'i';
 my $quiet = 0;
+my $host_arch = get_host_arch();
+my $changes_format = "1.7";
 
 my %f2p;           # - file to package map
 my %p2f;           # - package to file map, has entries for "packagename"
@@ -64,6 +63,8 @@ my $forcemaint;
 my $forcechangedby;
 my $since;
 
+my $substvars = Dpkg::Substvars->new();
+
 use constant SOURCE     => 1;
 use constant ARCH_DEP   => 2;
 use constant ARCH_INDEP => 4;
@@ -169,7 +170,7 @@ while (@ARGV) {
     } elsif (m/^-U([^\=:]+)$/) {
         $remove{$1}= 1;
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-	$substvar{$1}= $POSTMATCH;
+	$substvars->set($1, $POSTMATCH);
     } elsif (m/^-(h|-help)$/) {
         &usage; exit(0);
     } elsif (m/^--version$/) {
@@ -179,8 +180,10 @@ while (@ARGV) {
     }
 }
 
-parsechangelog($changelogfile, $changelogformat, $since);
-parsecontrolfile($controlfile);
+my $changelog = parse_changelog($changelogfile, $changelogformat, $since);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
+$substvars->set_version_substvars($changelog->{"Version"});
 
 if (not is_sourceonly) {
     open(FL,"<",$fileslistfile) || &syserr(_g("cannot read files list file"));
@@ -221,28 +224,30 @@ if (not is_sourceonly) {
     close(FL);
 }
 
-for $_ (keys %fi) {
-    my $v = $fi{$_};
-
-    if (s/^C //) {
-	if (m/^Source$/) {
-	    setsourcepackage($v);
-	}
-	elsif (m/^Section$|^Priority$/i) { $sourcedefault{$_}= $v; }
-	elsif (m/^Maintainer$/i) { $f{$_}= $v; }
-	elsif (s/^X[BS]*C[BS]*-//i) { $f{$_}= $v; }
-	elsif (m/^X[BS]+-/i ||
-	       m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
-	       m/^(Standards-Version|Uploaders|Homepage|Origin|Bugs)$/i ||
-	       m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
-	}
-	else { &unknown(_g('general section of control info file')); }
-    } elsif (s/^C(\d+) //) {
-	my $i = $1;
-	my $p = $fi{"C$i Package"};
-	my $a = $fi{"C$i Architecture"};
-	my $host_arch = get_host_arch();
+# Scan control info of source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+    my $v = $src_fields->{$_};
+    if (m/^Source$/) {
+	set_source_package($v);
+    }
+    elsif (m/^Section$|^Priority$/i) { $sourcedefault{$_}= $v; }
+    elsif (m/^Maintainer$/i) { $fields->{$_} = $v; }
+    elsif (s/^X[BS]*C[BS]*-//i) { $fields->{$_} = $v; }
+    elsif (m/^X[BS]+-/i ||
+	   m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
+	   m/^(Standards-Version|Uploaders|Homepage|Origin|Bugs)$/i ||
+	   m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+    }
+    else { &unknown(_g('general section of control info file')); }
+}
 
+# Scan control info of all binary packages
+foreach my $pkg ($control->get_packages()) {
+    my $p = $pkg->{"Package"};
+    my $a = $pkg->{"Architecture"};
+    foreach $_ (keys %{$pkg}) {
+	my $v = $pkg->{$_};
 	if (!defined($p2f{$p}) && not is_sourceonly) {
 	    if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
 		(grep(debarch_is($host_arch, $_), split(/\s+/, $a))
@@ -271,14 +276,14 @@ for $_ (keys %fi) {
 	    } elsif (m/^Priority$/) {
 		$f2pricf{$_} = $v foreach (@f);
 	    } elsif (s/^X[BS]*C[BS]*-//i) {
-		$f{$_}= $v;
+		$fields->{$_} = $v;
 	    } elsif (m/^Architecture$/) {
 		if (not is_sourceonly) {
 		    if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
 			and ($include & ARCH_DEP)) {
 			$v = $host_arch;
 		    } elsif (!debarch_eq('all', $v)) {
-			$v= '';
+			$v = '';
 		    }
 		} else {
 		    $v = '';
@@ -293,38 +298,38 @@ for $_ (keys %fi) {
 		&unknown(_g("package's section of control info file"));
 	    }
 	}
-    } elsif (s/^L //) {
-        if (m/^Source$/i) {
-	    setsourcepackage($v);
-        } elsif (m/^Maintainer$/i) {
-	    $f{"Changed-By"}=$v;
-        } elsif (m/^(Version|Changes|Urgency|Distribution|Date|Closes)$/i) {
-            $f{$_}= $v;
-        } elsif (s/^X[BS]*C[BS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[BS]+-/i) {
-            &unknown(_g("parsed version of changelog"));
-        }
-    } elsif (m/^o:.*/) {
-    } else {
-	internerr("value from nowhere, with key >%s< and value >%s<",
-                  $_, $v);
+    }
+}
+
+# Scan fields of dpkg-parsechangelog
+foreach $_ (keys %{$changelog}) {
+    my $v = $changelog->{$_};
+    if (m/^Source$/i) {
+	set_source_package($v);
+    } elsif (m/^Maintainer$/i) {
+	$fields->{"Changed-By"} = $v;
+    } elsif (m/^(Version|Changes|Urgency|Distribution|Date|Closes)$/i) {
+	$fields->{$_} = $v;
+    } elsif (s/^X[BS]*C[BS]*-//i) {
+	$fields->{$_} = $v;
+    } elsif (!m/^X[BS]+-/i) {
+	&unknown(_g("parsed version of changelog"));
     }
 }
 
 if ($changesdescription) {
-    $f{'Changes'}= '';
+    $fields->{'Changes'} = '';
     open(X,"<",$changesdescription) || &syserr(_g("read changesdescription"));
     while(<X>) {
         s/\s*\n$//;
         $_= '.' unless m/\S/;
-        $f{'Changes'}.= "\n $_";
+        $fields->{'Changes'}.= "\n $_";
     }
 }
 
 for my $pa (keys %pa2f) {
     my ($pp, $aa) = (split / /, $pa);
-    defined($p2i{"C $pp"}) ||
+    defined($control->get_pkg_by_name($pp)) ||
 	warning(_g("package %s listed in files list but not in control info"),
 	        $pp);
 }
@@ -354,9 +359,6 @@ for my $p (keys %p2f) {
     }
 }
 
-&init_substvars;
-init_substvar_arch();
-
 my $origsrcmsg;
 
 if (!is_binaryonly) {
@@ -371,14 +373,15 @@ if (!is_binaryonly) {
 	warning(_g("missing Priority for source files"));
     }
 
-    (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://;
+    (my $sversion = $substvars->get('source:Version')) =~ s/^\d+://;
     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
     open(CDATA, "<", $dsc) || syserr(_g("cannot open .dsc file %s"), $dsc);
     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
 
-    parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+    my $dsc_fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+				allow_pgp => 1);
 
-    my $files = $fi{'S Files'};
+    my $files = $dsc_fields->{'Files'};
     for my $file (split(/\n /, $files)) {
         next if $file eq '';
         $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
@@ -410,25 +413,25 @@ if (!is_binaryonly) {
 print(STDERR "$progname: $origsrcmsg\n") ||
     &syserr(_g("write original source message")) unless $quiet;
 
-$f{'Format'}= $substvar{'Format'};
+$fields->{'Format'} = $changes_format;
 
-if (!defined($f{'Date'})) {
+if (!defined($fields->{'Date'})) {
     chomp(my $date822 = `date -R`);
     $? && subprocerr("date -R");
-    $f{'Date'}= $date822;
+    $fields->{'Date'}= $date822;
 }
 
-$f{'Binary'}= join(' ',grep(s/C //,keys %p2i));
+$fields->{'Binary'} = join(' ', map { $_->{'Package'} } $control->get_packages());
 
 unshift(@archvalues,'source') unless is_binaryonly;
 @archvalues = ('all') if $include == ARCH_INDEP;
 @archvalues = grep {!debarch_eq('all',$_)} @archvalues
     unless $include & ARCH_INDEP;
-$f{'Architecture'}= join(' ',@archvalues);
+$fields->{'Architecture'} = join(' ',@archvalues);
 
-$f{'Description'}= "\n ".join("\n ",sort @descriptions);
+$fields->{'Description'} = "\n ".join("\n ",sort @descriptions);
 
-$f{'Files'}= '';
+$fields->{'Files'} = '';
 
 my %filedone;
 
@@ -451,34 +454,35 @@ for my $f (@sourcefiles, @fileslistfiles) {
     defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
         error(_g("md5sum of source file %s (%s) is different from md5sum " .
                  "in %s (%s)"), $uf, $md5sum, $dsc, $md5sum{$f});
-    $f{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
+    $fields->{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
 }
 
-$f{'Source'}= $sourcepackage;
-if ($f{'Version'} ne $substvar{'source:Version'}) {
-    $f{'Source'} .= " ($substvar{'source:Version'})";
+$fields->{'Source'}= $sourcepackage;
+if ($fields->{'Version'} ne $substvars->get('source:Version')) {
+    $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";
 }
 
-$f{'Maintainer'} = $forcemaint if defined($forcemaint);
-$f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
+$fields->{'Maintainer'} = $forcemaint if defined($forcemaint);
+$fields->{'Changed-By'} = $forcechangedby if defined($forcechangedby);
 
 for my $f (qw(Version Distribution Maintainer Changes)) {
-    defined($f{$f}) ||
+    defined($fields->{$f}) ||
         error(_g("missing information for critical output field %s"), $f);
 }
 
 for my $f (qw(Urgency)) {
-    defined($f{$f}) ||
+    defined($fields->{$f}) ||
         warning(_g("missing information for output field %s"), $f);
 }
 
 for my $f (keys %override) {
-    $f{capit($f)} = $override{$f};
+    $fields->{$f} = $override{$f};
 }
 for my $f (keys %remove) {
-    delete $f{capit($f)};
+    delete $fields->{$f};
 }
 
 set_field_importance(@changes_fields);
-outputclose();
+$substvars->parse($varlistfile) if -e $varlistfile;
+tied(%{$fields})->output(\*STDOUT, $substvars);
 

scripts/dpkg-gencontrol.pl

@@ -12,14 +12,10 @@ use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
 use Dpkg::Deps qw(@pkg_dep_fields %dep_field_type);
 use Dpkg::Fields qw(capit set_field_importance);
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
-
-our %substvar;
-our (%f, %fi);
-our %p2i;
-our $sourcepackage;
+use Dpkg::Control;
+use Dpkg::Substvars;
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
@@ -44,6 +40,7 @@ my %remove;
 my %override;
 my $oppackage;
 my $package_type = 'deb';
+my $substvars = Dpkg::Substvars->new();
 
 
 sub version {
@@ -83,12 +80,6 @@ Options:
 "), $progname;
 }
 
-sub spfileslistvalue($)
-{
-    return $f{$_[0]} || '-';
-}
-
-
 while (@ARGV) {
     $_=shift(@ARGV);
     if (m/^-p([-+0-9a-z.]+)$/) {
@@ -116,7 +107,7 @@ while (@ARGV) {
     } elsif (m/^-U([^\=:]+)$/) {
         $remove{$1}= 1;
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-        $substvar{$1}= $';
+        $substvars->set($1, $');
     } elsif (m/^-T/) {
         $varlistfile= $';
     } elsif (m/^-n/) {
@@ -130,120 +121,115 @@ while (@ARGV) {
     }
 }
 
-parsechangelog($changelogfile, $changelogformat);
-parsesubstvars($varlistfile);
-parsecontrolfile($controlfile);
+my $changelog = parse_changelog($changelogfile, $changelogformat);
+$substvars->set_version_substvars($changelog->{"Version"});
+$substvars->parse($varlistfile) if -e $varlistfile;
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
 
-my $myindex;
+my $pkg;
 
 if (defined($oppackage)) {
-    defined($p2i{"C $oppackage"}) ||
-        error(_g("package %s not in control info"), $oppackage);
-    $myindex= $p2i{"C $oppackage"};
+    $pkg = $control->get_pkg_by_name($oppackage);
+    defined($pkg) || error(_g("package %s not in control info"), $oppackage);
 } else {
-    my @packages = grep(m/^C /, keys %p2i);
+    my @packages = map { $_->{'Package'} } $control->get_packages();
     @packages==1 ||
         error(_g("must specify package since control info has many (%s)"),
               "@packages");
-    $myindex=1;
+    $pkg = $control->get_pkg_by_idx(1);
 }
 
-#print STDERR "myindex $myindex\n";
-
 my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
 
-for $_ (keys %fi) {
-    my $v = $fi{$_};
-
-    if (s/^C //) {
-#print STDERR "G key >$_< value >$v<\n";
-	if (m/^(Origin|Bugs|Maintainer)$/) {
-	    $f{$_} = $v;
-	} elsif (m/^(Section|Priority|Homepage)$/) {
-	    # Binary package stanzas can override these fields
-	    $f{$_} ||= $v;
-	} elsif (m/^Source$/) {
-	    setsourcepackage($v);
-	}
-        elsif (s/^X[CS]*B[CS]*-//i) { $f{$_}= $v; }
-	elsif (m/^X[CS]+-/i ||
-	       m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
-	       m/^(Standards-Version|Uploaders)$/i ||
-	       m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+# Scan source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+    my $v = $src_fields->{$_};
+    if (m/^(Origin|Bugs|Maintainer)$/) {
+	$fields->{$_} = $v;
+    } elsif (m/^(Section|Priority|Homepage)$/) {
+	$fields->{$_} = $v;
+    } elsif (m/^Source$/) {
+	set_source_package($v);
+    }
+    elsif (s/^X[CS]*B[CS]*-//i) { $fields->{$_} = $v; }
+    elsif (m/^X[CS]+-/i ||
+	   m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
+	   m/^(Standards-Version|Uploaders)$/i ||
+	   m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+    }
+    else { &unknown(_g('general section of control info file')); }
+}
+
+# Scan binary package
+foreach $_ (keys %{$pkg}) {
+    my $v = $pkg->{$_};
+    if (m/^(Package|Package-Type|Description|Homepage|Tag|Essential)$/ ||
+	m/^(Section$|Priority)$/ ||
+	m/^(Subarchitecture|Kernel-Version|Installer-Menu-Item)$/) {
+	$fields->{$_} = $v;
+    } elsif (exists($pkg_dep_fields{$_})) {
+	# Delay the parsing until later
+    } elsif (m/^Architecture$/) {
+	my $host_arch = get_host_arch();
+
+	if (debarch_eq('all', $v)) {
+	    $fields->{$_} = $v;
+	} else {
+	    my @archlist = split(/\s+/, $v);
+	    my @invalid_archs = grep m/[^\w-]/, @archlist;
+	    warning(ngettext("`%s' is not a legal architecture string.",
+			     "`%s' are not legal architecture strings.",
+			     scalar(@invalid_archs)),
+		    join("' `", @invalid_archs))
+		if @invalid_archs >= 1;
+	    grep(debarch_is($host_arch, $_), @archlist) ||
+		error(_g("current host architecture '%s' does not " .
+			 "appear in package's architecture list (%s)"),
+		      $host_arch, "@archlist");
+	    $fields->{$_} = $host_arch;
 	}
-        else { $_ = "C $_"; &unknown(_g('general section of control info file')); }
-    } elsif (s/^C$myindex //) {
-#print STDERR "P key >$_< value >$v<\n";
-        if (m/^(Package|Package-Type|Description|Homepage|Tag|Essential)$/ ||
-            m/^(Section$|Priority)$/ ||
-            m/^(Subarchitecture|Kernel-Version|Installer-Menu-Item)$/) {
-            $f{$_}= $v;
-        } elsif (exists($pkg_dep_fields{$_})) {
-	    # Delay the parsing until later
-        } elsif (m/^Architecture$/) {
-	    my $host_arch = get_host_arch();
-
-            if (debarch_eq('all', $v)) {
-                $f{$_}= $v;
-            } else {
-		my @archlist = split(/\s+/, $v);
-		my @invalid_archs = grep m/[^\w-]/, @archlist;
-		warning(ngettext("`%s' is not a legal architecture string.",
-		                 "`%s' are not legal architecture strings.",
-		                 scalar(@invalid_archs)),
-		        join("' `", @invalid_archs))
-		    if @invalid_archs >= 1;
-		grep(debarch_is($host_arch, $_), @archlist) ||
-		    error(_g("current host architecture '%s' does not " .
-		             "appear in package's architecture list (%s)"),
-		          $host_arch, "@archlist");
-		$f{$_} = $host_arch;
-            }
-        } elsif (s/^X[CS]*B[CS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[CS]+-/i) {
-            $_ = "C$myindex $_"; &unknown(_g("package's section of control info file"));
-        }
-    } elsif (m/^C\d+ /) {
-#print STDERR "X key >$_< value not shown<\n";
-    } elsif (s/^L //) {
-#print STDERR "L key >$_< value >$v<\n";
-        if (m/^Source$/) {
-	    setsourcepackage($v);
-        } elsif (m/^Version$/) {
-            $sourceversion= $v;
-	    $f{$_} = $v unless defined($forceversion);
-        } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/) {
-        } elsif (s/^X[CS]*B[CS]*-//i) {
-            $f{$_}= $v;
-        } elsif (!m/^X[CS]+-/i) {
-            $_ = "L $_"; &unknown(_g("parsed version of changelog"));
-        }
-    } elsif (m/o:/) {
-    } else {
-        internerr(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v);
+    } elsif (s/^X[CS]*B[CS]*-//i) {
+	$fields->{$_}= $v;
+    } elsif (!m/^X[CS]+-/i) {
+	&unknown(_g("package's section of control info file"));
     }
 }
 
-$f{'Version'} = $forceversion if defined($forceversion);
+# Scan fields of dpkg-parsechangelog
+foreach $_ (keys %{$changelog}) {
+    my $v = $changelog->{$_};
+
+    if (m/^Source$/) {
+	set_source_package($v);
+    } elsif (m/^Version$/) {
+	$sourceversion = $v;
+	$fields->{$_} = $v unless defined($forceversion);
+    } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/) {
+    } elsif (s/^X[CS]*B[CS]*-//i) {
+	$fields->{$_} = $v;
+    } elsif (!m/^X[CS]+-/i) {
+	&unknown(_g("parsed version of changelog"));
+    }
+}
 
-&init_substvars;
-init_substvar_arch();
+$fields->{'Version'} = $forceversion if defined($forceversion);
 
 # Process dependency fields in a second pass, now that substvars have been
 # initialized.
 
 my $facts = Dpkg::Deps::KnownFacts->new();
-$facts->add_installed_package($f{'Package'}, $f{'Version'});
-if (exists $fi{"C$myindex Provides"}) {
-    my $provides = Dpkg::Deps::parse(substvars($fi{"C$myindex Provides"}),
+$facts->add_installed_package($fields->{'Package'}, $fields->{'Version'});
+if (exists $pkg->{"Provides"}) {
+    my $provides = Dpkg::Deps::parse($substvars->substvars($pkg->{"Provides"}),
                                      reduce_arch => 1, union => 1);
     if (defined $provides) {
 	foreach my $subdep ($provides->get_deps()) {
 	    if ($subdep->isa('Dpkg::Deps::Simple')) {
 		$facts->add_provided_package($subdep->{package},
                         $subdep->{relation}, $subdep->{version},
-                        $f{'Package'});
+                        $fields->{'Package'});
 	    }
 	}
     }
@@ -251,10 +237,9 @@ if (exists $fi{"C$myindex Provides"}) {
 
 my (@seen_deps);
 foreach my $field (@pkg_dep_fields) {
-    my $key = "C$myindex $field";
-    if (exists $fi{$key}) {
+    if (exists $pkg->{$field}) {
 	my $dep;
-	my $field_value = substvars($fi{$key});
+	my $field_value = $substvars->substvars($pkg->{$field});
 	if ($dep_field_type{$field} eq 'normal') {
 	    $dep = Dpkg::Deps::parse($field_value, use_arch => 1,
                                      reduce_arch => 1);
@@ -269,36 +254,36 @@ foreach my $field (@pkg_dep_fields) {
 	    $dep->simplify_deps($facts);
 	}
 	$dep->sort();
-	$f{$field} = $dep->dump();
-	delete $f{$field} unless $f{$field}; # Delete empty field
+	$fields->{$field} = $dep->dump();
+	delete $fields->{$field} unless $fields->{$field}; # Delete empty field
     }
 }
 
 for my $f (qw(Package Version)) {
-    defined($f{$f}) || error(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || error(_g("missing information for output field %s"), $f);
 }
 for my $f (qw(Maintainer Description Architecture)) {
-    defined($f{$f}) || warning(_g("missing information for output field %s"), $f);
+    defined($fields->{$f}) || warning(_g("missing information for output field %s"), $f);
 }
-$oppackage= $f{'Package'};
+$oppackage = $fields->{'Package'};
 
-$package_type = $f{'Package-Type'} if (defined($f{'Package-Type'}));
+$package_type = $fields->{'Package-Type'} if (defined($fields->{'Package-Type'}));
 
 if ($package_type ne 'udeb') {
     for my $f (qw(Subarchitecture Kernel-Version Installer-Menu-Item)) {
         warning(_g("%s package with udeb specific field %s"), $package_type, $f)
-            if defined($f{$f});
+            if defined($fields->{$f});
     }
 }
 
-my $verdiff = $f{'Version'} ne $substvar{'source:Version'} ||
-              $f{'Version'} ne $sourceversion;
+my $verdiff = $fields->{'Version'} ne $substvars->get('source:Version') ||
+              $fields->{'Version'} ne $sourceversion;
 if ($oppackage ne $sourcepackage || $verdiff) {
-    $f{'Source'}= $sourcepackage;
-    $f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
+    $fields->{'Source'} = $sourcepackage;
+    $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")" if $verdiff;
 }
 
-if (!defined($substvar{'Installed-Size'})) {
+if (!defined($substvars->get('Installed-Size'))) {
     defined(my $c = open(DU, "-|")) || syserr(_g("fork for du"));
     if (!$c) {
         chdir("$packagebuilddir") ||
@@ -313,27 +298,26 @@ if (!defined($substvar{'Installed-Size'})) {
     $? && subprocerr(_g("du in \`%s'"), $packagebuilddir);
     $duo =~ m/^(\d+)\s+\.$/ ||
         failure(_g("du gave unexpected output \`%s'"), $duo);
-    $substvar{'Installed-Size'}= $1;
+    $substvars->set('Installed-Size', $1);
 }
-if (defined($substvar{'Extra-Size'})) {
-    $substvar{'Installed-Size'} += $substvar{'Extra-Size'};
+if (defined($substvars->get('Extra-Size'))) {
+    my $size = $substvars->get('Extra-Size') + $substvars->get('Installed-Size');
+    $substvars->set('Installed-Size', $size);
 }
-if (defined($substvar{'Installed-Size'})) {
-    $f{'Installed-Size'}= $substvar{'Installed-Size'};
+if (defined($substvars->get('Installed-Size'))) {
+    $fields->{'Installed-Size'} = $substvars->get('Installed-Size');
 }
 
 for my $f (keys %override) {
-    $f{capit($f)} = $override{$f};
+    $fields->{$f} = $override{$f};
 }
 for my $f (keys %remove) {
-    delete $f{capit($f)};
+    delete $fields->{$f};
 }
 
 $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
 open(Y,"> $fileslistfile.new") || &syserr(_g("open new files list file"));
 binmode(Y);
-chown(getfowner(), "$fileslistfile.new") 
-		|| &syserr(_g("chown new files list file"));
 if (open(X,"< $fileslistfile")) {
     binmode(X);
     while (<X>) {
@@ -341,7 +325,7 @@ if (open(X,"< $fileslistfile")) {
         next if m/^([-+0-9a-z.]+)_[^_]+_([\w-]+)\.(a-z+) /
                 && ($1 eq $oppackage)
 	        && ($3 eq $package_type)
-	        && (debarch_eq($2, $f{'Architecture'})
+	        && (debarch_eq($2, $fields->{'Architecture'})
 		    || debarch_eq($2, 'all'));
         print(Y "$_\n") || &syserr(_g("copy old entry to new files list file"));
     }
@@ -349,13 +333,14 @@ if (open(X,"< $fileslistfile")) {
 } elsif ($! != ENOENT) {
     &syserr(_g("read old files list file"));
 }
-my $sversion = $f{'Version'};
+my $sversion = $fields->{'Version'};
 $sversion =~ s/^\d+://;
-$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $f{'Architecture'},
+$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $fields->{'Architecture'},
 			 $package_type)
 	   unless ($forcefilename);
-print(Y &substvars(sprintf("%s %s %s\n", $forcefilename, 
-                           &spfileslistvalue('Section'), &spfileslistvalue('Priority'))))
+print(Y $substvars->substvars(sprintf("%s %s %s\n", $forcefilename,
+				      $fields->{'Section'} || '-',
+				      $fields->{'Priority'} || '-')))
     || &syserr(_g("write new entry to new files list file"));
 close(Y) || &syserr(_g("close new files list file"));
 rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
@@ -370,10 +355,11 @@ if (!$stdout) {
 }
 
 set_field_importance(@control_fields);
-outputclose($varlistfile);
+tied(%{$fields})->output(\*STDOUT, $substvars);
 
 if (!$stdout) {
     rename("$cf.new", "$cf") ||
         syserr(_g("cannot install output control file \`%s'"), $cf);
 }
 
+

scripts/dpkg-gensymbols.pl

@@ -10,16 +10,11 @@ use Dpkg::Shlibs::Objdump;
 use Dpkg::Shlibs::SymbolFile;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(warning error syserr usageerr);
+use Dpkg::Control;
+use Dpkg::Changelog qw(parse_changelog);
 
 textdomain("dpkg-dev");
 
-push(@INC, $dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our %p2i;
-
-my $controlfile = 'debian/control';
 my $changelogfile = 'debian/changelog';
 my $packagebuilddir = 'debian/tmp';
 
@@ -114,17 +109,16 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
 }
 
 if (not defined($sourceversion)) {
-    parsechangelog($changelogfile);
-    $sourceversion = $fi{"L Version"};
+    my $changelog = parse_changelog($changelogfile);
+    $sourceversion = $changelog->{"Version"};
 }
 if (not defined($oppackage)) {
-    parsecontrolfile($controlfile);
-    my @packages = grep(m/^C /, keys %p2i);
+    my $control = Dpkg::Control->new();
+    my @packages = map { $_->{'Package'} } $control->get_packages();
     @packages == 1 ||
 	error(_g("must specify package since control info has many (%s)"),
 	      "@packages");
     $oppackage = $packages[0];
-    $oppackage =~ s/^C //;
 }
 
 my $symfile = Dpkg::Shlibs::SymbolFile->new();

scripts/dpkg-parsechangelog.pl

@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+use English;
 use POSIX;
 use POSIX qw(:errno_h);
 use Dpkg;
@@ -16,7 +17,7 @@ my $changelogfile = 'debian/changelog';
 my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
                   "$dpkglibdir/parsechangelog");
 
-my $libdir;	# XXX: Not used!?
+my $libdir;
 my $force;
 
 
@@ -39,11 +40,27 @@ sub usage {
 
 Options:
   -l<changelogfile>        get per-version info from this file.
-  -v<sinceversion>         include all changes later than version.
   -F<changelogformat>      force change log format.
   -L<libdir>               look for change log parsers in <libdir>.
   -h, --help               show this help message.
       --version            show the version.
+
+parser options:
+    --format <outputformat>     see man page for list of available
+                                output formats, defaults to 'dpkg'
+                                for compatibility with dpkg-dev
+    --since, -s, -v <version>   include all changes later than version
+    --until, -u <version>       include all changes earlier than version
+    --from, -f <version>        include all changes equal or later
+                                than version
+    --to, -t <version>          include all changes up to or equal
+                                than version
+    --count, -c, -n <number>    include <number> entries from the top
+                                (or the tail if <number> is lower than 0)
+    --offset, -o <number>       change the starting point for --count,
+                                counted from the top (or the tail if
+                                <number> is lower than 0)
+    --all                       include all changes
 "), $progname;
 }
 
@@ -51,24 +68,28 @@ my @ap = ();
 while (@ARGV) {
     last unless $ARGV[0] =~ m/^-/;
     $_= shift(@ARGV);
-    if (m/^-L/ && length($_)>2) { $libdir=$'; next; }
+    if (m/^-L/ && length($_)>2) { $libdir=$POSTMATCH; next; }
     if (m/^-F([0-9a-z]+)$/) { $force=1; $format=$1; next; }
     push(@ap,$_);
-    if (m/^-l/ && length($_)>2) { $changelogfile=$'; next; }
+    if (m/^-l/ && length($_)>2) { $changelogfile=$POSTMATCH; next; }
     m/^--$/ && last;
-    m/^-v/ && next;
+    m/^-[cfnostuv]/ && next;
+    m/^--all$/ && next;
+    m/^--(count|file|format|from|offset|since|to|until)(.*)$/ && do {
+	push(@ap, shift(@ARGV)) unless $2;
+	next;
+    };
     if (m/^-(h|-help)$/) { &usage; exit(0); }
     if (m/^--version$/) { &version; exit(0); }
-    &usageerr("unknown option \`$_'");
+    &usageerr(_g("unknown option \`%s'"), $_);
 }
 
 @ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-$changelogfile= "./$changelogfile" if $changelogfile =~ m/^\s/;
 
 if (not $force and $changelogfile ne "-") {
-    open(STDIN,"< $changelogfile") ||
-        error(_g("cannot open %s to find format: %s"), $changelogfile, $!);
-    open(P,"tail -n 40 |") || die sprintf(_g("cannot fork: %s"), $!)."\n";
+    open(STDIN,"<", $changelogfile) ||
+	syserr(_g("cannot open %s to find format"), $changelogfile);
+    open(P,"-|","tail","-n",40) || syserr(_g("cannot fork"));
     while(<P>) {
         next unless m/\schangelog-format:\s+([0-9a-z]+)\W/;
         $format=$1;
@@ -79,6 +100,7 @@ if (not $force and $changelogfile ne "-") {
 
 my ($pa, $pf);
 
+unshift(@parserpath, $libdir) if $libdir;
 for my $pd (@parserpath) {
     $pa= "$pd/$format";
     if (!stat("$pa")) {
@@ -90,11 +112,12 @@ for my $pd (@parserpath) {
 	last;
     }
 }
-        
+
 defined($pf) || error(_g("format %s unknown"), $pa);
 
 if ($changelogfile ne "-") {
-    open(STDIN,"< $changelogfile") || die sprintf(_g("cannot open %s: %s"), $changelogfile, $!)."\n";
+    open(STDIN,"<", $changelogfile)
+	|| syserr(_g("cannot open %s: %s"), $changelogfile);
 }
-exec($pf,@ap); die sprintf(_g("cannot exec format parser: %s"), $!)."\n";
+exec($pf,@ap) || syserr(_g("cannot exec format parser: %s"));
 

scripts/dpkg-shlibdeps.pl

@@ -18,9 +18,7 @@ use Dpkg::Shlibs::SymbolFile;
 use Dpkg::Arch qw(get_host_arch);
 use Dpkg::Fields qw(capit);
 use Dpkg::Deps;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Control;
 
 # By increasing importance
 my @depfields = qw(Suggests Recommends Depends Pre-Depends);
@@ -92,10 +90,10 @@ foreach (@ARGV) {
 
 scalar keys %exec || usageerr(_g("need at least one executable"));
 
-our %fi;
-parsecontrolfile("debian/control");
-my $build_depends = defined($fi{"C Build-Depends"}) ?
-		    $fi{"C Build-Depends"} : "";
+my $control = Dpkg::Control->new();
+my $fields = $control->get_source();
+my $build_depends = defined($fields->{"Build-Depends"}) ?
+		    $fields->{"Build-Depends"} : "";
 my $build_deps = Dpkg::Deps::parse($build_depends, reduce_arch => 1);
 
 my %dependencies;

scripts/dpkg-source.pl

@@ -12,6 +12,12 @@ use Dpkg::Arch qw(debarch_eq);
 use Dpkg::Deps qw(@src_dep_fields %dep_field_type);
 use Dpkg::Fields qw(capit set_field_importance);
 use Dpkg::Compression;
+use Dpkg::Cdata;
+use Dpkg::Control;
+use Dpkg::Substvars;
+use Dpkg::Version qw(check_version);
+use Dpkg::Vars;
+use Dpkg::Changelog qw(parse_changelog);
 
 my @filesinarchive;
 my %dirincluded;
@@ -19,7 +25,7 @@ my %notfileobject;
 my $fn;
 my $ur;
 
-my $varlistfile;
+my $varlistfile = "debian/substvars";
 my $controlfile;
 my $changelogfile;
 my $changelogformat;
@@ -100,20 +106,14 @@ my %dirtocreate;	 # used by checkdiff
 
 my @tar_ignore;
 
+my $substvars = Dpkg::Substvars->new();
+
 use POSIX;
 use Fcntl qw (:mode);
 use English;
 use File::Temp qw (tempfile);
 use Cwd;
 
-push (@INC, $dpkglibdir);
-require 'controllib.pl';
-
-our (%f, %fi);
-our $sourcepackage;
-our %substvar;
-our @src_dep_fields;
-
 textdomain("dpkg-dev");
 
 my @dsc_fields = (qw(Format Source Binary Architecture Version Origin
@@ -250,9 +250,9 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
             $tar_ignore_default_pattern_done = 1;
         }
     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
-        $substvar{$1}= $POSTMATCH;
+        $substvars->set($1, $POSTMATCH);
     } elsif (m/^-T/) {
-        $varlistfile= $POSTMATCH;
+	$varlistfile = $POSTMATCH;
     } elsif (m/^-(h|-help)$/) {
         &usage; exit(0);
     } elsif (m/^--version$/) {
@@ -291,45 +291,49 @@ if ($opmode eq 'build') {
     $changelogfile= "$dir/debian/changelog" unless defined($changelogfile);
     $controlfile= "$dir/debian/control" unless defined($controlfile);
     
-    parsechangelog($changelogfile, $changelogformat);
-    parsecontrolfile($controlfile);
-    $f{"Format"}= $compression eq 'gzip' ? $def_dscformat : '2.0';
-    &init_substvars;
+    my $changelog = parse_changelog($changelogfile, $changelogformat);
+    my $control = Dpkg::Control->new($controlfile);
+    my $fields = Dpkg::Fields::Object->new();
+
+    $fields->{"Format"} = $compression eq 'gzip' ? $def_dscformat : '2.0';
 
     my @sourcearch;
     my %archadded;
     my $archspecific = 0; # XXX: Not used?!
-    my %packageadded;
     my @binarypackages;
 
-    for $_ (keys %fi) {
-        my $v = $fi{$_};
+    # Scan control info of source package
+    my $src_fields = $control->get_source();
+    foreach $_ (keys %{$src_fields}) {
+	my $v = $src_fields->{$_};
+	if (m/^Source$/i) {
+	    set_source_package($v);
+	} elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
+		 m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+	    $fields->{$_} = $v;
+	}
+	elsif (m/^Uploaders$/i) { ($fields->{$_} = $v) =~ s/[\r\n]//g; }
+	elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
+	    my $dep;
+	    my $type = $dep_field_type{capit($_)};
+	    $dep = Dpkg::Deps::parse($v, union =>  $type eq 'union');
+	    error(_g("error occurred while parsing %s"), $_) unless defined $dep;
+	    my $facts = Dpkg::Deps::KnownFacts->new();
+	    $dep->simplify_deps($facts);
+	    $dep->sort();
+	    $fields->{$_} = $dep->dump();
+	}
+	elsif (s/^X[BC]*S[BC]*-//i) { $fields->{$_} = $v; }
+	elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
+	else { &unknown(_g('general section of control info file')); }
+    }
 
-        if (s/^C //) {
-	    if (m/^Source$/i) {
-		setsourcepackage($v);
-	    } elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
-	             m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
-		$f{$_}= $v;
-	    }
-	    elsif (m/^Uploaders$/i) { ($f{$_}= $v) =~ s/[\r\n]//g; }
-	    elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
-		my $dep;
-		my $type = $dep_field_type{capit($_)};
-		$dep = Dpkg::Deps::parse($v, union =>  $type eq 'union');
-		error(_g("error occurred while parsing %s"), $_) unless defined $dep;
-		my $facts = Dpkg::Deps::KnownFacts->new();
-		$dep->simplify_deps($facts);
-		$dep->sort();
-		$f{$_}= $dep->dump();
-	    }
-            elsif (s/^X[BC]*S[BC]*-//i) { $f{$_}= $v; }
-            elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
-            else { &unknown(_g('general section of control info file')); }
-        } elsif (s/^C(\d+) //) {
-	    my $i = $1;
-	    my $p = $fi{"C$i Package"};
-            push(@binarypackages,$p) unless $packageadded{$p}++;
+    # Scan control info of binary packages
+    foreach my $pkg ($control->get_packages()) {
+	my $p = $pkg->{'Package'};
+	push(@binarypackages,$p);
+	foreach $_ (keys %{$pkg}) {
+	    my $v = $pkg->{$_};
             if (m/^Architecture$/) {
 		if (debarch_eq($v, 'any')) {
                     @sourcearch= ('any');
@@ -355,9 +359,9 @@ if ($opmode eq 'build') {
                         }
                 }
                 }
-                $f{'Architecture'}= join(' ',@sourcearch);
+                $fields->{'Architecture'}= join(' ',@sourcearch);
             } elsif (s/^X[BC]*S[BC]*-//i) {
-                $f{$_}= $v;
+                $fields->{$_} = $v;
             } elsif (m/^(Package|Package-Type|Essential|Kernel-Version)$/ ||
                      m/^(Homepage|Subarchitecture|Installer-Menu-Item)$/i ||
                      m/^(Pre-Depends|Depends|Provides)$/i ||
@@ -367,46 +371,47 @@ if ($opmode eq 'build') {
             } else {
                 &unknown(_g("package's section of control info file"));
             }
-        } elsif (s/^L //) {
-            if (m/^Source$/) {
-		setsourcepackage($v);
-            } elsif (m/^Version$/) {
-		checkversion( $v );
-                $f{$_}= $v;
-            } elsif (s/^X[BS]*C[BS]*-//i) {
-                $f{$_}= $v;
-            } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/i ||
-                     m/^X[BS]+-/i) {
-            } else {
-                &unknown(_g("parsed version of changelog"));
-            }
-        } elsif (m/^o:.*/) {
-        } else {
-	    internerr(_g("value from nowhere, with key >%s< and value >%s<"),
-	              $_, $v);
-        }
+	}
+    }
+
+    # Scan fields of dpkg-parsechangelog
+    foreach $_ (keys %{$changelog}) {
+        my $v = $changelog->{$_};
+
+	if (m/^Source$/) {
+	    set_source_package($v);
+	} elsif (m/^Version$/) {
+	    check_version($v);
+	    $fields->{$_} = $v;
+	} elsif (s/^X[BS]*C[BS]*-//i) {
+	    $fields->{$_} = $v;
+	} elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/i ||
+		 m/^X[BS]+-/i) {
+	} else {
+	    &unknown(_g("parsed version of changelog"));
+	}
     }
 
-    $f{'Binary'}= join(', ',@binarypackages);
-    for my $f (keys %override) {
-	$f{capit($f)} = $override{$f};
+    $fields->{'Binary'}= join(', ', @binarypackages);
+    foreach my $f (keys %override) {
+	$fields->{$f} = $override{$f};
     }
 
     for my $f (qw(Version)) {
-	defined($f{$f}) ||
+	defined($fields->{$f}) ||
 	    error(_g("missing information for critical output field %s"), $f);
     }
     for my $f (qw(Maintainer Architecture Standards-Version)) {
-	defined($f{$f}) ||
+	defined($fields->{$f}) ||
 	    warning(_g("missing information for output field %s"), $f);
     }
     defined($sourcepackage) || &error(_g("unable to determine source package name !"));
-    $f{'Source'}= $sourcepackage;
+    $fields->{'Source'} = $sourcepackage;
     for my $f (keys %remove) {
-	delete $f{capit($f)};
+	delete $fields->{$f};
     }
 
-    my $version = $f{'Version'};
+    my $version = $fields->{'Version'};
     $version =~ s/^\d+://;
     my $upstreamversion = $version;
     $upstreamversion =~ s/-[^-]*$//;
@@ -507,7 +512,7 @@ if ($opmode eq 'build') {
 
 	$tarname= $origtargz || "$basename.orig.tar.$comp_ext";
 	if ($tarname =~ /\Q$basename\E\.orig\.tar\.($comp_regex)/) {
-	    if (($1 ne 'gz') && ($f{'Format'} < 2)) { $f{'Format'} = '2.0' };
+	    if (($1 ne 'gz') && ($fields->{'Format'} < 2)) { $fields->{'Format'} = '2.0' };
 	} else {
 	    warning(_g(".orig.tar name %s is not <package>_<upstreamversion>" .
 	               ".orig.tar (wanted %s)"),
@@ -560,7 +565,7 @@ if ($opmode eq 'build') {
         
     }
     
-    addfile("$tarname");
+    addfile($fields, "$tarname");
 
     if ($sourcestyle =~ m/[kpKP]/) {
 
@@ -750,7 +755,7 @@ if ($opmode eq 'build') {
         }
         close(FIND); $? && subprocerr("find on $dirname");
 
-	&addfile($diffname);
+	addfile($fields, $diffname);
 
     }
 
@@ -765,7 +770,8 @@ if ($opmode eq 'build') {
         syserr(_g("create %s"), "$basenamerev.dsc");
 
     set_field_importance(@dsc_fields);
-    outputclose($varlistfile);
+    $substvars->parse($varlistfile) if -e $varlistfile;
+    tied(%{$fields})->output(\*STDOUT, $substvars);
 
     if ($ur) {
         printf(STDERR _g("%s: unrepresentable changes to source")."\n",
@@ -829,31 +835,31 @@ if ($opmode eq 'build') {
 	warning(_g("extracting unsigned source package (%s)"), $dsc);
     }
 
-    open(CDATA, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
-    parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+    open(CDATA, "<", $dsc) || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
+    my $fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+			    allow_pgp => 1);
     close(CDATA);
 
     for my $f (qw(Source Version Files)) {
-        defined($fi{"S $f"}) ||
+        defined($fields->{$f}) ||
             error(_g("missing critical source control field %s"), $f);
     }
 
     my $dscformat = $def_dscformat;
-    if (defined $fi{'S Format'}) {
-	if (not handleformat($fi{'S Format'})) {
-	    error(_g("Unsupported format of .dsc file (%s)"), $fi{'S Format'});
+    if (defined $fields->{'Format'}) {
+	if (not handleformat($fields->{'Format'})) {
+	    error(_g("Unsupported format of .dsc file (%s)"), $fields->{'Format'});
 	}
-        $dscformat=$fi{'S Format'};
+        $dscformat=$fields->{'Format'};
     }
 
-    $sourcepackage = $fi{'S Source'}; # XXX: should use setsourcepackage??
-    checkpackagename( $sourcepackage );
+    set_source_package($fields->{'Source'});
 
-    my $version = $fi{'S Version'};
+    my $version = $fields->{'Version'};
     my $baseversion;
     my $revision;
 
-    checkversion( $version );
+    check_version($version);
     $version =~ s/^\d+://;
     if ($version =~ m/-([^-]+)$/) {
         $baseversion= $`; $revision= $1;
@@ -861,7 +867,7 @@ if ($opmode eq 'build') {
         $baseversion= $version; $revision= '';
     }
 
-    my $files = $fi{'S Files'};
+    my $files = $fields->{'Files'};
     my @tarfiles;
     my $difffile;
     my $debianfile;
@@ -1625,7 +1631,7 @@ sub reapgzip {
 
 my %added_files;
 sub addfile {
-    my ($filename)= @_;
+    my ($fields, $filename)= @_;
     $added_files{$filename}++ &&
         internerr(_g("tried to add file `%s' twice"), $filename);
     stat($filename) || syserr(_g("could not stat output file `%s'"), $filename);
@@ -1633,7 +1639,7 @@ sub addfile {
     my $md5sum= `md5sum <$filename`;
     $? && &subprocerr("md5sum $filename");
     $md5sum = readmd5sum( $md5sum );
-    $f{'Files'}.= "\n $md5sum $size $filename";
+    $fields->{'Files'}.= "\n $md5sum $size $filename";
 }
 
 # replace \ddd with their corresponding character, refuse \ddd > \377
@@ -1656,3 +1662,10 @@ sub deoctify {
     return join("", @_);
 } }
 
+sub readmd5sum {
+    (my $md5sum = shift) or return;
+    $md5sum =~ s/^([0-9a-f]{32})\s*\*?-?\s*\n?$/$1/o
+        || failure(_g("md5sum gave bogus output `%s'"), $md5sum);
+    return $md5sum;
+}
+

scripts/po/POTFILES.in

@@ -1,7 +1,6 @@
 # This is the list of all source files with translatable strings.
 
 scripts/822-date.pl
-scripts/controllib.pl
 scripts/dpkg-architecture.pl
 scripts/dpkg-buildpackage.pl
 scripts/dpkg-checkbuilddeps.pl
@@ -16,8 +15,16 @@ scripts/dpkg-shlibdeps.pl
 scripts/dpkg-source.pl
 scripts/changelog/debian.pl
 scripts/Dpkg/Arch.pm
+scripts/Dpkg/Cdata.pm
+scripts/Dpkg/Changelog.pm
+scripts/Dpkg/Changelog/Debian.pm
+scripts/Dpkg/Control.pm
+scripts/Dpkg/Deps.pm
+scripts/Dpkg/ErrorHandling.pm
+scripts/Dpkg/Fields.pm
 scripts/Dpkg/Shlibs.pm
 scripts/Dpkg/Shlibs/Objdump.pm
 scripts/Dpkg/Shlibs/SymbolFile.pm
+scripts/Dpkg/Substvars.pm
+scripts/Dpkg/Vars.pm
 scripts/Dpkg/Version.pm
-scripts/Dpkg/ErrorHandling.pm

scripts/t/600_Dpkg_Changelog.t

@@ -0,0 +1,207 @@
+# -*- perl -*-
+
+use strict;
+use warnings;
+
+use File::Basename;
+
+BEGIN {
+    my $no_examples = 2;
+    my $no_err_examples = 1;
+    my $no_tests = $no_examples * 4
+	+ $no_err_examples * 2
+	+ 48;
+
+    require Test::More;
+    import Test::More tests => $no_tests;
+}
+BEGIN {
+    use_ok('Dpkg::Changelog');
+    use_ok('Dpkg::Changelog::Debian');
+};
+
+my $srcdir = $ENV{srcdir} || '.';
+$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") {
+
+    my $changes = Dpkg::Changelog::Debian->init( { infile => $file,
+						   quiet => 1 } );
+    my $errors = $changes->get_parse_errors();
+    my $basename = basename( $file );
+
+#    use Data::Dumper;
+#    diag(Dumper($changes));
+
+    ok( !$errors, "Parse example changelog $file without errors" );
+
+    my @data = $changes->data;
+
+    ok( @data, "data is not empty" );
+
+    my $str = $changes->dpkg_str();
+
+#    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 { $_->Version } @data);
+
+	sub check_options {
+	    my ($changes, $data, $options, $count, $versions,
+		$check_name) = @_;
+
+	    my @cnt = $changes->data( $options );
+	    cmp_ok( @cnt, '==', $count, "$check_name -> count" );
+	    if ($count == @$data) {
+		is_deeply( \@cnt, $data, "$check_name -> returns all" );
+
+	    } else {
+		is( join( "/", map { $_->Version } @cnt),
+		    $versions, "$check_name -> versions" );
+	    }
+	}
+
+	check_options( $changes, \@data,
+		       { count => 3 }, 3, '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'positve count' );
+	check_options( $changes, \@data,
+		       { count => -3 }, 3,
+		       '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
+		       'negative count' );
+	check_options( $changes, \@data,
+		       { count => 1 }, 1, '2:2.0-1',
+		       'count 1' );
+	check_options( $changes, \@data,
+		       { count => 1, default_all => 1 }, 1, '2:2.0-1',
+		       'count 1 (d_a 1)' );
+	check_options( $changes, \@data,
+		       { count => -1 }, 1, '1.5-1',
+		       'count -1' );
+
+	check_options( $changes, \@data,
+		       { count => 3, offset => 2 }, 3,
+		       '1:2.0~rc2-2/1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2',
+		       'positve count + positive offset' );
+	check_options( $changes, \@data,
+		       { count => -3, offset => 4 }, 3,
+		       '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'negative count + positive offset' );
+
+	check_options( $changes, \@data,
+		       { count => 4, offset => 5 }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'positve count + positive offset (>max)' );
+	check_options( $changes, \@data,
+		       { count => -4, offset => 2 }, 2,
+		       '2:2.0-1/1:2.0~rc2-3',
+		       'negative count + positive offset (<0)' );
+
+	check_options( $changes, \@data,
+		       { count => 3, offset => -4 }, 3,
+		       '1:2.0~rc2-1sarge3/1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1',
+		       'positve count + negative offset' );
+	check_options( $changes, \@data,
+		       { count => -3, offset => -3 }, 3,
+		       '1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'negative count + negative offset' );
+
+	check_options( $changes, \@data,
+		       { count => 5, offset => -2 }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'positve count + negative offset (>max)' );
+	check_options( $changes, \@data,
+		       { count => -5, offset => -4 }, 3,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'negative count + negative offset (<0)' );
+
+	check_options( $changes, \@data,
+		       { count => 7 }, 7, '',
+		       'count 7 (max)' );
+	check_options( $changes, \@data,
+		       { count => -7 }, 7, '',
+		       'count -7 (-max)' );
+	check_options( $changes, \@data,
+		       { count => 10 }, 7, '',
+		       'count 10 (>max)' );
+	check_options( $changes, \@data,
+		       { count => -10 }, 7, '',
+		       'count -10 (<-max)' );
+
+	check_options( $changes, \@data,
+		       { from => '1:2.0~rc2-1sarge3' }, 4,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3',
+		       'from => "1:2.0~rc2-1sarge3"' );
+	check_options( $changes, \@data,
+		       { since => '1:2.0~rc2-1sarge3' }, 3,
+		       '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2',
+		       'since => "1:2.0~rc2-1sarge3"' );
+	check_options( $changes, \@data,
+		       { to => '1:2.0~rc2-1sarge2' }, 3,
+		       '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1',
+		       'to => "1:2.0~rc2-1sarge2"' );
+	check_options( $changes, \@data,
+		       { until => '1:2.0~rc2-1sarge2' }, 2,
+		       '1:2.0~rc2-1sarge1/1.5-1',
+		       'until => "1:2.0~rc2-1sarge2"' );
+	#TODO: test combinations
+    }
+
+#     if ($file eq 'Changes') {
+# 	my $v = $data[0]->Version;
+# 	$v =~ s/[a-z]$//;
+# 	cmp_ok( $v, 'eq', $Parse::DebianChangelog::VERSION,
+# 		'version numbers in module and Changes match' );
+#     }
+
+    my $oldest_version = $data[-1]->Version;
+    $str = $changes->dpkg_str({ since => $oldest_version });
+
+#    is( $str, `dpkg-parsechangelog -v$oldest_version -l$file`,
+#	'Output of dpkg_str equal to output of dpkg-parsechangelog' )
+#	or diag("oldest_version=$oldest_version");
+
+    $str = $changes->rfc822_str();
+
+    ok( 1 );
+
+    $str = $changes->rfc822_str({ 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 @errors = $changes->get_parse_errors();
+
+    ok( @errors, 'errors occoured' );
+    is_deeply( [ map { $_->[1] } @errors ], $test, 'check line numbers' );
+}

scripts/t/600_Dpkg_Changelog/countme

@@ -0,0 +1,41 @@
+countme (2:2.0-1) unstable; urgency=low
+
+  * Final
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:49:05 +0200
+
+countme (1:2.0~rc2-3) unstable; urgency=low
+
+  * kadabra
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:48:05 +0200
+
+countme (1:2.0~rc2-2) unstable; urgency=low
+
+  * Abra
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:48 +0200
+
+countme (1:2.0~rc2-1sarge3) unstable; urgency=low
+
+  * Baz
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:19 +0200
+
+countme (1:2.0~rc2-1sarge2) unstable; urgency=low
+
+  * Bar
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:47:08 +0200
+
+countme (1:2.0~rc2-1sarge1) unstable; urgency=low
+
+  * Foo
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Tue,  4 Oct 2005 01:46:49 +0200
+
+countme (1.5-1) unstable; urgency=low
+
+  * Initial
+
+ -- Frank Lichtenheld <frank@lichtenheld.de>  Thu, 01 Jan 1970 00:00:00 +0000

scripts/t/600_Dpkg_Changelog/misplaced-tz

@@ -0,0 +1,12 @@
+error-tz (1.1-1) unstable; urgency=low
+
+  * 
+
+ -- Frank Lichtenheld <djpig@debian.org>  Mon, 16 Jul 2007 02:54:18 +0200
++0200
+
+error-tz (1.0-1) unstable; urgency=low
+
+  * 
+
+ -- Frank Lichtenheld <djpig@debian.org>  Mon, 16 Jul 2007 02:54:18 +0200

scripts/t/700_Dpkg_Control.t

@@ -0,0 +1,63 @@
+# -*- mode: cperl;-*-
+
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+use IO::String;
+
+use_ok('Dpkg::Control');
+
+my $srcdir = $ENV{srcdir} || '.';
+$srcdir .= '/t/700_Dpkg_Control';
+
+my $c = Dpkg::Control->new("$srcdir/control-1");
+
+my $io = IO::String->new();
+$c->dump($io);
+is(${$io->string_ref()},
+'Source: mysource
+My-Field-One: myvalue1
+My-Field-Two: myvalue2
+Long-Field: line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3
+Empty-Field: 
+
+Package: mypackage1
+Depends: libc6
+
+Package: mypackage2
+Depends: hello
+
+Package: mypackage3
+Depends: hello
+Description: short one
+ long one
+ very long one
+', "Dump of $srcdir/control-1");
+
+my $src = $c->get_source();
+is($src->{'my-field-one'}, 'myvalue1', "Access field through badly capitalized field name");
+is($src->{'long-field'}, 
+'line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3', "Get multi-line field");
+is($src->{'Empty-field'}, "", "Get empty field");
+
+my $pkg = $c->get_pkg_by_idx(1);
+is($pkg->{package}, 'mypackage1', 'Name of first package');
+
+$pkg = $c->get_pkg_by_name("mypackage3");
+is($pkg->{package}, 'mypackage3', 'Name of third package');
+is($pkg->{Depends}, 'hello', 'Name of third package');
+
+$pkg = $c->get_pkg_by_idx(2);
+$io = IO::String->new();
+tied(%{$pkg})->dump($io);
+
+is(${$io->string_ref()},
+'Package: mypackage2
+Depends: hello
+', "Dump of second binary package of $srcdir/control-1");
+

scripts/t/700_Dpkg_Control/control-1

@@ -0,0 +1,22 @@
+Source: mysource
+# This is a comment
+my-field-one: myvalue1
+my-field-two: myvalue2
+long-field: line1
+ line 2 line 2 line 2
+ line 3 line 3 line 3
+empty-field: 
+     
+# First package
+Package: mypackage1
+Depends: libc6
+
+# Second package
+Package: mypackage2
+Depends: hello
+
+Package: mypackage3
+Depends: hello
+Description: short one
+ long one
+ very long one