Move parse_changelog() to a separate module Dpkg::Changelog::Parse

Despite its name, this function does not actuallay parse anything by
itself, it just calls external parsers and returns their result. This
interface is largely used by other tools and is not tied with any of the
other Dpkg::Changelog modules so it's best kept separate.

Many scripts have to be updated to cope with the renaming.

10 files changed, 182 insertions, 139 deletions

diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 57898bd8f..0949e076e 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -53,7 +53,6 @@ our %EXPORT_TAGS = ( 'util' => [ qw(
                 data2rfc822
                 data2rfc822_mult
                 get_dpkg_changes
-		parse_changelog
 ) ] );
 our @EXPORT_OK = @{$EXPORT_TAGS{util}};
 
@@ -789,131 +788,6 @@ sub get_dpkg_changes {
     return $changes;
 }
 
-=pod
-
-=head3 my $fields = parse_changelog(%opt)
-
-This function will parse a changelog. In list context, it return as many
-Dpkg::Control object as the parser did output. In scalar context, it will
-return only the first one. If the parser didn't return any data, it will
-return an empty in list context or undef on scalar context. If the parser
-failed, it will die.
-
-The parsing itself is done by an external program (searched in the
-following list of directories: $opt{libdir},
-/usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog) That
-program is named according to the format that it's able to parse. By
-default it's either "debian" or the format name lookep up in the 40 last
-lines of the changelog itself (extracted with this perl regular expression
-"\schangelog-format:\s+([0-9a-z]+)\W"). But it can be overriden
-with $opt{changelogformat}. The program expects the content of the
-changelog file on its standard input.
-
-The changelog file that is parsed is debian/changelog by default but it
-can be overriden with $opt{file}.
-
-All the other keys in %opt are forwarded as parameter to the external
-parser. If the key starts with "-", it's passed as is. If not, it's passed
-as "--<key>". If the value of the corresponding hash entry is defined, then
-it's passed as the parameter that follows.
-
-=cut
-
-sub parse_changelog {
-    my (%options) = @_;
-    my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
-                      "$dpkglibdir/parsechangelog",
-                      "/usr/lib/dpkg/parsechangelog");
-    my $format = "debian";
-    my $changelogfile = "debian/changelog";
-    my $force = 0;
-
-    # Extract and remove options that do not concern the changelog parser
-    # itself (and that we shouldn't forward)
-    if (exists $options{"libdir"}) {
-	unshift @parserpath, $options{"libdir"};
-	delete $options{"libdir"};
-    }
-    if (exists $options{"file"}) {
-	$changelogfile = $options{"file"};
-	delete $options{"file"};
-    }
-    if (exists $options{"changelogformat"}) {
-	$format = $options{"changelogformat"};
-	delete $options{"changelogformat"};
-	$force = 1;
-    }
-    # XXX: For compatibility with old parsers, don't use --since but -v
-    # This can be removed later (in lenny+1 for example)
-    if (exists $options{"since"}) {
-	my $since = $options{"since"};
-	$options{"-v$since"} = undef;
-	delete $options{"since"};
-    }
-
-    # Extract the format from the changelog file if possible
-    unless($force or ($changelogfile eq "-")) {
-	open(P, "-|", "tail", "-n", "40", $changelogfile);
-	while(<P>) {
-	    $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
-	}
-	close(P) or subprocerr(_g("tail of %s"), $changelogfile);
-    }
-
-    # Find the right changelog parser
-    my $parser;
-    foreach my $dir (@parserpath) {
-        my $candidate = "$dir/$format";
-	next if not -e $candidate;
-	if (-x _) {
-	    $parser = $candidate;
-	    last;
-	} else {
-	    warning(_g("format parser %s not executable"), $candidate);
-	}
-    }
-    error(_g("changelog format %s is unknown"), $format) if not defined $parser;
-
-    # Create the arguments for the changelog parser
-    my @exec = ($parser, "-l$changelogfile");
-    foreach (keys %options) {
-	if (m/^-/) {
-	    # Options passed untouched
-	    push @exec, $_;
-	} else {
-	    # Non-options are mapped to long options
-	    push @exec, "--$_";
-	}
-	push @exec, $options{$_} if defined($options{$_});
-    }
-
-    # Fork and call the parser
-    my $pid = open(P, "-|");
-    syserr(_g("fork for %s"), $parser) unless defined $pid;
-    if (not $pid) {
-	if ($changelogfile ne "-") {
-	    open(STDIN, "<", $changelogfile) or
-		syserr(_g("cannot open %s"), $changelogfile);
-	}
-	exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser);
-    }
-
-    # Get the output into several Dpkg::Control objects
-    my (@res, $fields);
-    while (1) {
-        $fields = Dpkg::Control::Changelog->new();
-        last unless $fields->parse_fh(\*P, _g("output of changelog parser"));
-	push @res, $fields;
-    }
-    close(P) or subprocerr(_g("changelog parser %s"), $parser);
-    if (wantarray) {
-	return @res;
-    } else {
-	return $res[0] if (@res);
-	return undef;
-    }
-}
-
 1;
 __END__
 
diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm
new file mode 100644
index 000000000..91a54c176
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Parse.pm
@@ -0,0 +1,167 @@
+# Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de>
+# Copyright © 2009       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 St, Fifth Floor, Boston, MA  02110-1301 USA
+
+=head1 NAME
+
+Dpkg::Changelog::Parse - generic changelog parser for dpkg-parsechangelog
+
+=head1 DESCRIPTION
+
+This module provides a single function changelog_parse() which reproduces
+all the features of dpkg-parsechangelog.
+
+=head2 Functions
+
+=cut
+
+package Dpkg::Changelog::Parse;
+
+use strict;
+use warnings;
+
+use Dpkg; # for $dpkglibdir
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling;
+use Dpkg::Control::Changelog;
+
+use base qw(Exporter);
+our @EXPORT = qw(changelog_parse);
+
+=head3 my $fields = changelog_parse(%opt)
+
+This function will parse a changelog. In list context, it return as many
+Dpkg::Control object as the parser did output. In scalar context, it will
+return only the first one. If the parser didn't return any data, it will
+return an empty in list context or undef on scalar context. If the parser
+failed, it will die.
+
+The parsing itself is done by an external program (searched in the
+following list of directories: $opt{libdir},
+/usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog) That
+program is named according to the format that it's able to parse. By
+default it's either "debian" or the format name lookep up in the 40 last
+lines of the changelog itself (extracted with this perl regular expression
+"\schangelog-format:\s+([0-9a-z]+)\W"). But it can be overriden
+with $opt{changelogformat}. The program expects the content of the
+changelog file on its standard input.
+
+The changelog file that is parsed is debian/changelog by default but it
+can be overriden with $opt{file}.
+
+All the other keys in %opt are forwarded as parameter to the external
+parser. If the key starts with "-", it's passed as is. If not, it's passed
+as "--<key>". If the value of the corresponding hash entry is defined, then
+it's passed as the parameter that follows.
+
+=cut
+
+sub changelog_parse {
+    my (%options) = @_;
+    my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+                      "$dpkglibdir/parsechangelog",
+                      "/usr/lib/dpkg/parsechangelog");
+    my $format = "debian";
+    my $changelogfile = "debian/changelog";
+    my $force = 0;
+
+    # Extract and remove options that do not concern the changelog parser
+    # itself (and that we shouldn't forward)
+    if (exists $options{"libdir"}) {
+	unshift @parserpath, $options{"libdir"};
+	delete $options{"libdir"};
+    }
+    if (exists $options{"file"}) {
+	$changelogfile = $options{"file"};
+	delete $options{"file"};
+    }
+    if (exists $options{"changelogformat"}) {
+	$format = $options{"changelogformat"};
+	delete $options{"changelogformat"};
+	$force = 1;
+    }
+    # XXX: For compatibility with old parsers, don't use --since but -v
+    # This can be removed later (in lenny+1 for example)
+    if (exists $options{"since"}) {
+	my $since = $options{"since"};
+	$options{"-v$since"} = undef;
+	delete $options{"since"};
+    }
+
+    # Extract the format from the changelog file if possible
+    unless($force or ($changelogfile eq "-")) {
+	open(P, "-|", "tail", "-n", "40", $changelogfile);
+	while(<P>) {
+	    $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
+	}
+	close(P) or subprocerr(_g("tail of %s"), $changelogfile);
+    }
+
+    # Find the right changelog parser
+    my $parser;
+    foreach my $dir (@parserpath) {
+        my $candidate = "$dir/$format";
+	next if not -e $candidate;
+	if (-x _) {
+	    $parser = $candidate;
+	    last;
+	} else {
+	    warning(_g("format parser %s not executable"), $candidate);
+	}
+    }
+    error(_g("changelog format %s is unknown"), $format) if not defined $parser;
+
+    # Create the arguments for the changelog parser
+    my @exec = ($parser, "-l$changelogfile");
+    foreach (keys %options) {
+	if (m/^-/) {
+	    # Options passed untouched
+	    push @exec, $_;
+	} else {
+	    # Non-options are mapped to long options
+	    push @exec, "--$_";
+	}
+	push @exec, $options{$_} if defined($options{$_});
+    }
+
+    # Fork and call the parser
+    my $pid = open(P, "-|");
+    syserr(_g("fork for %s"), $parser) unless defined $pid;
+    if (not $pid) {
+	if ($changelogfile ne "-") {
+	    open(STDIN, "<", $changelogfile) or
+		syserr(_g("cannot open %s"), $changelogfile);
+	}
+	exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser);
+    }
+
+    # Get the output into several Dpkg::Control objects
+    my (@res, $fields);
+    while (1) {
+        $fields = Dpkg::Control::Changelog->new();
+        last unless $fields->parse_fh(\*P, _g("output of changelog parser"));
+	push @res, $fields;
+    }
+    close(P) or subprocerr(_g("changelog parser %s"), $parser);
+    if (wantarray) {
+	return @res;
+    } else {
+	return $res[0] if (@res);
+	return undef;
+    }
+}
+
+1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index edfb6401a..a3468aeca 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -93,6 +93,7 @@ nobase_dist_perllib_DATA = \
 	Dpkg/Changelog/Debian.pm \
 	Dpkg/Changelog/Entry.pm \
 	Dpkg/Changelog/Entry/Debian.pm \
+	Dpkg/Changelog/Parse.pm \
 	Dpkg/Checksums.pm \
 	Dpkg/Compression.pm \
 	Dpkg/Control.pm \
diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl
index 6e383c615..464f1a80c 100755
--- a/scripts/dpkg-buildpackage.pl
+++ b/scripts/dpkg-buildpackage.pl
@@ -13,7 +13,7 @@ use Dpkg::ErrorHandling;
 use Dpkg::BuildOptions;
 use Dpkg::Compression;
 use Dpkg::Version;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 use Dpkg::Arch qw(get_build_arch debarch_to_gnutriplet);
 
 textdomain("dpkg-dev");
@@ -278,7 +278,7 @@ foreach my $flag (keys %flags) {
 my $cwd = cwd();
 my $dir = basename($cwd);
 
-my $changelog = parse_changelog();
+my $changelog = changelog_parse();
 
 my $pkg = mustsetvar($changelog->{source}, _g('source package'));
 my $version = mustsetvar($changelog->{version}, _g('source version'));
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 9bde36e19..f5e44b49c 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -17,7 +17,7 @@ use Dpkg::Control::Fields;
 use Dpkg::Control;
 use Dpkg::Substvars;
 use Dpkg::Vars;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 use Dpkg::Version;
 
 textdomain("dpkg-dev");
@@ -185,14 +185,14 @@ while (@ARGV) {
 my %options = (file => $changelogfile);
 $options{"changelogformat"} = $changelogformat if $changelogformat;
 $options{"since"} = $since if defined($since);
-my $changelog = parse_changelog(%options);
+my $changelog = changelog_parse(%options);
 # Change options to retrieve info of the former changelog entry
 delete $options{"since"};
 $options{"count"} = 1;
 $options{"offset"} = 1;
 my ($prev_changelog, $bad_parser);
 eval { # Do not fail if parser failed due to unsupported options
-    $prev_changelog = parse_changelog(%options);
+    $prev_changelog = changelog_parse(%options);
 };
 $bad_parser = 1 if ($@);
 # Other initializations
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index 814fb7874..8145c86f6 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -15,7 +15,7 @@ use Dpkg::Control::Info;
 use Dpkg::Control::Fields;
 use Dpkg::Substvars;
 use Dpkg::Vars;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 
 textdomain("dpkg-dev");
 
@@ -120,7 +120,7 @@ while (@ARGV) {
 umask 0022; # ensure sane default permissions for created files
 my %options = (file => $changelogfile);
 $options{"changelogformat"} = $changelogformat if $changelogformat;
-my $changelog = parse_changelog(%options);
+my $changelog = changelog_parse(%options);
 $substvars->set_version_substvars($changelog->{"Version"});
 $substvars->set_arch_substvars();
 $substvars->parse($varlistfile) if -e $varlistfile;
diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl
index e1dde104b..10d37b8cb 100755
--- a/scripts/dpkg-gensymbols.pl
+++ b/scripts/dpkg-gensymbols.pl
@@ -11,7 +11,7 @@ use Dpkg::Shlibs::SymbolFile;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Control::Info;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 use Dpkg::Path qw(check_files_are_the_same);
 
 textdomain("dpkg-dev");
@@ -118,7 +118,7 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
 }
 
 if (not defined($sourceversion)) {
-    my $changelog = parse_changelog();
+    my $changelog = changelog_parse();
     $sourceversion = $changelog->{"Version"};
 }
 if (not defined($oppackage)) {
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index f813139e9..5420929de 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -9,7 +9,7 @@ use POSIX qw(:errno_h);
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 
 textdomain("dpkg-dev");
 
@@ -105,7 +105,7 @@ while (@ARGV) {
 @ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
 
 my $count = 0;
-my @fields = parse_changelog(%options);
+my @fields = changelog_parse(%options);
 foreach my $f (@fields) {
     print "\n" if $count++;
     print $f->output();
diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 1d9e1a647..1db6a1cc5 100755
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -15,7 +15,7 @@ use Dpkg::Control::Fields;
 use Dpkg::Substvars;
 use Dpkg::Version;
 use Dpkg::Vars;
-use Dpkg::Changelog qw(parse_changelog);
+use Dpkg::Changelog::Parse;
 use Dpkg::Source::Compressor;
 use Dpkg::Source::Package;
 use Dpkg::Vendor qw(run_vendor_hook);
@@ -145,7 +145,7 @@ if ($options{'opmode'} eq 'build') {
     
     my %ch_options = (file => $changelogfile);
     $ch_options{"changelogformat"} = $changelogformat if $changelogformat;
-    my $changelog = parse_changelog(%ch_options);
+    my $changelog = changelog_parse(%ch_options);
     my $control = Dpkg::Control::Info->new($controlfile);
 
     my $srcpkg = Dpkg::Source::Package->new(options => \%options);
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index 1aa1b9b10..82a400ac8 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -19,6 +19,7 @@ scripts/Dpkg/Changelog.pm
 scripts/Dpkg/Changelog/Debian.pm
 scripts/Dpkg/Changelog/Entry.pm
 scripts/Dpkg/Changelog/Entry/Debian.pm
+scripts/Dpkg/Changelog/Parse.pm
 scripts/Dpkg/Checksums.pm
 scripts/Dpkg/Control.pm
 scripts/Dpkg/Control/Changelog.pm