scripts: Replace changelog program parsers with perl modules

Using programs to implement the custom changelog parsers was very
inefficient as it required to parse the custom changelog, output deb822
formatted entries to then parse that and output again with the desired
format.

These were implemented as programs because at the time the perl code
in dpkg was not using perl modules, so it was not easy to extend. Using
perl modules now is cleaner and allows for a faster implementation.

In addition there's no known users in Debian, so it was deemed safe to
remove the support without a transition.

6 files changed, 96 insertions, 307 deletions

diff --git a/scripts/Dpkg/Changelog/Parse.pm b/scripts/Dpkg/Changelog/Parse.pm
index 9f3d36c81..b57b7d99e 100644
--- a/scripts/Dpkg/Changelog/Parse.pm
+++ b/scripts/Dpkg/Changelog/Parse.pm
@@ -33,7 +33,7 @@ package Dpkg::Changelog::Parse;
 use strict;
 use warnings;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 our @EXPORT = qw(
     changelog_parse_debian
     changelog_parse_plugin
@@ -46,15 +46,67 @@ use Dpkg ();
 use Dpkg::Util qw(none);
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
-use Dpkg::Changelog::Debian;
 use Dpkg::Control::Changelog;
 
+sub _changelog_detect_format {
+    my $file = shift;
+    my $format = 'debian';
+
+    # Extract the format from the changelog file if possible
+    if ($file ne '-') {
+        local $_;
+
+        open my $format_fh, '-|', 'tail', '-n', '40', $file
+            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'), $file);
+    }
+
+    return $format;
+}
+
 =head1 FUNCTIONS
 
 =over 4
 
 =item $fields = changelog_parse_debian(%opt)
 
+This function is deprecated, use changelog_parse() instead, with the changelog
+format set to "debian".
+
+=cut
+
+sub changelog_parse_debian {
+    my (%options) = @_;
+
+    warnings::warnif('deprecated',
+                     'deprecated function changelog_parse_debian, use changelog_parse instead');
+
+    # Force the plugin to be debian.
+    $options{changelogformat} = 'debian';
+
+    return _changelog_parse(%options);
+}
+
+=item $fields = changelog_parse_plugin(%opt)
+
+This function is deprecated, use changelog_parse() instead.
+
+=cut
+
+sub changelog_parse_plugin {
+    my (%options) = @_;
+
+    warnings::warnif('deprecated',
+                     'deprecated function changelog_parse_plugin, use changelog_parse instead');
+
+    return _changelog_parse(%options);
+}
+
+=item $fields = changelog_parse(%opt)
+
 This function will parse a changelog. In list context, it returns as many
 Dpkg::Control objects as the parser did create. In scalar context, it will
 return only the first one. If the parser did not return any data, it will
@@ -65,30 +117,53 @@ The changelog file that is parsed is F<debian/changelog> by default but it
 can be overridden with $opt{file}. The default output format is "dpkg" but
 it can be overridden with $opt{format}.
 
-The parsing itself is done by Dpkg::Changelog::Debian.
+The parsing itself is done by a parser module (searched in the standard
+perl library directories. That module is named according to the format that
+it is able to parse, with the name capitalized. By default it is either
+Dpkg::Changelog::Debian (from the "debian" format) or the format name looked
+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}.
+
+All the other keys in %opt are forwarded to the parser module constructor.
 
 =cut
 
-sub changelog_parse_debian {
+sub _changelog_parse {
     my (%options) = @_;
 
     # Setup and sanity checks.
+    if (exists $options{libdir}) {
+        warnings::warnif('deprecated',
+                         'obsolete libdir option, changelog parsers are now perl modules');
+    }
+
     $options{file} //= 'debian/changelog';
     $options{label} //= $options{file};
+    $options{changelogformat} //= _changelog_detect_format($options{file});
     $options{format} //= 'dpkg';
-    $options{all} = 1 if exists $options{all};
 
-    if (none { defined $options{$_} } qw(since until from to offset count all)) {
+    my @range_opts = qw(since until from to offset count all);
+    $options{all} = 1 if exists $options{all};
+    if (none { defined $options{$_} } @range_opts) {
         $options{count} = 1;
     }
-
     my $range;
-    foreach my $opt (qw(since until from to offset count all)) {
+    foreach my $opt (@range_opts) {
         $range->{$opt} = $options{$opt} if exists $options{$opt};
     }
 
-    my $changes = Dpkg::Changelog::Debian->new(reportfile => $options{label},
-                                               range => $range);
+    # Find the right changelog parser.
+    my $format = ucfirst lc $options{changelogformat};
+    my $changes;
+    eval qq{
+        require Dpkg::Changelog::$format;
+        \$changes = Dpkg::Changelog::$format->new();
+    };
+    error(g_('changelog format %s is unknown: %s'), $format, $@) if $@;
+    $changes->set_options(reportfile => $options{label}, range => $range);
+
+    # Load and parse the changelog.
     $changes->load($options{file})
         or error(g_('fatal error occurred while parsing %s'), $options{file});
 
@@ -110,163 +185,25 @@ sub changelog_parse_debian {
     }
 }
 
-sub _changelog_detect_format {
-    my $file = shift;
-    my $format = 'debian';
-
-    # Extract the format from the changelog file if possible
-    if ($file ne '-') {
-        local $_;
-
-        open my $format_fh, '-|', 'tail', '-n', '40', $file
-            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'), $file);
-    }
-
-    return $format;
-}
-
-=item $fields = changelog_parse_plugin(%opt)
-
-This function will parse a changelog. In list context, it returns as many
-Dpkg::Control objects as the parser did output. In scalar context, it will
-return only the first one. If the parser did not return any data, it will
-return an empty list 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 is able to parse. By
-default it is either "debian" or the format name looked 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 is passed as is. If not, it is passed
-as "--<key>". If the value of the corresponding hash entry is defined, then
-it is passed as the parameter that follows.
-
-=cut
-
-sub changelog_parse_plugin {
+sub changelog_parse {
     my (%options) = @_;
 
-    # Setup and sanity checks.
-    $options{file} //= 'debian/changelog';
-
-    my @parserpath = ('/usr/local/lib/dpkg/parsechangelog',
-                      "$Dpkg::LIBDIR/parsechangelog",
-                      '/usr/lib/dpkg/parsechangelog');
-    my $format;
-
-    # Extract and remove options that do not concern the changelog parser
-    # itself (and that we shouldn't forward)
-    delete $options{forceplugin};
-    if (exists $options{libdir}) {
-	unshift @parserpath, $options{libdir};
-	delete $options{libdir};
-    }
-    if (exists $options{changelogformat}) {
-	$format = $options{changelogformat};
-	delete $options{changelogformat};
-    } else {
-	$format = _changelog_detect_format($options{file});
-    }
-
-    # 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$options{file}");
-    foreach my $option (keys %options) {
-	if ($option =~ m/^-/) {
-	    # Options passed untouched
-	    push @exec, $option;
-	} else {
-	    # Non-options are mapped to long options
-	    push @exec, "--$option";
-	}
-	push @exec, $options{$option} if defined $options{$option};
-    }
-
-    # 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 execute format parser: %s'), $parser);
+    if (exists $options{forceplugin}) {
+        warnings::warnif('deprecated', 'obsolete forceplugin option');
     }
 
-    # 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;
-    }
+    return _changelog_parse(%options);
 }
 
-=item $fields = changelog_parse(%opt)
-
-This function will parse a changelog. In list context, it returns as many
-Dpkg::Control objects as the parser did create. In scalar context, it will
-return only the first one. If the parser did not return any data, it will
-return an empty list in list context or undef on scalar context. If the
-parser failed, it will die.
-
-If $opt{forceplugin} is false and $opt{changelogformat} is "debian", then
-changelog_parse_debian() is called to perform the parsing. Otherwise
-changelog_parse_plugin() is used.
-
-The changelog file that is parsed is F<debian/changelog> by default but it
-can be overridden with $opt{file}.
-
-=cut
-
-sub changelog_parse {
-    my (%options) = @_;
+=back
 
-    $options{forceplugin} //= 0;
-    $options{file} //= 'debian/changelog';
-    $options{changelogformat} //= _changelog_detect_format($options{file});
+=head1 CHANGES
 
-    if (not $options{forceplugin} and
-        $options{changelogformat} eq 'debian') {
-        return changelog_parse_debian(%options);
-    } else {
-        return changelog_parse_plugin(%options);
-    }
-}
+=head2 Version 1.02 (dpkg 1.18.8)
 
-=back
+Deprecated functions: changelog_parse_debian(), changelog_parse_plugin().
 
-=head1 CHANGES
+Obsolete options: $forceplugin, $libdir.
 
 =head2 Version 1.01 (dpkg 1.18.2)
 
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index a15abf5eb..152c2e4cb 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -21,10 +21,6 @@ bin_SCRIPTS = \
 	dpkg-source \
 	dpkg-vendor
 
-changelogdir = $(pkglibdir)/parsechangelog
-changelog_SCRIPTS = \
-	changelog/debian
-
 EXTRA_DIST = \
 	dpkg-architecture.pl \
 	dpkg-buildflags.pl \
@@ -43,14 +39,13 @@ EXTRA_DIST = \
 	dpkg-shlibdeps.pl \
 	dpkg-source.pl \
 	dpkg-vendor.pl \
-	changelog/debian.pl \
 	$(test_scripts) \
 	$(test_data)
 
 
 CLEANFILES = \
 	$(test_data_objects) \
-	$(bin_SCRIPTS) $(changelog_SCRIPTS)
+	$(bin_SCRIPTS)
 
 perllibdir = $(PERL_LIBDIR)
 nobase_dist_perllib_DATA = \
diff --git a/scripts/changelog/.gitignore b/scripts/changelog/.gitignore
deleted file mode 100644
index 2dee1753e..000000000
--- a/scripts/changelog/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-debian
diff --git a/scripts/changelog/debian.pl b/scripts/changelog/debian.pl
deleted file mode 100755
index 0f422bdb6..000000000
--- a/scripts/changelog/debian.pl
+++ /dev/null
@@ -1,138 +0,0 @@
-#!/usr/bin/perl
-#
-# parsechangelog/debian
-#
-# Copyright © 1996 Ian Jackson
-# Copyright © 2005,2007 Frank Lichtenheld
-# Copyright © 2006-2014 Guillem Jover <guillem@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/>.
-
-use strict;
-use warnings;
-
-use Getopt::Long qw(:config posix_default bundling no_ignorecase);
-
-use Dpkg ();
-use Dpkg::Util qw(none);
-use Dpkg::Gettext;
-use Dpkg::ErrorHandling;
-use Dpkg::Changelog::Debian;
-
-textdomain('dpkg-dev');
-
-$Dpkg::PROGNAME = "parsechangelog/$Dpkg::PROGNAME";
-
-sub version {
-    printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
-
-    printf g_('
-This is free software; see the GNU General Public License version 2 or
-later for copying conditions. There is NO warranty.
-');
-}
-
-sub usage {
-    printf g_(
-'Usage: %s [<option>...] [<changelog-file>]')
-    . "\n\n" . g_(
-"Options:
-      --file <file>       changelog <file> to parse (defaults to '-').
-  -l, --label <file>      changelog <file> name to use in error messages.
-      --format <output-format>
-                          set the output format (defaults to 'dpkg').
-      --all               include all changes.
-  -s, --since <version>   include all changes later than <version>.
-  -v <version>            ditto.
-  -u, --until <version>   include all changes earlier than <version>.
-  -f, --from <version>    include all changes equal or later than <version>.
-  -t, --to <version>      include all changes up to or equal than <version>.
-  -c, --count <number>    include <number> entries from the top (or tail if
-                            <number> is lower than 0).
-  -n <number>             ditto.
-  -o, --offset <number>   change starting point for --count, counted from
-                            the top (or tail if <number> is lower than 0).
-  -?, --help              print usage information.
-  -V, --version           print version information.
-"), $Dpkg::PROGNAME;
-}
-
-my ( $since, $until, $from, $to, $all, $count, $offset, $file, $label );
-my $default_file = '-';
-my $format = 'dpkg';
-my %allowed_formats = (
-    dpkg => 1,
-    rfc822 => 1,
-    );
-
-sub set_format {
-    my ($opt, $val) = @_;
-
-    unless ($allowed_formats{$val}) {
-	usageerr(g_('output format %s not supported'), $val );
-    }
-
-    $format = $val;
-}
-
-my @options_spec = (
-    'file=s' => \$file,
-    'label|l=s' => \$label,
-    'since|v=s' => \$since,
-    'until|u=s' => \$until,
-    'from|f=s' => \$from,
-    'to|t=s' => \$to,
-    'count|c|n=i' => \$count,
-    'offset|o=i' => \$offset,
-    'help|?' => sub{ usage(); exit(0) },
-    'version|V' => sub{version();exit(0)},
-    'format=s' => \&set_format,
-    'all|a' => \$all,
-);
-
-{
-    local $SIG{__WARN__} = sub { usageerr($_[0]) };
-    GetOptions(@options_spec);
-}
-
-usageerr('too many arguments') if @ARGV > 1;
-
-if (@ARGV) {
-    if ($file && ($file ne $ARGV[0])) {
-	usageerr(g_('more than one file specified (%s and %s)'),
-		 $file, $ARGV[0] );
-    }
-    $file = $ARGV[0];
-}
-
-$file //= $default_file;
-$label //= $file;
-
-my %all = $all ? ( all => $all ) : ();
-my $range = {
-    since => $since, until => $until, from => $from, to => $to,
-    count => $count, offset => $offset,
-    %all
-};
-if (none { defined $range->{$_} } qw(since until from to offset count all)) {
-    $range->{count} = 1;
-}
-
-my $changes = Dpkg::Changelog::Debian->new(reportfile => $label, range => $range);
-
-$changes->load($file)
-    or error(g_('fatal error occurred while parsing %s'), $file);
-
-my $entries = $changes->format_range($format, $range);
-print $entries if defined $entries;
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index d37e91a0e..9f826a9eb 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -49,7 +49,6 @@ sub usage {
 'Options:
   -l <changelog-file>      get per-version info from this file.
   -F <changelog-format>    force changelog format.
-  -L <libdir>              look for changelog parsers in <libdir>.
   -S, --show-field <field> show the values for <field>.
   -?, --help               show this help message.
       --version            show the version.')
@@ -81,9 +80,7 @@ while (@ARGV) {
     if ($arg eq '--') {
         last;
     } elsif ($arg eq '-L') {
-        $options{libdir} = shift;
-        usageerr(g_('missing library directory'))
-            unless length $options{libdir};
+        warning(g_('-L is obsolete; it is without effect'));
     } elsif ($arg eq '-F') {
         $options{changelogformat} = shift;
         usageerr(g_('bad changelog format name'))
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index c225de62d..ab99f47e9 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -16,7 +16,6 @@ scripts/dpkg-scansources.pl
 scripts/dpkg-shlibdeps.pl
 scripts/dpkg-source.pl
 scripts/dpkg-vendor.pl
-scripts/changelog/debian.pl
 scripts/Dpkg/Arch.pm
 scripts/Dpkg/BuildFlags.pm
 scripts/Dpkg/BuildOptions.pm