File Coverage

File:Dpkg/Changelog/Debian.pm
Coverage:73.3%

linestmtbrancondsubpodtimecode
1# Copyright © 1996 Ian Jackson
2# Copyright © 2005 Frank Lichtenheld <frank@lichtenheld.de>
3# Copyright © 2009 Raphaël Hertzog <hertzog@debian.org>
4# Copyright © 2012-2017 Guillem Jover <guillem@debian.org>
5#
6# This program is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program.  If not, see <https://www.gnu.org/licenses/>.
18
19=encoding utf8
20
21 - 43
=head1 NAME

Dpkg::Changelog::Debian - parse Debian changelogs

=head1 DESCRIPTION

This class represents a Debian changelog file as an array of changelog
entries (L<Dpkg::Changelog::Entry::Debian>).
It implements the generic interface L<Dpkg::Changelog>.
Only methods specific to this implementation are described below,
the rest are inherited.

Dpkg::Changelog::Debian parses Debian changelogs as described in
L<deb-changelog(5)>.

The parser tries to ignore most cruft like # or /* */ style comments,
RCS keywords, Vim modelines, Emacs local variables and stuff from
older changelogs with other formats at the end of the file.
NOTE: most of these are ignored silently currently, there is no
parser error issued for them. This should become configurable in the
future.

=cut
44
45package Dpkg::Changelog::Debian 1.00;
46
47
18
18
18
18
42
13
333
use strict;
48
18
18
18
18
31
15
454
use warnings;
49
50
18
18
18
18
1306
21
698
use Dpkg::Gettext;
51
18
18
18
18
1979
21
632
use Dpkg::File;
52
18
18
18
18
2788
23
403
use Dpkg::Changelog;
53
18
18
18
18
3037
28
876
use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer);
54
55
18
18
18
18
76
17
42
use parent qw(Dpkg::Changelog);
56
57use constant {
58
18
43
    FIRST_HEADING => g_('first heading'),
59    NEXT_OR_EOF => g_('next heading or end of file'),
60    START_CHANGES => g_('start of change data'),
61    CHANGES_OR_TRAILER => g_('more change data or trailer'),
62
18
18
18
983
14
};
63
64my $ancient_delimiter_re = qr{
65    ^
66    (?: # Ancient GNU style changelog entry with expanded date
67      (?:
68        \w+\s+                          # Day of week (abbreviated)
69        \w+\s+                          # Month name (abbreviated)
70        \d{1,2}                         # Day of month
71        \Q \E
72        \d{1,2}:\d{1,2}:\d{1,2}\s+      # Time
73        [\w\s]*                         # Timezone
74        \d{4}                           # Year
75      )
76      \s+
77      (?:.*)                            # Maintainer name
78      \s+
79      [<\(]
80        (?:.*)                          # Maintainer email
81      [\)>]
82    | # Old GNU style changelog entry with expanded date
83      (?:
84        \w+\s+                          # Day of week (abbreviated)
85        \w+\s+                          # Month name (abbreviated)
86        \d{1,2},?\s*                    # Day of month
87        \d{4}                           # Year
88      )
89      \s+
90      (?:.*)                            # Maintainer name
91      \s+
92      [<\(]
93        (?:.*)                          # Maintainer email
94      [\)>]
95    | # Ancient changelog header w/o key=value options
96      (?:\w[-+0-9a-z.]*)                # Package name
97      \Q \E
98      \(
99        (?:[^\(\) \t]+)                 # Package version
100      \)
101      \;?
102    | # Ancient changelog header
103      (?:[\w.+-]+)                      # Package name
104      [- ]
105      (?:\S+)                           # Package version
106      \ Debian
107      \ (?:\S+)                         # Package revision
108    |
109      Changes\ from\ version\ (?:.*)\ to\ (?:.*):
110    |
111      Changes\ for\ [\w.+-]+-[\w.+-]+:?\s*$
112    |
113      Old\ Changelog:\s*$
114    |
115      (?:\d+:)?
116      \w[\w.+~-]*:?
117      \s*$
118    )
119}xi;
120
121 - 133
=head1 METHODS

=over 4

=item $count = $c->parse($fh, $description)

Read the filehandle and parse a Debian changelog in it, to store the entries
as an array of L<Dpkg::Changelog::Entry::Debian> objects.
Any previous entries in the object are reset before parsing new data.

Returns the number of changelog entries that have been parsed with success.

=cut
134
135sub parse {
136
84
84
1
111
    my ($self, $fh, $file) = @_;
137
84
50
445
    $file = $self->{reportfile} if exists $self->{reportfile};
138
139
84
204
    $self->reset_parse_errors;
140
141
84
112
    $self->{data} = [];
142
84
155
    $self->set_unparsed_tail(undef);
143
144
84
84
    my $expect = FIRST_HEADING;
145
84
375
    my $entry = Dpkg::Changelog::Entry::Debian->new();
146
84
85
    my @blanklines = ();
147    # To make version unique, for example for using as id.
148
84
65
    my $unknowncounter = 1;
149
84
79
    local $_;
150
151
84
176
    while (<$fh>) {
152
13110
9200
        chomp;
153
13110
100
50
100
50
50
50
100
100
100
100
100
50
10208
        if (match_header($_)) {
154
957
100
100
2306
            unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
155
6
11
                $self->parse_error($file, $.,
156                    sprintf(g_('found start of entry where expected %s'),
157                    $expect), "$_");
158            }
159
957
100
1170
            unless ($entry->is_empty) {
160
873
873
513
1107
                push @{$self->{data}}, $entry;
161
873
1159
                $entry = Dpkg::Changelog::Entry::Debian->new();
162
873
50
1291
                last if $self->abort_early();
163            }
164
957
1266
            $entry->set_part('header', $_);
165
957
1126
            foreach my $error ($entry->parse_header()) {
166
9
21
                $self->parse_error($file, $., $error, $_);
167            }
168
957
738
            $expect = START_CHANGES;
169
957
1498
            @blanklines = ();
170        } elsif (m/^(?:;;\s*)?Local variables:/io) {
171            # Save any trailing Emacs variables at end of file.
172
0
0
0
            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
173
0
0
            last;
174        } elsif (m/^vim:/io) {
175            # Save any trailing Vim modelines at end of file.
176
24
50
65
            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
177
24
29
            last;
178        } elsif (m/^\$\w+:.*\$/o) {
179
0
0
            next; # skip stuff that look like a RCS keyword
180        } elsif (m/^\# /o) {
181
0
0
            next; # skip comments, even that's not supported
182        } elsif (m{^/\*.*\*/}o) {
183
0
0
            next; # more comments
184        } elsif (m/$ancient_delimiter_re/) {
185            # save entries on old changelog format verbatim
186            # we assume the rest of the file will be in old format once we
187            # hit it for the first time
188
6
18
            $self->set_unparsed_tail("$_\n" . file_slurp($fh));
189        } elsif (m/^\S/) {
190
6
19
            $self->parse_error($file, $., g_('badly formatted heading line'), "$_");
191        } elsif (match_trailer($_)) {
192
951
50
913
            unless ($expect eq CHANGES_OR_TRAILER) {
193
0
0
                $self->parse_error($file, $.,
194                    sprintf(g_('found trailer where expected %s'), $expect), "$_");
195            }
196
951
1327
            $entry->set_part('trailer', $_);
197
951
1289
            $entry->extend_part('blank_after_changes', [ @blanklines ]);
198
951
913
            @blanklines = ();
199
951
1079
            foreach my $error ($entry->parse_trailer()) {
200
0
0
                $self->parse_error($file, $., $error, $_);
201            }
202
951
1605
            $expect = NEXT_OR_EOF;
203        } elsif (m/^ \-\-/) {
204
6
13
            $self->parse_error($file, $., g_('badly formatted trailer line'), "$_");
205        } elsif (m/^\s{2,}(?:\S)/) {
206
8337
50
67
14099
            unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
207
0
0
                $self->parse_error($file, $., sprintf(g_('found change data' .
208                    ' where expected %s'), $expect), "$_");
209
0
0
0
0
                if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
210                    # lets assume we have missed the actual header line
211
0
0
0
0
                    push @{$self->{data}}, $entry;
212
0
0
                    $entry = Dpkg::Changelog::Entry::Debian->new();
213
0
0
                    $entry->set_part('header', 'unknown (unknown' . ($unknowncounter++) . ') unknown; urgency=unknown');
214                }
215            }
216            # Keep raw changes
217
8337
10577
            $entry->extend_part('changes', [ @blanklines, $_ ]);
218
8337
5819
            @blanklines = ();
219
8337
8694
            $expect = CHANGES_OR_TRAILER;
220        } elsif (!m/\S/) {
221
2823
100
100
50
3185
            if ($expect eq START_CHANGES) {
222
945
1274
                $entry->extend_part('blank_after_header', $_);
223
945
1290
                next;
224            } elsif ($expect eq NEXT_OR_EOF) {
225
903
1131
                $entry->extend_part('blank_after_trailer', $_);
226
903
1119
                next;
227            } elsif ($expect ne CHANGES_OR_TRAILER) {
228
0
0
                $self->parse_error($file, $.,
229                    sprintf(g_('found blank line where expected %s'), $expect));
230            }
231
975
1315
            push @blanklines, $_;
232        } else {
233
0
0
            $self->parse_error($file, $., g_('unrecognized line'), "$_");
234
0
0
0
0
            unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
235                # lets assume change data if we expected it
236
0
0
                $entry->extend_part('changes', [ @blanklines, $_]);
237
0
0
                @blanklines = ();
238
0
0
                $expect = CHANGES_OR_TRAILER;
239            }
240        }
241    }
242
243
84
50
131
    unless ($expect eq NEXT_OR_EOF) {
244
0
0
        $self->parse_error($file, $.,
245                           sprintf(g_('found end of file where expected %s'),
246                                   $expect));
247    }
248
84
50
112
    unless ($entry->is_empty) {
249
84
84
56
133
        push @{$self->{data}}, $entry;
250    }
251
252
84
84
69
196
    return scalar @{$self->{data}};
253}
254
2551;
256
257=back
258
259 - 269
=head1 CHANGES

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=head1 SEE ALSO

L<Dpkg::Changelog>.

=cut