diff options
| -rw-r--r-- | scripts/Dpkg/Changelog.pm | 126 | ||||
| -rw-r--r-- | scripts/Dpkg/Changelog/Parse.pm | 167 | ||||
| -rw-r--r-- | scripts/Makefile.am | 1 | ||||
| -rwxr-xr-x | scripts/dpkg-buildpackage.pl | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-genchanges.pl | 6 | ||||
| -rwxr-xr-x | scripts/dpkg-gencontrol.pl | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-gensymbols.pl | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-parsechangelog.pl | 4 | ||||
| -rwxr-xr-x | scripts/dpkg-source.pl | 4 | ||||
| -rw-r--r-- | scripts/po/POTFILES.in | 1 |
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 |