File: | Dpkg/Changelog/Debian.pm |
Coverage: | 73.3% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
45 | package Dpkg::Changelog::Debian; | ||||||
46 | |||||||
47 | 6 6 6 | 12 3 65 | use strict; | ||||
48 | 6 6 6 | 8 8 121 | use warnings; | ||||
49 | |||||||
50 | our $VERSION = '1.00'; | ||||||
51 | |||||||
52 | 6 6 6 | 440 5 145 | use Dpkg::Gettext; | ||||
53 | 6 6 6 | 471 3 178 | use Dpkg::File; | ||||
54 | 6 6 6 | 578 5 94 | use Dpkg::Changelog qw(:util); | ||||
55 | 6 6 6 | 781 5 192 | use Dpkg::Changelog::Entry::Debian qw(match_header match_trailer); | ||||
56 | |||||||
57 | 6 6 6 | 15 3 10 | use parent qw(Dpkg::Changelog); | ||||
58 | |||||||
59 | use 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 | 225 7 | }; | ||||
65 | |||||||
66 | my $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 | |||||||
137 | sub parse { | ||||||
138 | 28 | 1 | 32 | my ($self, $fh, $file) = @_; | |||
139 | 28 | 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 | 2820 | if (match_header($_)) { | ||||
156 | 319 | 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 | 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 | 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 | $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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | |||||||
257 | 1; | ||||||
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 |