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 |
deleted file mode 100644 |
index 41c4440d7e846d37606385c7556bb3848d2c430a..0000000000000000000000000000000000000000 |
--- a/third_party/dpkg-dev/scripts/Dpkg/Changelog/Parse.pm |
+++ /dev/null |
@@ -1,167 +0,0 @@ |
-# 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; |