summaryrefslogtreecommitdiffstats
path: root/lib/Lintian/Changelog.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Lintian/Changelog.pm')
-rw-r--r--lib/Lintian/Changelog.pm380
1 files changed, 380 insertions, 0 deletions
diff --git a/lib/Lintian/Changelog.pm b/lib/Lintian/Changelog.pm
new file mode 100644
index 0000000..84854c3
--- /dev/null
+++ b/lib/Lintian/Changelog.pm
@@ -0,0 +1,380 @@
+# 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-10 06:12:01 +0000