[PATCH] Integrated dpkg-parsechangelog processing into Dpkg::Changelog::parse_changelog()
* scripts/Dpkg/Changelog.pm (parse_changelog): Rewrite it completely
to not call dpkg-parsechangelog but do the work of this program by itself.
* scripts/dpkg-parsechangelog.pl: Rewrote it to use the enhanced
parse_changelog() function.
* scripts/dpkg-genchanges.pl, script/dpkg-gencontrol.pl: Adapted to use
the modified parse_changelog().
* scripts/dpkg-gensymbols.pl, scripts/dpkg-source.pl: Likewise.
---
scripts/Dpkg/Changelog.pm | 109 +++++++++++++++++++++++++++++++++++----
scripts/dpkg-genchanges.pl | 12 ++++-
scripts/dpkg-gencontrol.pl | 4 +-
scripts/dpkg-gensymbols.pl | 3 +-
scripts/dpkg-parsechangelog.pl | 98 +++++++++++++++---------------------
scripts/dpkg-source.pl | 4 +-
6 files changed, 156 insertions(+), 74 deletions(-)
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 18db282..70992bc 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -39,7 +39,7 @@ use English;
use Dpkg;
use Dpkg::Gettext;
-use Dpkg::ErrorHandling qw(warning report syserr subprocerr);
+use Dpkg::ErrorHandling qw(warning report syserr subprocerr error);
use Dpkg::Cdata;
use Dpkg::Fields;
@@ -689,23 +689,108 @@ sub get_dpkg_changes {
=pod
-=head3 parse_changelog($file, $format, $since)
+=head3 my $fields = parse_changelog(%opt)
-Calls "dpkg-parsechangelog -l$file -F$format -v$since" and returns a
-Dpkg::Fields::Object with the values output by the program.
+This function will parse a changelog and return a Dpkg::Fields::Object
+with some sumary information. It will return undef if the parser didn't
+return any data. If the parser failed, it will die.
+
+The parsing itself is done by an external program (either in
+/usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog
+or in $opt{libdir}). That program is named according to the format
+that it's able to parse. By default it's "debian" 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 ($changelogfile, $changelogformat, $since) = @_;
+ my (%options) = @_;
+ my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
+ "$dpkglibdir/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);
+ }
- my @exec = ('dpkg-parsechangelog');
- push(@exec, "-l$changelogfile");
- push(@exec, "-F$changelogformat") if defined($changelogformat);
- push(@exec, "-v$since") if defined($since);
+ # 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, "-|");
+ 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);
+ }
- open(PARSECH, "-|", @exec) || syserr(_g("fork for parse changelog"));
- my $fields = parsecdata(\*PARSECH, _g("parsed version of changelog"));
- close(PARSECH) || subprocerr(_g("parse changelog"));
+ # Get the output into a Dpkg::Fields::Object
+ my $fields = parsecdata(\*P, _g("output of changelog parser"));
+ close(P) or subprocerr(_g("changelog parser %s"), $parser);
return $fields;
}
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index f6ada09..3e5f6d5 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -180,7 +180,17 @@ while (@ARGV) {
}
}
-my $changelog = parse_changelog($changelogfile, $changelogformat, $since);
+# Retrieve info from the current changelog entry
+my %options = (file => $changelogfile);
+$options{"changelogformat"} = $changelogformat if $changelogformat;
+$options{"since"} = $since if $since;
+my $changelog = parse_changelog(%options);
+# Change options to retrieve info of the former changelog entry
+delete $options{"since"};
+$options{"count"} = 1;
+$options{"offset"} = 1;
+my $prev_changelog = parse_changelog(%options);
+# Other initializations
my $control = Dpkg::Control->new($controlfile);
my $fields = Dpkg::Fields::Object->new();
$substvars->set_version_substvars($changelog->{"Version"});
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index 6ae5c72..d6e8bef 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -121,7 +121,9 @@ while (@ARGV) {
}
}
-my $changelog = parse_changelog($changelogfile, $changelogformat);
+my %options = (file => $changelogfile);
+$options{"changelogformat"} = $changelogformat if $changelogformat;
+my $changelog = parse_changelog(%options);
$substvars->set_version_substvars($changelog->{"Version"});
$substvars->parse($varlistfile) if -e $varlistfile;
$substvars->set("binary:Version", $forceversion) if defined $forceversion;
diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl
index 592ea25..ac3799d 100755
--- a/scripts/dpkg-gensymbols.pl
+++ b/scripts/dpkg-gensymbols.pl
@@ -15,7 +15,6 @@ use Dpkg::Changelog qw(parse_changelog);
textdomain("dpkg-dev");
-my $changelogfile = 'debian/changelog';
my $packagebuilddir = 'debian/tmp';
my $sourceversion;
@@ -109,7 +108,7 @@ if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
}
if (not defined($sourceversion)) {
- my $changelog = parse_changelog($changelogfile);
+ my $changelog = parse_changelog();
$sourceversion = $changelog->{"Version"};
}
if (not defined($oppackage)) {
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index 26b0929..9ea3c4f 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -9,17 +9,11 @@ use POSIX qw(:errno_h);
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error syserr subprocerr usageerr);
+use Dpkg::Changelog qw(parse_changelog);
textdomain("dpkg-dev");
-my $format ='debian';
-my $changelogfile = 'debian/changelog';
-my @parserpath = ("/usr/local/lib/dpkg/parsechangelog",
- "$dpkglibdir/parsechangelog");
-
-my $libdir;
-my $force;
-
+my %options;
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
@@ -64,60 +58,50 @@ parser options:
"), $progname;
}
-my @ap = ();
while (@ARGV) {
last unless $ARGV[0] =~ m/^-/;
- $_= shift(@ARGV);
- 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=$POSTMATCH; next; }
- m/^--$/ && last;
- 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(_g("unknown option \`%s'"), $_);
-}
-
-@ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-
-if (not $force and $changelogfile ne "-") {
- 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;
- }
- close(P);
- $? && subprocerr(_g("tail of %s"), $changelogfile);
-}
-
-my ($pa, $pf);
-
-unshift(@parserpath, $libdir) if $libdir;
-for my $pd (@parserpath) {
- $pa= "$pd/$format";
- if (!stat("$pa")) {
- $! == ENOENT || syserr(_g("failed to check for format parser %s"), $pa);
- } elsif (!-x _) {
- warning(_g("format parser %s not executable"), $pa);
- } else {
- $pf= $pa;
+ $_ = shift(@ARGV);
+ if (m/^-L(.+)$/) {
+ $options{"libdir"} = $1;
+ } elsif (m/^-F([0-9a-z]+)$/) {
+ $options{"changelogformat"} = $1;
+ } elsif (m/^-l(.+)$/) {
+ $options{"file"} = $1;
+ } elsif (m/^--$/) {
last;
+ } elsif (m/^-([cfnostuv])(.*)$/) {
+ if (($1 eq "c") or ($1 eq "n")) {
+ $options{"count"} = $2;
+ } elsif ($1 eq "f") {
+ $options{"from"} = $2;
+ } elsif ($1 eq "o") {
+ $options{"offset"} = $2;
+ } elsif (($1 eq "s") or ($1 eq "v")) {
+ $options{"since"} = $2;
+ } elsif ($1 eq "t") {
+ $options{"to"} = $2;
+ } elsif ($1 eq "u") {
+ $options{"until"} = $2;
+ }
+ } elsif (m/^--(count|file|format|from|offset|since|to|until)(.*)$/) {
+ if ($2) {
+ $options{$1} = $2;
+ } else {
+ $options{$1} = shift(@ARGV);
+ }
+ } elsif (m/^--all$/) {
+ $options{"all"} = undef;
+ } elsif (m/^-(h|-help)$/) {
+ usage(); exit(0);
+ } elsif (m/^--version$/) {
+ version(); exit(0);
+ } else {
+ usageerr(_g("unknown option \`%s'"), $_);
}
}
-defined($pf) || error(_g("format %s unknown"), $pa);
+@ARGV && usageerr(_g("%s takes no non-option arguments"), $progname);
-if ($changelogfile ne "-") {
- open(STDIN,"<", $changelogfile)
- || syserr(_g("cannot open %s: %s"), $changelogfile);
-}
-exec($pf,@ap) || syserr(_g("cannot exec format parser: %s"));
+my $fields = parse_changelog(%options);
+print tied(%$fields)->dump();
diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index 8c956b0..3aa8d67 100755
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -291,7 +291,9 @@ if ($opmode eq 'build') {
$changelogfile= "$dir/debian/changelog" unless defined($changelogfile);
$controlfile= "$dir/debian/control" unless defined($controlfile);
- my $changelog = parse_changelog($changelogfile, $changelogformat);
+ my %options = (file => $changelogfile);
+ $options{"changelogformat"} = $changelogformat if $changelogformat;
+ my $changelog = parse_changelog(%options);
my $control = Dpkg::Control->new($controlfile);
my $fields = Dpkg::Fields::Object->new();
--
1.5.3.8
Reply to: