From: Raphael Hertzog Date: Mon, 14 Jan 2008 21:39:48 +0000 (+0100) Subject: Integrated dpkg-parsechangelog processing into Dpkg::Changelog::parse_changelog() X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=808f74dc53b446d46ab9e7d426d50e7081d7403a;p=dpkg 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. --- diff --git a/ChangeLog b/ChangeLog index 62910a48..61948a66 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2008-01-18 Raphael Hertzog + + * 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. + 2008-01-18 Guillem Jover * m4/arch.m4 (_DPKG_ARCHITECTURE): Do not use backticks inside double diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm index 7d5b9410..38b93a01 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; @@ -693,24 +693,123 @@ 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. In list context, it return as many +Dpkg::Fields::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 "--". 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"}; + } - my @exec = ('dpkg-parsechangelog'); - push(@exec, "-l$changelogfile"); - push(@exec, "-F$changelogformat") if defined($changelogformat); - push(@exec, "-v$since") if defined($since); + # Extract the format from the changelog file if possible + unless($force or ($changelogfile eq "-")) { + open(P, "-|", "tail", "-n", "40", $changelogfile); + while(

) { + $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/; + } + close(P) or subprocerr(_g("tail of %s"), $changelogfile); + } - 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; + # 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::Fields::Object + my (@res, $fields); + while ($fields = parsecdata(\*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; + } } =head1 NAME diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index e88092f6..7c8d8595 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -181,7 +181,12 @@ 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); +# 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 6ae5c723..d6e8bef2 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 592ea25f..ac3799d6 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 1ae3da2b..2aeedc79 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,54 @@ 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(

) { - 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"), $changelogfile); +my $count = 0; +my @fields = parse_changelog(%options); +foreach my $f (@fields) { + print "\n" if $count++; + print tied(%$f)->dump(); } -exec($pf,@ap) || syserr(_g("cannot exec format parser: %s")); diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 92e82bd4..12355e1f 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();