|
@@ -33,7 +33,7 @@ package Dpkg::Changelog::Parse;
|
|
use strict;
|
|
use strict;
|
|
use warnings;
|
|
use warnings;
|
|
|
|
|
|
-our $VERSION = '1.01';
|
|
|
|
|
|
+our $VERSION = '1.02';
|
|
our @EXPORT = qw(
|
|
our @EXPORT = qw(
|
|
changelog_parse_debian
|
|
changelog_parse_debian
|
|
changelog_parse_plugin
|
|
changelog_parse_plugin
|
|
@@ -46,15 +46,67 @@ use Dpkg ();
|
|
use Dpkg::Util qw(none);
|
|
use Dpkg::Util qw(none);
|
|
use Dpkg::Gettext;
|
|
use Dpkg::Gettext;
|
|
use Dpkg::ErrorHandling;
|
|
use Dpkg::ErrorHandling;
|
|
-use Dpkg::Changelog::Debian;
|
|
|
|
use Dpkg::Control::Changelog;
|
|
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
|
|
=head1 FUNCTIONS
|
|
|
|
|
|
=over 4
|
|
=over 4
|
|
|
|
|
|
=item $fields = changelog_parse_debian(%opt)
|
|
=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
|
|
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
|
|
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 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
|
|
can be overridden with $opt{file}. The default output format is "dpkg" but
|
|
it can be overridden with $opt{format}.
|
|
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
|
|
=cut
|
|
|
|
|
|
-sub changelog_parse_debian {
|
|
|
|
|
|
+sub _changelog_parse {
|
|
my (%options) = @_;
|
|
my (%options) = @_;
|
|
|
|
|
|
# Setup and sanity checks.
|
|
# 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{file} //= 'debian/changelog';
|
|
$options{label} //= $options{file};
|
|
$options{label} //= $options{file};
|
|
|
|
+ $options{changelogformat} //= _changelog_detect_format($options{file});
|
|
$options{format} //= 'dpkg';
|
|
$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;
|
|
$options{count} = 1;
|
|
}
|
|
}
|
|
-
|
|
|
|
my $range;
|
|
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};
|
|
$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})
|
|
$changes->load($options{file})
|
|
or error(g_('fatal error occurred while parsing %s'), $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) = @_;
|
|
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)
|
|
=head2 Version 1.01 (dpkg 1.18.2)
|
|
|
|
|