| Index: third_party/dpkg-dev/scripts/Dpkg/Changelog/Parse.pm
|
| diff --git a/third_party/dpkg-dev/scripts/Dpkg/Changelog/Parse.pm b/third_party/dpkg-dev/scripts/Dpkg/Changelog/Parse.pm
|
| new file mode 100644
|
| index 0000000000000000000000000000000000000000..41c4440d7e846d37606385c7556bb3848d2c430a
|
| --- /dev/null
|
| +++ b/third_party/dpkg-dev/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, see <https://www.gnu.org/licenses/>.
|
| +
|
| +=encoding utf8
|
| +
|
| +=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;
|
| +
|
| +our $VERSION = '1.00';
|
| +
|
| +use Dpkg ();
|
| +use Dpkg::Gettext;
|
| +use Dpkg::ErrorHandling;
|
| +use Dpkg::Control::Changelog;
|
| +
|
| +use Exporter qw(import);
|
| +our @EXPORT = qw(changelog_parse);
|
| +
|
| +=over 4
|
| +
|
| +=item 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},
|
| +F</usr/local/lib/dpkg/parsechangelog>, F</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 overridden
|
| +with $opt{changelogformat}. The program expects the content of the
|
| +changelog file on its standard input.
|
| +
|
| +The changelog file that is parsed is F<debian/changelog> by default but it
|
| +can be overridden 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',
|
| + "$Dpkg::LIBDIR/parsechangelog",
|
| + '/usr/lib/dpkg/parsechangelog');
|
| + my $format = 'debian';
|
| + 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{changelogformat}) {
|
| + $format = $options{changelogformat};
|
| + delete $options{changelogformat};
|
| + $force = 1;
|
| + }
|
| +
|
| + # Set a default filename
|
| + if (not exists $options{file}) {
|
| + $options{file} = 'debian/changelog';
|
| + }
|
| + my $changelogfile = $options{file};
|
| +
|
| + # Extract the format from the changelog file if possible
|
| + unless($force or ($changelogfile eq '-')) {
|
| + open(my $format_fh, '-|', 'tail', '-n', '40', $changelogfile)
|
| + or syserr(_g('cannot create pipe for %s'), 'tail');
|
| + while (<$format_fh>) {
|
| + $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
|
| + }
|
| + close($format_fh) 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(my $parser_fh, '-|');
|
| + syserr(_g('cannot fork for %s'), $parser) unless defined $pid;
|
| + if (not $pid) {
|
| + exec(@exec) or 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($parser_fh, _g('output of changelog parser'));
|
| + push @res, $fields;
|
| + }
|
| + close($parser_fh) or subprocerr(_g('changelog parser %s'), $parser);
|
| + if (wantarray) {
|
| + return @res;
|
| + } else {
|
| + return $res[0] if (@res);
|
| + return;
|
| + }
|
| +}
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +1;
|
|
|