+2008-01-18 Raphael Hertzog <hertzog@debian.org>
+
+ * 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 <guillem@debian.org>
* m4/arch.m4 (_DPKG_ARCHITECTURE): Do not use backticks inside double
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;
=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 "--<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"};
+ }
- 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(<P>) {
+ $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
}
}
-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"});
}
}
-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;
textdomain("dpkg-dev");
-my $changelogfile = 'debian/changelog';
my $packagebuilddir = 'debian/tmp';
my $sourceversion;
}
if (not defined($sourceversion)) {
- my $changelog = parse_changelog($changelogfile);
+ my $changelog = parse_changelog();
$sourceversion = $changelog->{"Version"};
}
if (not defined($oppackage)) {
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;
"), $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"), $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"));
$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();
projects / dpkg / commitdiff