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 (Dpkg::Changelog::Entry::Debian).
It implements the generic interface Dpkg::Changelog.
Only methods specific to this implementation are described below,
the rest are inherited.

Dpkg::Changelog::Debian parses Debian changelogs as described in
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;
46
47
6
6
6
6
12
3
65
use strict;
48
6
6
6
6
8
8
121
use warnings;
49
50our $VERSION = '1.00';
51
52
6
6
6
6
440
5
145
use Dpkg::Gettext;
53
6
6
6
6
471
3
178
use Dpkg::File;
54
6
6
6
6
578
5
94
use Dpkg::Changelog qw(:util);
55
6
6
6
6
781
5
192
use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer);
56
57
6
6
6
6
15
3
10
use parent qw(Dpkg::Changelog);
58
59use constant {
60
6
9
    FIRST_HEADING => g_('first heading'),
61    NEXT_OR_EOF => g_('next heading or end of file'),
62    START_CHANGES => g_('start of change data'),
63    CHANGES_OR_TRAILER => g_('more change data or trailer'),
64
6
6
6
225
7
};
65
66my $ancient_delimiter_re = qr{
67    ^
68    (?: # Ancient GNU style changelog entry with expanded date
69      (?:
70        \w+\s+                          # Day of week (abbreviated)
71        \w+\s+                          # Month name (abbreviated)
72        \d{1,2}                         # Day of month
73        \Q \E
74        \d{1,2}:\d{1,2}:\d{1,2}\s+      # Time
75        [\w\s]*                         # Timezone
76        \d{4}                           # Year
77      )
78      \s+
79      (?:.*)                            # Maintainer name
80      \s+
81      [<\(]
82        (?:.*)                          # Maintainer email
83      [\)>]
84    | # Old GNU style changelog entry with expanded date
85      (?:
86        \w+\s+                          # Day of week (abbreviated)
87        \w+\s+                          # Month name (abbreviated)
88        \d{1,2},?\s*                    # Day of month
89        \d{4}                           # Year
90      )
91      \s+
92      (?:.*)                            # Maintainer name
93      \s+
94      [<\(]
95        (?:.*)                          # Maintainer email
96      [\)>]
97    | # Ancient changelog header w/o key=value options
98      (?:\w[-+0-9a-z.]*)                # Package name
99      \Q \E
100      \(
101        (?:[^\(\) \t]+)                 # Package version
102      \)
103      \;?
104    | # Ancient changelog header
105      (?:[\w.+-]+)                      # Package name
106      [- ]
107      (?:\S+)                           # Package version
108      \ Debian
109      \ (?:\S+)                         # Package revision
110    |
111      Changes\ from\ version\ (?:.*)\ to\ (?:.*):
112    |
113      Changes\ for\ [\w.+-]+-[\w.+-]+:?\s*$
114    |
115      Old\ Changelog:\s*$
116    |
117      (?:\d+:)?
118      \w[\w.+~-]*:?
119      \s*$
120    )
121}xi;
122
123 - 135
=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 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
136
137sub parse {
138
28
28
1
32
    my ($self, $fh, $file) = @_;
139
28
50
127
    $file = $self->{reportfile} if exists $self->{reportfile};
140
141
28
57
    $self->reset_parse_errors;
142
143
28
29
    $self->{data} = [];
144
28
43
    $self->set_unparsed_tail(undef);
145
146
28
18
    my $expect = FIRST_HEADING;
147
28
81
    my $entry = Dpkg::Changelog::Entry::Debian->new();
148
28
25
    my @blanklines = ();
149    # To make version unique, for example for using as id.
150
28
16
    my $unknowncounter = 1;
151
28
19
    local $_;
152
153
28
55
    while (<$fh>) {
154
4370
2515
        chomp;
155
4370
100
50
100
50
50
50
100
100
100
100
100
50
2820
        if (match_header($_)) {
156
319
100
100
573
            unless ($expect eq FIRST_HEADING || $expect eq NEXT_OR_EOF) {
157
2
3
                $self->parse_error($file, $.,
158                    sprintf(g_('found start of entry where expected %s'),
159                    $expect), "$_");
160            }
161
319
100
268
            unless ($entry->is_empty) {
162
291
291
159
262
                push @{$self->{data}}, $entry;
163
291
265
                $entry = Dpkg::Changelog::Entry::Debian->new();
164
291
50
280
                last if $self->abort_early();
165            }
166
319
344
            $entry->set_part('header', $_);
167
319
263
            foreach my $error ($entry->parse_header()) {
168
3
4
                $self->parse_error($file, $., $error, $_);
169            }
170
319
185
            $expect= START_CHANGES;
171
319
354
            @blanklines = ();
172        } elsif (m/^(?:;;\s*)?Local variables:/io) {
173            # Save any trailing Emacs variables at end of file.
174
0
0
0
            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
175
0
0
            last;
176        } elsif (m/^vim:/io) {
177            # Save any trailing Vim modelines at end of file.
178
8
50
13
            $self->set_unparsed_tail("$_\n" . (file_slurp($fh) // ''));
179
8
8
            last;
180        } elsif (m/^\$\w+:.*\$/o) {
181
0
0
            next; # skip stuff that look like a RCS keyword
182        } elsif (m/^\# /o) {
183
0
0
            next; # skip comments, even that's not supported
184        } elsif (m{^/\*.*\*/}o) {
185
0
0
            next; # more comments
186        } elsif (m/$ancient_delimiter_re/) {
187            # save entries on old changelog format verbatim
188            # we assume the rest of the file will be in old format once we
189            # hit it for the first time
190
2
9
            $self->set_unparsed_tail("$_\n" . file_slurp($fh));
191        } elsif (m/^\S/) {
192
2
4
            $self->parse_error($file, $., g_('badly formatted heading line'), "$_");
193        } elsif (match_trailer($_)) {
194
317
50
242
            unless ($expect eq CHANGES_OR_TRAILER) {
195
0
0
                $self->parse_error($file, $.,
196                    sprintf(g_('found trailer where expected %s'), $expect), "$_");
197            }
198
317
323
            $entry->set_part('trailer', $_);
199
317
370
            $entry->extend_part('blank_after_changes', [ @blanklines ]);
200
317
252
            @blanklines = ();
201
317
245
            foreach my $error ($entry->parse_trailer()) {
202
0
0
                $self->parse_error($file, $., $error, $_);
203            }
204
317
365
            $expect = NEXT_OR_EOF;
205        } elsif (m/^ \-\-/) {
206
2
3
            $self->parse_error($file, $., g_('badly formatted trailer line'), "$_");
207        } elsif (m/^\s{2,}(?:\S)/) {
208
2779
50
67
3775
            unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
209
0
0
                $self->parse_error($file, $., sprintf(g_('found change data' .
210                    ' where expected %s'), $expect), "$_");
211
0
0
0
0
                if ($expect eq NEXT_OR_EOF and not $entry->is_empty) {
212                    # lets assume we have missed the actual header line
213
0
0
0
0
                    push @{$self->{data}}, $entry;
214
0
0
                    $entry = Dpkg::Changelog::Entry::Debian->new();
215
0
0
                    $entry->set_part('header', 'unknown (unknown' . ($unknowncounter++) . ') unknown; urgency=unknown');
216                }
217            }
218            # Keep raw changes
219
2779
2945
            $entry->extend_part('changes', [ @blanklines, $_ ]);
220
2779
1700
            @blanklines = ();
221
2779
2345
            $expect = CHANGES_OR_TRAILER;
222        } elsif (!m/\S/) {
223
941
100
100
50
809
            if ($expect eq START_CHANGES) {
224
315
332
                $entry->extend_part('blank_after_header', $_);
225
315
325
                next;
226            } elsif ($expect eq NEXT_OR_EOF) {
227
301
307
                $entry->extend_part('blank_after_trailer', $_);
228
301
298
                next;
229            } elsif ($expect ne CHANGES_OR_TRAILER) {
230
0
0
                $self->parse_error($file, $.,
231                    sprintf(g_('found blank line where expected %s'), $expect));
232            }
233
325
321
            push @blanklines, $_;
234        } else {
235
0
0
            $self->parse_error($file, $., g_('unrecognized line'), "$_");
236
0
0
0
0
            unless ($expect eq START_CHANGES or $expect eq CHANGES_OR_TRAILER) {
237                # lets assume change data if we expected it
238
0
0
                $entry->extend_part('changes', [ @blanklines, $_]);
239
0
0
                @blanklines = ();
240
0
0
                $expect = CHANGES_OR_TRAILER;
241            }
242        }
243    }
244
245
28
50
33
    unless ($expect eq NEXT_OR_EOF) {
246
0
0
        $self->parse_error($file, $.,
247                           sprintf(g_('found end of file where expected %s'),
248                                   $expect));
249    }
250
28
50
28
    unless ($entry->is_empty) {
251
28
28
12
31
        push @{$self->{data}}, $entry;
252    }
253
254
28
28
19
46
    return scalar @{$self->{data}};
255}
256
2571;
258
259=back
260
261 - 271
=head1 CHANGES

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=head1 SEE ALSO

Dpkg::Changelog

=cut