The following commit has been merged in the master branch:
commit 99e3abcc33343dbfb65e585b496f451d433ed7fc
Author: Raphaël Hertzog <[email protected]>
Date: Sat Oct 24 17:54:31 2009 +0200
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.
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 57898bd..0949e07 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 0000000..91a54c1
--- /dev/null
+++ b/scripts/Dpkg/Changelog/Parse.pm
@@ -0,0 +1,167 @@
+# Copyright © 2005, 2007 Frank Lichtenheld <[email protected]>
+# Copyright © 2009 Raphaël Hertzog <[email protected]>
+#
+# 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 edfb640..a3468ae 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 6e383c6..464f1a8 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 9bde36e..f5e44b4 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 814fb78..8145c86 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 e1dde10..10d37b8 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 f813139..5420929 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 1d9e1a6..1db6a1c 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 1aa1b9b..82a400a 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
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
