mirror of https://gitee.com/openkylin/lintian.git
381 lines
12 KiB
Perl
381 lines
12 KiB
Perl
# Copyright (C) 2019 Felix Lechner <felix.lechner@lease-up.com>
|
|
#
|
|
# 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, you can find it on the World Wide
|
|
# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
|
|
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
|
|
# MA 02110-1301, USA.
|
|
|
|
package Lintian::Changelog;
|
|
|
|
use v5.20;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Carp;
|
|
use Const::Fast;
|
|
use Date::Parse;
|
|
|
|
use Lintian::Changelog::Entry;
|
|
|
|
const my $EMPTY => q{};
|
|
const my $SPACE => q{ };
|
|
const my $ASTERISK => q{*};
|
|
const my $UNKNOWN => q{unknown};
|
|
|
|
use Moo;
|
|
use namespace::clean;
|
|
|
|
=head1 NAME
|
|
|
|
Lintian::Changelog -- Parse a literal version string into its constituents
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Lintian::Changelog;
|
|
|
|
my $version = Lintian::Changelog->new;
|
|
$version->set('1.2.3-4', undef);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
A class for parsing literal version strings
|
|
|
|
=head1 CLASS METHODS
|
|
|
|
=over 4
|
|
|
|
=item new ()
|
|
|
|
Creates a new Lintian::Changelog object.
|
|
|
|
=cut
|
|
|
|
=item find_closes
|
|
|
|
Takes one string as argument and finds "Closes: #123456, #654321" statements
|
|
as supported by the Debian Archive software in it. Returns all closed bug
|
|
numbers in an array reference.
|
|
|
|
=cut
|
|
|
|
sub find_closes {
|
|
my $changes = shift;
|
|
my @closes = ();
|
|
|
|
while (
|
|
$changes
|
|
&& ($changes
|
|
=~ /(closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*)/ig)
|
|
) {
|
|
push(@closes, $1 =~ /\#?\s?(\d+)/g);
|
|
}
|
|
|
|
@closes = sort { $a <=> $b } @closes;
|
|
return \@closes;
|
|
}
|
|
|
|
=back
|
|
|
|
=head1 INSTANCE METHODS
|
|
|
|
=over 4
|
|
|
|
=item parse (STRING)
|
|
|
|
Parses STRING as the content of a debian/changelog file.
|
|
|
|
=cut
|
|
|
|
sub parse {
|
|
my ($self, $contents) = @_;
|
|
|
|
$self->errors([]);
|
|
$self->entries([]);
|
|
|
|
# careful with negative matching /m
|
|
unless (
|
|
$contents =~ m{^ \S+ \s* [(] [^\)]+ [)] \s* (?:[^ \t;]+ \s*)+ ; }mx) {
|
|
|
|
push(@{$self->errors}, [1, 'not a Debian changelog']);
|
|
return;
|
|
}
|
|
|
|
my @lines = split(/\n/, $contents);
|
|
|
|
# based on /usr/lib/dpkg/parsechangelog/debian
|
|
my $expect='first heading';
|
|
my $entry = Lintian::Changelog::Entry->new;
|
|
my $blanklines = 0;
|
|
|
|
# to make unknown version unique, for id
|
|
my $unknown_version_counter = 1;
|
|
|
|
my $position = 1;
|
|
for my $line (@lines) {
|
|
|
|
# trim end
|
|
$line =~ s/\s+\r?$//;
|
|
|
|
# print encode_utf*(sprintf(STDERR "%-39.39s %-39.39s\n",$expect,$line));
|
|
if ($line
|
|
=~ m/^(?<Source>\w[-+0-9a-z.]*) \((?<Version>[^\(\) \t]+)\)(?<Distribution>(?:\s+[-+0-9a-z.]+)+)\;\s*(?<kvpairs>.*)$/i
|
|
){
|
|
my $source = $+{Source};
|
|
my $version = $+{Version};
|
|
my $distribution = $+{Distribution};
|
|
my $kvpairs = $+{kvpairs};
|
|
|
|
unless ($expect eq 'first heading'
|
|
|| $expect eq 'next heading or eof') {
|
|
$entry->ERROR(
|
|
[
|
|
$position,
|
|
"found start of entry where expected $expect",$line
|
|
]
|
|
);
|
|
push @{$self->errors}, $entry->ERROR;
|
|
}
|
|
|
|
unless ($entry->is_empty) {
|
|
$entry->Closes(find_closes($entry->Changes));
|
|
|
|
push @{$self->entries}, $entry;
|
|
$entry = Lintian::Changelog::Entry->new;
|
|
}
|
|
|
|
$entry->position($position);
|
|
|
|
$entry->Header($line);
|
|
|
|
$entry->Source($source);
|
|
$entry->Version($version);
|
|
|
|
$distribution =~ s/^\s+//;
|
|
$entry->Distribution($distribution);
|
|
|
|
my %kvdone;
|
|
for my $kv (split(/\s*,\s*/,$kvpairs)) {
|
|
$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i
|
|
||push @{$self->errors},
|
|
[$position,"bad key-value after ';': '$kv'"];
|
|
my $k = ucfirst $1;
|
|
my $v = $2;
|
|
$kvdone{$k}++
|
|
&& push @{$self->errors},
|
|
[$position,"repeated key-value $k"];
|
|
if ($k eq 'Urgency') {
|
|
$v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i
|
|
||push @{$self->errors},
|
|
[$position,"badly formatted urgency value $v"];
|
|
$entry->Urgency($1);
|
|
$entry->Urgency_LC(lc($1));
|
|
$entry->Urgency_Comment($2);
|
|
} elsif ($k =~ m/^X[BCS]+-/i) {
|
|
# Extensions - XB for putting in Binary,
|
|
# XC for putting in Control, XS for putting in Source
|
|
$entry->{$k}= $v;
|
|
} else {
|
|
push @{$self->errors},
|
|
[$position,
|
|
"unknown key-value key $k - copying to XS-$k"];
|
|
$entry->{ExtraFields}{"XS-$k"} = $v;
|
|
}
|
|
}
|
|
$expect= 'start of change data';
|
|
$blanklines = 0;
|
|
|
|
} elsif ($line =~ /^(?:;;\s*)?Local variables:/i) {
|
|
last; # skip Emacs variables at end of file
|
|
|
|
} elsif ($line =~ /^vim:/i) {
|
|
last; # skip vim variables at end of file
|
|
|
|
} elsif ($line =~ /^\$\w+:.*\$/) {
|
|
next; # skip stuff that look like a CVS keyword
|
|
|
|
} elsif ($line =~ /^\# /) {
|
|
next; # skip comments, even that's not supported
|
|
|
|
} elsif ($line =~ m{^/\*.*\*/}) {
|
|
next; # more comments
|
|
|
|
} elsif ($line
|
|
=~ m/^(?:\w+\s+\w+\s+\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}\s+[\w\s]*\d{4})\s+(?:.*)\s+[<\(](?:.*)[\)>]/
|
|
|| $line
|
|
=~ m/^(?:\w+\s+\w+\s+\d{1,2},?\s*\d{4})\s+(?:.*)\s+[<\(](?:.*)[\)>]/
|
|
|| $line =~ m/^(?:\w[-+0-9a-z.]*) \((?:[^\(\) \t]+)\)\;?/i
|
|
|| $line =~ m/^(?:[\w.+-]+)[- ]\S+ Debian \S+/i
|
|
|| $line =~ m/^Changes from version (?:.*) to (?:.*):/i
|
|
|| $line =~ m/^Changes for [\w.+-]+-[\w.+-]+:?$/i
|
|
|| fc($line) eq fc('Old Changelog:')
|
|
|| $line =~ m/^(?:\d+:)?\w[\w.+~-]*:?$/) {
|
|
# save entries on old changelog format verbatim
|
|
# we assume the rest of the file will be in old format once we
|
|
# hit it for the first time
|
|
last;
|
|
|
|
} elsif ($line =~ m/^\S/) {
|
|
push @{$self->errors},
|
|
[$position,'badly formatted heading line', $line];
|
|
|
|
} elsif ($line
|
|
=~ m/^ \-\- (?<name>.*) <(?<email>.*)>(?<sep> ?)(?<date>(?:\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(?:\s+\([^\\\(\)]\))?)$/
|
|
) {
|
|
|
|
my $name = $+{name};
|
|
my $email = $+{email};
|
|
my $separator = $+{sep};
|
|
my $date = $+{date};
|
|
|
|
$expect eq 'more change data or trailer'
|
|
|| push @{$self->errors},
|
|
[$position,"found trailer where expected $expect", $line];
|
|
if ($separator ne $SPACE . $SPACE) {
|
|
push @{$self->errors},
|
|
[$position,'badly formatted trailer line', $line];
|
|
}
|
|
$entry->Trailer($line);
|
|
$entry->Maintainer("$name <$email>")
|
|
unless length $entry->Maintainer;
|
|
|
|
unless(length $entry->Date && defined $entry->Timestamp) {
|
|
$entry->Date($date);
|
|
$entry->Timestamp(str2time($date));
|
|
unless (defined $entry->Timestamp) {
|
|
push @{$self->errors},
|
|
[$position,"could not parse date $date"];
|
|
}
|
|
}
|
|
$expect = 'next heading or eof';
|
|
|
|
} elsif ($line =~ m/^ \-\-/) {
|
|
$entry->{ERROR}
|
|
= [$position, 'badly formatted trailer line', $line];
|
|
push @{$self->errors}, $entry->ERROR;
|
|
# $expect = 'next heading or eof'
|
|
# if $expect eq 'more change data or trailer';
|
|
|
|
} elsif ($line =~ m/^\s{2,}(\S)/) {
|
|
$expect eq 'start of change data'
|
|
|| $expect eq 'more change data or trailer'
|
|
|| do {
|
|
push @{$self->errors},
|
|
[$position,"found change data where expected $expect",$line];
|
|
if (($expect eq 'next heading or eof')
|
|
&& !$entry->is_empty) {
|
|
# lets assume we have missed the actual header line
|
|
$entry->Closes(find_closes($entry->Changes));
|
|
|
|
push @{$self->entries}, $entry;
|
|
|
|
$entry = Lintian::Changelog::Entry->new;
|
|
$entry->Source($UNKNOWN);
|
|
$entry->Distribution($UNKNOWN);
|
|
$entry->Urgency($UNKNOWN);
|
|
$entry->Urgency_LC($UNKNOWN);
|
|
$entry->Version($UNKNOWN . (++$unknown_version_counter));
|
|
$entry->Urgency_Comment($EMPTY);
|
|
$entry->ERROR(
|
|
[
|
|
$position,
|
|
"found change data where expected $expect",$line
|
|
]
|
|
);
|
|
}
|
|
};
|
|
$entry->{'Changes'} .= (" \n" x $blanklines)." $line\n";
|
|
if (!$entry->{Items} || $1 eq $ASTERISK) {
|
|
$entry->{Items} ||= [];
|
|
push @{$entry->{Items}}, "$line\n";
|
|
} else {
|
|
$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $line\n";
|
|
}
|
|
$blanklines = 0;
|
|
$expect = 'more change data or trailer';
|
|
|
|
} elsif ($line !~ m/\S/) {
|
|
next
|
|
if $expect eq 'start of change data'
|
|
|| $expect eq 'next heading or eof';
|
|
$expect eq 'more change data or trailer'
|
|
|| push @{$self->errors},
|
|
[$position,"found blank line where expected $expect"];
|
|
$blanklines++;
|
|
|
|
} else {
|
|
push @{$self->errors}, [$position, 'unrecognised line', $line];
|
|
( $expect eq 'start of change data'
|
|
|| $expect eq 'more change data or trailer')
|
|
&& do {
|
|
# lets assume change data if we expected it
|
|
$entry->{'Changes'} .= (" \n" x $blanklines)." $line\n";
|
|
if (!$entry->{Items}) {
|
|
$entry->{Items} ||= [];
|
|
push @{$entry->{Items}}, "$line\n";
|
|
} else {
|
|
$entry->{'Items'}[-1] .= (" \n" x $blanklines)." $line\n";
|
|
}
|
|
$blanklines = 0;
|
|
$expect = 'more change data or trailer';
|
|
$entry->ERROR([$position, 'unrecognised line', $line]);
|
|
};
|
|
}
|
|
|
|
} continue {
|
|
++$position;
|
|
}
|
|
|
|
$expect eq 'next heading or eof'
|
|
|| do {
|
|
$entry->ERROR([$position, "found eof where expected $expect"]);
|
|
push @{$self->errors}, $entry->ERROR;
|
|
};
|
|
|
|
unless ($entry->is_empty) {
|
|
$entry->Closes(find_closes($entry->Changes));
|
|
push @{$self->entries}, $entry;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
=item errors
|
|
|
|
=item entries
|
|
|
|
=cut
|
|
|
|
has errors => (is => 'rw', default => sub { [] });
|
|
has entries => (is => 'rw', default => sub { [] });
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Originally written by Felix Lechner <felix.lechner@lease-up.com> for Lintian.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
lintian(1)
|
|
|
|
=cut
|
|
|
|
1;
|
|
|
|
# Local Variables:
|
|
# indent-tabs-mode: nil
|
|
# cperl-indent-level: 4
|
|
# End:
|
|
# vim: syntax=perl sw=4 sts=4 sr et
|