| 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;
 | 
| 
 |