Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | # Copyright © 2005, 2007 Frank Lichtenheld <frank@lichtenheld.de> |
2 | # Copyright © 2009 Raphaël Hertzog <hertzog@debian.org> | |
3 | # | |
4 | # This program is free software; you can redistribute it and/or modify | |
5 | # it under the terms of the GNU General Public License as published by | |
6 | # the Free Software Foundation; either version 2 of the License, or | |
7 | # (at your option) any later version. | |
8 | # | |
9 | # This program is distributed in the hope that it will be useful, | |
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | # GNU General Public License for more details. | |
13 | # | |
14 | # You should have received a copy of the GNU General Public License | |
15 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
16 | ||
17 | =encoding utf8 | |
18 | ||
19 | =head1 NAME | |
20 | ||
21 | Dpkg::Changelog - base class to implement a changelog parser | |
22 | ||
23 | =head1 DESCRIPTION | |
24 | ||
25 | Dpkg::Changelog is a class representing a changelog file | |
26 | as an array of changelog entries (Dpkg::Changelog::Entry). | |
27 | By deriving this object and implementing its parse method, you | |
28 | add the ability to fill this object with changelog entries. | |
29 | ||
30 | =cut | |
31 | ||
32 | package Dpkg::Changelog; | |
33 | ||
34 | use strict; | |
35 | use warnings; | |
36 | ||
37 | our $VERSION = '1.01'; | |
38 | ||
39 | use Carp; | |
40 | ||
41 | use Dpkg::Gettext; | |
42 | use Dpkg::ErrorHandling qw(:DEFAULT report REPORT_WARN); | |
43 | use Dpkg::Control; | |
44 | use Dpkg::Control::Changelog; | |
45 | use Dpkg::Control::Fields; | |
46 | use Dpkg::Index; | |
47 | use Dpkg::Version; | |
48 | use Dpkg::Vendor qw(run_vendor_hook); | |
49 | ||
50 | use parent qw(Dpkg::Interface::Storable); | |
51 | ||
52 | use overload | |
53 | '@{}' => sub { return $_[0]->{data} }; | |
54 | ||
55 | =head1 METHODS | |
56 | ||
57 | =over 4 | |
58 | ||
59 | =item $c = Dpkg::Changelog->new(%options) | |
60 | ||
61 | Creates a new changelog object. | |
62 | ||
63 | =cut | |
64 | ||
65 | sub new { | |
66 | my ($this, %opts) = @_; | |
67 | my $class = ref($this) || $this; | |
68 | my $self = { | |
69 | verbose => 1, | |
70 | parse_errors => [] | |
71 | }; | |
72 | bless $self, $class; | |
73 | $self->set_options(%opts); | |
74 | return $self; | |
75 | } | |
76 | ||
77 | =item $c->load($filename) | |
78 | ||
79 | Parse $filename as a changelog. | |
80 | ||
81 | =cut | |
82 | ||
83 | =item $c->set_options(%opts) | |
84 | ||
85 | Change the value of some options. "verbose" (defaults to 1) defines | |
86 | whether parse errors are displayed as warnings by default. "reportfile" | |
87 | is a string to use instead of the name of the file parsed, in particular | |
88 | in error messages. "range" defines the range of entries that we want to | |
89 | parse, the parser will stop as soon as it has parsed enough data to | |
90 | satisfy $c->get_range($opts{range}). | |
91 | ||
92 | =cut | |
93 | ||
94 | sub set_options { | |
95 | my ($self, %opts) = @_; | |
96 | $self->{$_} = $opts{$_} foreach keys %opts; | |
97 | } | |
98 | ||
99 | =item $c->reset_parse_errors() | |
100 | ||
101 | Can be used to delete all information about errors occurred during | |
102 | previous L<parse> runs. | |
103 | ||
104 | =cut | |
105 | ||
106 | sub reset_parse_errors { | |
107 | my $self = shift; | |
108 | $self->{parse_errors} = []; | |
109 | } | |
110 | ||
111 | =item $c->parse_error($file, $line_nr, $error, [$line]) | |
112 | ||
113 | Record a new parse error in $file at line $line_nr. The error message is | |
114 | specified with $error and a copy of the line can be recorded in $line. | |
115 | ||
116 | =cut | |
117 | ||
118 | sub parse_error { | |
119 | my ($self, $file, $line_nr, $error, $line) = @_; | |
120 | ||
121 | push @{$self->{parse_errors}}, [ $file, $line_nr, $error, $line ]; | |
122 | ||
123 | if ($self->{verbose}) { | |
124 | if ($line) { | |
125 | warning("%20s(l$line_nr): $error\nLINE: $line", $file); | |
126 | } else { | |
127 | warning("%20s(l$line_nr): $error", $file); | |
128 | } | |
129 | } | |
130 | } | |
131 | ||
132 | =item $c->get_parse_errors() | |
133 | ||
134 | Returns all error messages from the last L<parse> run. | |
135 | If called in scalar context returns a human readable | |
136 | string representation. If called in list context returns | |
137 | an array of arrays. Each of these arrays contains | |
138 | ||
139 | =over 4 | |
140 | ||
141 | =item 1. | |
142 | ||
143 | a string describing the origin of the data (a filename usually). If the | |
144 | reportfile configuration option was given, its value will be used instead. | |
145 | ||
146 | =item 2. | |
147 | ||
148 | the line number where the error occurred | |
149 | ||
150 | =item 3. | |
151 | ||
152 | an error description | |
153 | ||
154 | =item 4. | |
155 | ||
156 | the original line | |
157 | ||
158 | =back | |
159 | ||
160 | =cut | |
161 | ||
162 | sub get_parse_errors { | |
163 | my $self = shift; | |
164 | ||
165 | if (wantarray) { | |
166 | return @{$self->{parse_errors}}; | |
167 | } else { | |
168 | my $res = ''; | |
169 | foreach my $e (@{$self->{parse_errors}}) { | |
170 | if ($e->[3]) { | |
171 | $res .= report(REPORT_WARN, g_("%s(l%s): %s\nLINE: %s"), @$e); | |
172 | } else { | |
173 | $res .= report(REPORT_WARN, g_('%s(l%s): %s'), @$e); | |
174 | } | |
175 | } | |
176 | return $res; | |
177 | } | |
178 | } | |
179 | ||
180 | =item $c->set_unparsed_tail($tail) | |
181 | ||
182 | Add a string representing unparsed lines after the changelog entries. | |
183 | Use undef as $tail to remove the unparsed lines currently set. | |
184 | ||
185 | =item $c->get_unparsed_tail() | |
186 | ||
187 | Return a string representing the unparsed lines after the changelog | |
188 | entries. Returns undef if there's no such thing. | |
189 | ||
190 | =cut | |
191 | ||
192 | sub set_unparsed_tail { | |
193 | my ($self, $tail) = @_; | |
194 | $self->{unparsed_tail} = $tail; | |
195 | } | |
196 | ||
197 | sub get_unparsed_tail { | |
198 | my $self = shift; | |
199 | return $self->{unparsed_tail}; | |
200 | } | |
201 | ||
202 | =item @{$c} | |
203 | ||
204 | Returns all the Dpkg::Changelog::Entry objects contained in this changelog | |
205 | in the order in which they have been parsed. | |
206 | ||
207 | =item $c->get_range($range) | |
208 | ||
209 | Returns an array (if called in list context) or a reference to an array of | |
210 | Dpkg::Changelog::Entry objects which each represent one entry of the | |
211 | changelog. $range is a hash reference describing the range of entries | |
212 | to return. See section L<"RANGE SELECTION">. | |
213 | ||
214 | =cut | |
215 | ||
216 | sub __sanity_check_range { | |
217 | my ($self, $r) = @_; | |
218 | my $data = $self->{data}; | |
219 | ||
220 | if (defined($r->{offset}) and not defined($r->{count})) { | |
221 | warning(g_("'offset' without 'count' has no effect")) if $self->{verbose}; | |
222 | delete $r->{offset}; | |
223 | } | |
224 | ||
225 | ## no critic (ControlStructures::ProhibitUntilBlocks) | |
226 | if ((defined($r->{count}) || defined($r->{offset})) && | |
227 | (defined($r->{from}) || defined($r->{since}) || | |
228 | defined($r->{to}) || defined($r->{until}))) | |
229 | { | |
230 | warning(g_("you can't combine 'count' or 'offset' with any other " . | |
231 | 'range option')) if $self->{verbose}; | |
232 | delete $r->{from}; | |
233 | delete $r->{since}; | |
234 | delete $r->{to}; | |
235 | delete $r->{until}; | |
236 | } | |
237 | if (defined($r->{from}) && defined($r->{since})) { | |
238 | warning(g_("you can only specify one of 'from' and 'since', using " . | |
239 | "'since'")) if $self->{verbose}; | |
240 | delete $r->{from}; | |
241 | } | |
242 | if (defined($r->{to}) && defined($r->{until})) { | |
243 | warning(g_("you can only specify one of 'to' and 'until', using " . | |
244 | "'until'")) if $self->{verbose}; | |
245 | delete $r->{to}; | |
246 | } | |
247 | ||
248 | # Handle non-existing versions | |
249 | my (%versions, @versions); | |
250 | foreach my $entry (@{$data}) { | |
251 | my $version = $entry->get_version(); | |
252 | next unless defined $version; | |
253 | $versions{$version->as_string()} = 1; | |
254 | push @versions, $version->as_string(); | |
255 | } | |
256 | if ((defined($r->{since}) and not exists $versions{$r->{since}})) { | |
257 | warning(g_("'%s' option specifies non-existing version"), 'since'); | |
258 | warning(g_('use newest entry that is earlier than the one specified')); | |
259 | foreach my $v (@versions) { | |
260 | if (version_compare_relation($v, REL_LT, $r->{since})) { | |
261 | $r->{since} = $v; | |
262 | last; | |
263 | } | |
264 | } | |
265 | if (not exists $versions{$r->{since}}) { | |
266 | # No version was earlier, include all | |
267 | warning(g_('none found, starting from the oldest entry')); | |
268 | delete $r->{since}; | |
269 | $r->{from} = $versions[-1]; | |
270 | } | |
271 | } | |
272 | if ((defined($r->{from}) and not exists $versions{$r->{from}})) { | |
273 | warning(g_("'%s' option specifies non-existing version"), 'from'); | |
274 | warning(g_('use oldest entry that is later than the one specified')); | |
275 | my $oldest; | |
276 | foreach my $v (@versions) { | |
277 | if (version_compare_relation($v, REL_GT, $r->{from})) { | |
278 | $oldest = $v; | |
279 | } | |
280 | } | |
281 | if (defined($oldest)) { | |
282 | $r->{from} = $oldest; | |
283 | } else { | |
284 | warning(g_("no such entry found, ignoring '%s' parameter"), 'from'); | |
285 | delete $r->{from}; # No version was oldest | |
286 | } | |
287 | } | |
288 | if (defined($r->{until}) and not exists $versions{$r->{until}}) { | |
289 | warning(g_("'%s' option specifies non-existing version"), 'until'); | |
290 | warning(g_('use oldest entry that is later than the one specified')); | |
291 | my $oldest; | |
292 | foreach my $v (@versions) { | |
293 | if (version_compare_relation($v, REL_GT, $r->{until})) { | |
294 | $oldest = $v; | |
295 | } | |
296 | } | |
297 | if (defined($oldest)) { | |
298 | $r->{until} = $oldest; | |
299 | } else { | |
300 | warning(g_("no such entry found, ignoring '%s' parameter"), 'until'); | |
301 | delete $r->{until}; # No version was oldest | |
302 | } | |
303 | } | |
304 | if (defined($r->{to}) and not exists $versions{$r->{to}}) { | |
305 | warning(g_("'%s' option specifies non-existing version"), 'to'); | |
306 | warning(g_('use newest entry that is earlier than the one specified')); | |
307 | foreach my $v (@versions) { | |
308 | if (version_compare_relation($v, REL_LT, $r->{to})) { | |
309 | $r->{to} = $v; | |
310 | last; | |
311 | } | |
312 | } | |
313 | if (not exists $versions{$r->{to}}) { | |
314 | # No version was earlier | |
315 | warning(g_("no such entry found, ignoring '%s' parameter"), 'to'); | |
316 | delete $r->{to}; | |
317 | } | |
318 | } | |
319 | ||
320 | if (defined($r->{since}) and $data->[0]->get_version() eq $r->{since}) { | |
321 | warning(g_("'since' option specifies most recent version, ignoring")); | |
322 | delete $r->{since}; | |
323 | } | |
324 | if (defined($r->{until}) and $data->[-1]->get_version() eq $r->{until}) { | |
325 | warning(g_("'until' option specifies oldest version, ignoring")); | |
326 | delete $r->{until}; | |
327 | } | |
328 | ## use critic | |
329 | } | |
330 | ||
331 | sub get_range { | |
332 | my ($self, $range) = @_; | |
333 | $range //= {}; | |
334 | my $res = $self->_data_range($range); | |
335 | if (defined $res) { | |
336 | return @$res if wantarray; | |
337 | return $res; | |
338 | } else { | |
339 | return; | |
340 | } | |
341 | } | |
342 | ||
343 | sub _is_full_range { | |
344 | my ($self, $range) = @_; | |
345 | ||
346 | return 1 if $range->{all}; | |
347 | ||
348 | # If no range delimiter is specified, we want everything. | |
349 | foreach my $delim (qw(since until from to count offset)) { | |
350 | return 0 if exists $range->{$delim}; | |
351 | } | |
352 | ||
353 | return 1; | |
354 | } | |
355 | ||
356 | sub _data_range { | |
357 | my ($self, $range) = @_; | |
358 | ||
359 | my $data = $self->{data} or return; | |
360 | ||
361 | return [ @$data ] if $self->_is_full_range($range); | |
362 | ||
363 | $self->__sanity_check_range($range); | |
364 | ||
365 | my ($start, $end); | |
366 | if (defined($range->{count})) { | |
367 | my $offset = $range->{offset} // 0; | |
368 | my $count = $range->{count}; | |
369 | # Convert count/offset in start/end | |
370 | if ($offset > 0) { | |
371 | $offset -= ($count < 0); | |
372 | } elsif ($offset < 0) { | |
373 | $offset = $#$data + ($count > 0) + $offset; | |
374 | } else { | |
375 | $offset = $#$data if $count < 0; | |
376 | } | |
377 | $start = $end = $offset; | |
378 | $start += $count+1 if $count < 0; | |
379 | $end += $count-1 if $count > 0; | |
380 | # Check limits | |
381 | $start = 0 if $start < 0; | |
382 | return if $start > $#$data; | |
383 | $end = $#$data if $end > $#$data; | |
384 | return if $end < 0; | |
385 | $end = $start if $end < $start; | |
386 | return [ @{$data}[$start .. $end] ]; | |
387 | } | |
388 | ||
389 | ## no critic (ControlStructures::ProhibitUntilBlocks) | |
390 | my @result; | |
391 | my $include = 1; | |
392 | $include = 0 if defined($range->{to}) or defined($range->{until}); | |
393 | foreach my $entry (@{$data}) { | |
394 | my $v = $entry->get_version(); | |
395 | $include = 1 if defined($range->{to}) and $v eq $range->{to}; | |
396 | last if defined($range->{since}) and $v eq $range->{since}; | |
397 | ||
398 | push @result, $entry if $include; | |
399 | ||
400 | $include = 1 if defined($range->{until}) and $v eq $range->{until}; | |
401 | last if defined($range->{from}) and $v eq $range->{from}; | |
402 | } | |
403 | ## use critic | |
404 | ||
405 | return \@result if scalar(@result); | |
406 | return; | |
407 | } | |
408 | ||
409 | =item $c->abort_early() | |
410 | ||
411 | Returns true if enough data have been parsed to be able to return all | |
412 | entries selected by the range set at creation (or with set_options). | |
413 | ||
414 | =cut | |
415 | ||
416 | sub abort_early { | |
417 | my $self = shift; | |
418 | ||
419 | my $data = $self->{data} or return; | |
420 | my $r = $self->{range} or return; | |
421 | my $count = $r->{count} // 0; | |
422 | my $offset = $r->{offset} // 0; | |
423 | ||
424 | return if $self->_is_full_range($r); | |
425 | return if $offset < 0 or $count < 0; | |
426 | if (defined($r->{count})) { | |
427 | if ($offset > 0) { | |
428 | $offset -= ($count < 0); | |
429 | } | |
430 | my $start = my $end = $offset; | |
431 | $end += $count-1 if $count > 0; | |
432 | return ($start < @$data and $end < @$data); | |
433 | } | |
434 | ||
435 | return unless defined($r->{since}) or defined($r->{from}); | |
436 | foreach my $entry (@{$data}) { | |
437 | my $v = $entry->get_version(); | |
438 | return 1 if defined($r->{since}) and $v eq $r->{since}; | |
439 | return 1 if defined($r->{from}) and $v eq $r->{from}; | |
440 | } | |
441 | ||
442 | return; | |
443 | } | |
444 | ||
445 | =item $c->save($filename) | |
446 | ||
447 | Save the changelog in the given file. | |
448 | ||
449 | =item $c->output() | |
450 | ||
451 | =item "$c" | |
452 | ||
453 | Returns a string representation of the changelog (it's a concatenation of | |
454 | the string representation of the individual changelog entries). | |
455 | ||
456 | =item $c->output($fh) | |
457 | ||
458 | Output the changelog to the given filehandle. | |
459 | ||
460 | =cut | |
461 | ||
462 | sub output { | |
463 | my ($self, $fh) = @_; | |
464 | my $str = ''; | |
465 | foreach my $entry (@{$self}) { | |
466 | my $text = $entry->output(); | |
467 | print { $fh } $text if defined $fh; | |
468 | $str .= $text if defined wantarray; | |
469 | } | |
470 | my $text = $self->get_unparsed_tail(); | |
471 | if (defined $text) { | |
472 | print { $fh } $text if defined $fh; | |
473 | $str .= $text if defined wantarray; | |
474 | } | |
475 | return $str; | |
476 | } | |
477 | ||
478 | our ( @URGENCIES, %URGENCIES ); | |
479 | BEGIN { | |
480 | @URGENCIES = qw(low medium high critical emergency); | |
481 | my $i = 1; | |
482 | %URGENCIES = map { $_ => $i++ } @URGENCIES; | |
483 | } | |
484 | ||
485 | sub _format_dpkg { | |
486 | my ($self, $range) = @_; | |
487 | ||
488 | my @data = $self->get_range($range) or return; | |
489 | my $src = shift @data; | |
490 | ||
491 | my $f = Dpkg::Control::Changelog->new(); | |
492 | $f->{Urgency} = $src->get_urgency() || 'unknown'; | |
493 | $f->{Source} = $src->get_source() || 'unknown'; | |
494 | $f->{Version} = $src->get_version() // 'unknown'; | |
495 | $f->{Distribution} = join(' ', $src->get_distributions()); | |
496 | $f->{Maintainer} = $src->get_maintainer() // ''; | |
497 | $f->{Date} = $src->get_timestamp() // ''; | |
498 | $f->{Timestamp} = $src->get_timepiece && $src->get_timepiece->epoch // ''; | |
499 | $f->{Changes} = $src->get_dpkg_changes(); | |
500 | ||
501 | # handle optional fields | |
502 | my $opts = $src->get_optional_fields(); | |
503 | my %closes; | |
504 | foreach (keys %$opts) { | |
505 | if (/^Urgency$/i) { # Already dealt | |
506 | } elsif (/^Closes$/i) { | |
507 | $closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes})); | |
508 | } else { | |
509 | field_transfer_single($opts, $f); | |
510 | } | |
511 | } | |
512 | ||
513 | foreach my $bin (@data) { | |
514 | my $oldurg = $f->{Urgency} // ''; | |
515 | my $oldurgn = $URGENCIES{$f->{Urgency}} // -1; | |
516 | my $newurg = $bin->get_urgency() // ''; | |
517 | my $newurgn = $URGENCIES{$newurg} // -1; | |
518 | $f->{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg; | |
519 | $f->{Changes} .= "\n" . $bin->get_dpkg_changes(); | |
520 | ||
521 | # handle optional fields | |
522 | $opts = $bin->get_optional_fields(); | |
523 | foreach (keys %$opts) { | |
524 | if (/^Closes$/i) { | |
525 | $closes{$_} = 1 foreach (split(/\s+/, $opts->{Closes})); | |
526 | } elsif (not exists $f->{$_}) { # Don't overwrite an existing field | |
527 | field_transfer_single($opts, $f); | |
528 | } | |
529 | } | |
530 | } | |
531 | ||
532 | if (scalar keys %closes) { | |
533 | $f->{Closes} = join ' ', sort { $a <=> $b } keys %closes; | |
534 | } | |
535 | run_vendor_hook('post-process-changelog-entry', $f); | |
536 | ||
537 | return $f; | |
538 | } | |
539 | ||
540 | sub _format_rfc822 { | |
541 | my ($self, $range) = @_; | |
542 | ||
543 | my @data = $self->get_range($range) or return; | |
544 | my @ctrl; | |
545 | ||
546 | foreach my $entry (@data) { | |
547 | my $f = Dpkg::Control::Changelog->new(); | |
548 | $f->{Urgency} = $entry->get_urgency() || 'unknown'; | |
549 | $f->{Source} = $entry->get_source() || 'unknown'; | |
550 | $f->{Version} = $entry->get_version() // 'unknown'; | |
551 | $f->{Distribution} = join(' ', $entry->get_distributions()); | |
552 | $f->{Maintainer} = $entry->get_maintainer() // ''; | |
553 | $f->{Date} = $entry->get_timestamp() // ''; | |
554 | $f->{Timestamp} = $entry->get_timepiece && $entry->get_timepiece->epoch // ''; | |
555 | $f->{Changes} = $entry->get_dpkg_changes(); | |
556 | ||
557 | # handle optional fields | |
558 | my $opts = $entry->get_optional_fields(); | |
559 | foreach (keys %$opts) { | |
560 | field_transfer_single($opts, $f) unless exists $f->{$_}; | |
561 | } | |
562 | ||
563 | run_vendor_hook('post-process-changelog-entry', $f); | |
564 | ||
565 | push @ctrl, $f; | |
566 | } | |
567 | ||
568 | return @ctrl; | |
569 | } | |
570 | ||
571 | =item $control = $c->format_range($format, $range) | |
572 | ||
573 | Formats the changelog into Dpkg::Control::Changelog objects representing the | |
574 | entries selected by the optional range specifier (see L<"RANGE SELECTION"> | |
575 | for details). In scalar context returns a Dpkg::Index object containing the | |
576 | selected entries, in list context returns an array of Dpkg::Control::Changelog | |
577 | objects. | |
578 | ||
579 | With format B<dpkg> the returned Dpkg::Control::Changelog object is coalesced | |
580 | from the entries in the changelog that are part of the range requested, | |
581 | with the fields described below, but considering that "selected entry" | |
582 | means the first entry of the selected range. | |
583 | ||
584 | With format B<rfc822> each returned Dpkg::Control::Changelog objects | |
585 | represents one entry in the changelog that is part of the range requested, | |
586 | with the fields described below, but considering that "selected entry" | |
587 | means for each entry. | |
588 | ||
589 | The different formats return undef if no entries are matched. The following | |
590 | fields are contained in the object(s) returned: | |
591 | ||
592 | =over 4 | |
593 | ||
594 | =item Source | |
595 | ||
596 | package name (selected entry) | |
597 | ||
598 | =item Version | |
599 | ||
600 | packages' version (selected entry) | |
601 | ||
602 | =item Distribution | |
603 | ||
604 | target distribution (selected entry) | |
605 | ||
606 | =item Urgency | |
607 | ||
608 | urgency (highest of all entries in range) | |
609 | ||
610 | =item Maintainer | |
611 | ||
612 | person that created the (selected) entry | |
613 | ||
614 | =item Date | |
615 | ||
616 | date of the (selected) entry | |
617 | ||
618 | =item Timestamp | |
619 | ||
620 | date of the (selected) entry as a timestamp in seconds since the epoch | |
621 | ||
622 | =item Closes | |
623 | ||
624 | bugs closed by the (selected) entry/entries, sorted by bug number | |
625 | ||
626 | =item Changes | |
627 | ||
628 | content of the (selected) entry/entries | |
629 | ||
630 | =back | |
631 | ||
632 | =cut | |
633 | ||
634 | sub format_range { | |
635 | my ($self, $format, $range) = @_; | |
636 | ||
637 | my @ctrl; | |
638 | ||
639 | if ($format eq 'dpkg') { | |
640 | @ctrl = $self->_format_dpkg($range); | |
641 | } elsif ($format eq 'rfc822') { | |
642 | @ctrl = $self->_format_rfc822($range); | |
643 | } else { | |
644 | croak "unknown changelog output format $format"; | |
645 | } | |
646 | ||
647 | if (wantarray) { | |
648 | return @ctrl; | |
649 | } else { | |
650 | my $index = Dpkg::Index->new(type => CTRL_CHANGELOG); | |
651 | ||
652 | foreach my $f (@ctrl) { | |
653 | $index->add($f); | |
654 | } | |
655 | ||
656 | return $index; | |
657 | } | |
658 | } | |
659 | ||
660 | =item $control = $c->dpkg($range) | |
661 | ||
662 | This is a deprecated alias for $c->format_range('dpkg', $range). | |
663 | ||
664 | =cut | |
665 | ||
666 | sub dpkg { | |
667 | my ($self, $range) = @_; | |
668 | ||
669 | warnings::warnif('deprecated', | |
670 | 'deprecated method, please use format_range("dpkg", $range) instead'); | |
671 | ||
672 | return $self->format_range('dpkg', $range); | |
673 | } | |
674 | ||
675 | =item @controls = $c->rfc822($range) | |
676 | ||
677 | This is a deprecated alias for C<scalar c->format_range('rfc822', $range)>. | |
678 | ||
679 | =cut | |
680 | ||
681 | sub rfc822 { | |
682 | my ($self, $range) = @_; | |
683 | ||
684 | warnings::warnif('deprecated', | |
685 | 'deprecated method, please use format_range("rfc822", $range) instead'); | |
686 | ||
687 | return scalar $self->format_range('rfc822', $range); | |
688 | } | |
689 | ||
690 | =back | |
691 | ||
692 | =head1 RANGE SELECTION | |
693 | ||
694 | A range selection is described by a hash reference where | |
695 | the allowed keys and values are described below. | |
696 | ||
697 | The following options take a version number as value. | |
698 | ||
699 | =over 4 | |
700 | ||
701 | =item since | |
702 | ||
703 | Causes changelog information from all versions strictly | |
704 | later than B<version> to be used. | |
705 | ||
706 | =item until | |
707 | ||
708 | Causes changelog information from all versions strictly | |
709 | earlier than B<version> to be used. | |
710 | ||
711 | =item from | |
712 | ||
713 | Similar to C<since> but also includes the information for the | |
714 | specified B<version> itself. | |
715 | ||
716 | =item to | |
717 | ||
718 | Similar to C<until> but also includes the information for the | |
719 | specified B<version> itself. | |
720 | ||
721 | =back | |
722 | ||
723 | The following options don't take version numbers as values: | |
724 | ||
725 | =over 4 | |
726 | ||
727 | =item all | |
728 | ||
729 | If set to a true value, all entries of the changelog are returned, | |
730 | this overrides all other options. | |
731 | ||
732 | =item count | |
733 | ||
734 | Expects a signed integer as value. Returns C<value> entries from the | |
735 | top of the changelog if set to a positive integer, and C<abs(value)> | |
736 | entries from the tail if set to a negative integer. | |
737 | ||
738 | =item offset | |
739 | ||
740 | Expects a signed integer as value. Changes the starting point for | |
741 | C<count>, either counted from the top (positive integer) or from | |
742 | the tail (negative integer). C<offset> has no effect if C<count> | |
743 | wasn't given as well. | |
744 | ||
745 | =back | |
746 | ||
747 | Some examples for the above options. Imagine an example changelog with | |
748 | entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1. | |
749 | ||
750 | Range Included entries | |
751 | ----- ---------------- | |
752 | since => '2.0' 3.1, 3.0, 2.2 | |
753 | until => '2.0' 1.3, 1.2 | |
754 | from => '2.0' 3.1, 3.0, 2.2, 2.1, 2.0 | |
755 | to => '2.0' 2.0, 1.3, 1.2 | |
756 | count => 2 3.1, 3.0 | |
757 | count => -2 1.3, 1.2 | |
758 | count => 3, offset => 2 2.2, 2.1, 2.0 | |
759 | count => 2, offset => -3 2.0, 1.3 | |
760 | count => -2, offset => 3 3.0, 2.2 | |
761 | count => -2, offset => -3 2.2, 2.1 | |
762 | ||
763 | Any combination of one option of C<since> and C<from> and one of | |
764 | C<until> and C<to> returns the intersection of the two results | |
765 | with only one of the options specified. | |
766 | ||
767 | =head1 CHANGES | |
768 | ||
769 | =head2 Version 1.01 (dpkg 1.18.8) | |
770 | ||
771 | New method: $c->format_range(). | |
772 | ||
773 | Deprecated methods: $c->dpkg(), $c->rfc822(). | |
774 | ||
775 | New field Timestamp in output formats. | |
776 | ||
777 | =head2 Version 1.00 (dpkg 1.15.6) | |
778 | ||
779 | Mark the module as public. | |
780 | ||
781 | =cut | |
782 | 1; |