2 # Parse::DebianChangelog
4 # Copyright 1996 Ian Jackson
5 # Copyright 2005 Frank Lichtenheld <frank@lichtenheld.de>
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 2 of the License, or
10 # (at your option) any later version.
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
24 Parse::DebianChangelog - parse Debian changelogs and output them in other formats
28 use Parse::DebianChangelog;
30 my $chglog = Parse::DebianChangelog->init( { infile => 'debian/changelog',
31 HTML => { outfile => 'changelog.html' } );
34 # the following is semantically equivalent
35 my $chglog = Parse::DebianChangelog->init();
36 $chglog->parse( { infile => 'debian/changelog' } );
37 $chglog->html( { outfile => 'changelog.html' } );
39 my $changes = $chglog->dpkg_str( { since => '1.0-1' } );
44 Parse::DebianChangelog parses Debian changelogs as described in the Debian
45 policy (version 3.6.2.1 at the time of this writing). See section
46 L<"SEE ALSO"> for locations where to find this definition.
48 The parser tries to ignore most cruft like # or /* */ style comments,
49 CVS comments, vim variables, emacs local variables and stuff from
50 older changelogs with other formats at the end of the file.
51 NOTE: most of these are ignored silently currently, there is no
52 parser error issued for them. This should become configurable in the
55 Beside giving access to the details of the parsed file via the
56 L<"data"> method, Parse::DebianChangelog also supports converting these
57 changelogs to various other formats. These are currently:
63 Format as known from L<dpkg-parsechangelog(1)>. All requested entries
64 (see L<"METHODS"> for an explanation what this means) are returned in
65 the usual Debian control format, merged in one stanza, ready to be used
66 in a F<.changes> file.
70 Similar to the C<dpkg> format, but the requested entries are returned
71 as one stanza each, i.e. they are not merged. This is probably the format
72 to use if you want a machine-usable representation of the changelog.
76 Just a simple XML dump of the changelog data. Without any schema or
77 DTD currently, just some made up XML. The actual format might still
78 change. Comments and Improvements welcome.
82 The changelog is converted to a somewhat nice looking HTML file with
83 some nice features as a quick-link bar with direct links to every entry.
84 NOTE: This is not very configurable yet and was specifically designed
85 to be used on L<http://packages.debian.org/>. This is planned to be
86 changed until version 1.0.
94 package Parse::DebianChangelog;
99 use Fcntl qw( :flock );
103 use Parse::DebianChangelog::Util qw( :all );
104 use Parse::DebianChangelog::Entry;
106 our $VERSION = '1.1.1';
112 Creates a new object instance. Takes a reference to a hash as
113 optional argument, which is interpreted as configuration options.
114 There are currently no supported general configuration options, but
115 see the other methods for more specific configuration options which
116 can also specified to C<init>.
118 If C<infile> or C<instring> are specified (see L<parse>), C<parse()>
119 is called from C<init>. If a fatal error is encountered during parsing
120 (e.g. the file can't be opened), C<init> will not return a
121 valid object but C<undef>!
126 my $classname = shift;
127 my $config = shift || {};
129 bless( $self, $classname );
131 $config->{verbose} = 1 if $config->{debug};
132 $self->{config} = $config;
135 $self->reset_parse_errors;
137 if ($self->{config}{infile} || $self->{config}{instring}) {
138 defined($self->parse) or return undef;
146 =head3 reset_parse_errors
148 Can be used to delete all information about errors ocurred during
149 previous L<parse> runs. Note that C<parse()> also calls this method.
153 sub reset_parse_errors {
156 $self->{errors}{parser} = [];
159 sub _do_parse_error {
160 my ($self, $file, $line_nr, $error, $line) = @_;
163 push @{$self->{errors}{parser}}, [ @_ ];
165 $file = substr $file, 0, 20;
166 unless ($self->{config}{quiet}) {
168 warn "WARN: $file(l$NR): $error\nLINE: $line\n";
170 warn "WARN: $file(l$NR): $error\n";
177 =head3 get_parse_errors
179 Returns all error messages from the last L<parse> run.
180 If called in scalar context returns a human readable
181 string representation. If called in list context returns
182 an array of arrays. Each of these arrays contains
188 the filename of the parsed file or C<String> if a string was
193 the line number where the error occurred
205 NOTE: This format isn't stable yet and may change in later versions
210 sub get_parse_errors {
214 return @{$self->{errors}{parser}};
217 foreach my $e (@{$self->{errors}{parser}}) {
219 $res .= __g( "WARN: %s(l%s): %s\nLINE: %s\n", @$e );
221 $res .= __g( "WARN: %s(l%s): %s\n", @$e );
228 sub _do_fatal_error {
229 my ($self, @msg) = @_;
231 $self->{errors}{fatal} = "@msg";
232 warn __g( "FATAL: %s", "@msg")."\n" unless $self->{config}{quiet};
239 Get the last non-parser error (e.g. the file to parse couldn't be opened).
246 return $self->{errors}{fatal};
253 Parses either the file named in configuration item C<infile> or the string
254 saved in configuration item C<instring>.
255 Accepts a hash ref as optional argument which can contain configuration
258 Returns C<undef> in case of error (e.g. "file not found", B<not> parse
259 errors) and the object if successful. If C<undef> was returned, you
260 can get the reason for the failure by calling the L<get_error> method.
266 return sprintf( dgettext( 'Parse-DebianChangelog', $string ), @_ );
270 my ($self, $config) = @_;
272 foreach my $c (keys %$config) {
273 $self->{config}{$c} = $config->{$c};
277 if ($file = $self->{config}{infile}) {
278 open $fh, '<', $file or do {
279 $self->_do_fatal_error( __g( "can't open file %s: %s",
283 flock $fh, LOCK_SH or do {
284 $self->_do_fatal_error( __g( "can't lock file %s: %s",
288 } elsif (my $string = $self->{config}{instring}) {
289 eval { require IO::String };
291 $self->_do_fatal_error( __g( "can't load IO::String: %s",
295 $fh = IO::String->new( $string );
298 $self->_do_fatal_error( __g( 'no changelog file specified' ));
302 $self->reset_parse_errors;
306 # based on /usr/lib/dpkg/parsechangelog/debian
307 my $expect='first heading';
308 my $entry = Parse::DebianChangelog::Entry->init();
310 my $unknowncounter = 1; # to make version unique, e.g. for using as id
314 # printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
315 if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
316 unless ($expect eq 'first heading'
317 || $expect eq 'next heading or eof') {
318 $entry->{ERROR} = [ $file, $NR,
319 __g( "found start of entry where expected %s",
321 $self->_do_parse_error(@{$entry->{ERROR}});
323 unless ($entry->is_empty) {
324 $entry->{'Closes'} = find_closes( $entry->{Changes} );
325 # print STDERR, Dumper($entry);
326 push @{$self->{data}}, $entry;
327 $entry = Parse::DebianChangelog::Entry->init();
330 $entry->{'Source'} = "$1";
331 $entry->{'Version'} = "$2";
332 $entry->{'Header'} = "$_";
333 ($entry->{'Distribution'} = "$3") =~ s/^\s+//;
334 $entry->{'Changes'} = $entry->{'Urgency_Comment'} = '';
335 $entry->{'Urgency'} = $entry->{'Urgency_LC'} = 'unknown';
337 (my $rhs = $POSTMATCH) =~ s/^\s+//;
339 # print STDERR "RHS: $rhs\n";
340 for my $kv (split(/\s*,\s*/,$rhs)) {
341 $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
342 $self->_do_parse_error($file, $NR,
343 __g( "bad key-value after \`;': \`%s'", $kv ));
346 $kvdone{$k}++ && $self->_do_parse_error($file, $NR,
347 __g( "repeated key-value %s", $k ));
348 if ($k eq 'Urgency') {
349 $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
350 $self->_do_parse_error($file, $NR,
351 __g( "badly formatted urgency value" ),
353 $entry->{'Urgency'} = "$1";
354 $entry->{'Urgency_LC'} = lc("$1");
355 $entry->{'Urgency_Comment'} = "$2";
356 } elsif ($k =~ m/^X[BCS]+-/i) {
357 # Extensions - XB for putting in Binary,
358 # XC for putting in Control, XS for putting in Source
361 $self->_do_parse_error($file, $NR,
362 __g( "unknown key-value key %s - copying to XS-%s", $k, $k ));
363 $entry->{ExtraFields}{"XS-$k"} = $v;
366 $expect= 'start of change data';
368 } elsif (m/^(;;\s*)?Local variables:/io) {
369 last; # skip Emacs variables at end of file
370 } elsif (m/^vim:/io) {
371 last; # skip vim variables at end of file
372 } elsif (m/^\$\w+:.*\$/o) {
373 next; # skip stuff that look like a CVS keyword
375 next; # skip comments, even that's not supported
376 } elsif (m,^/\*.*\*/,o) {
377 next; # more comments
378 } elsif (m/^(\w+\s+\w+\s+\d{1,2} \d{1,2}:\d{1,2}:\d{1,2}\s+[\w\s]*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
379 || m/^(\w+\s+\w+\s+\d{1,2},?\s*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
380 || m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)\;?/io
381 || m/^([\w.+-]+)(-| )(\S+) Debian (\S+)/io
382 || m/^Changes from version (.*) to (.*):/io
383 || m/^Changes for [\w.+-]+-[\w.+-]+:?$/io
384 || m/^Old Changelog:$/io
385 || m/^(?:\d+:)?\w[\w.+~-]*:?$/o) {
386 # save entries on old changelog format verbatim
387 # we assume the rest of the file will be in old format once we
388 # hit it for the first time
389 $self->{oldformat} = "$_\n";
390 $self->{oldformat} .= join "", <$fh>;
392 $self->_do_parse_error($file, $NR,
393 __g( "badly formatted heading line" ), "$_");
394 } elsif (m/^ \-\- (.*) <(.*)>( ?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/o) {
395 $expect eq 'more change data or trailer' ||
396 $self->_do_parse_error($file, $NR,
397 __g( "found trailer where expected %s",
400 $self->_do_parse_error($file, $NR,
401 __g( "badly formatted trailer line" ),
404 $entry->{'Trailer'} = $_;
405 $entry->{'Maintainer'} = "$1 <$2>" unless $entry->{'Maintainer'};
406 unless($entry->{'Date'} && defined $entry->{'Timestamp'}) {
407 $entry->{'Date'} = "$4";
408 $entry->{'Timestamp'} = str2time($4);
409 unless (defined $entry->{'Timestamp'}) {
410 $self->_do_parse_error( $file, $NR,
411 __g( "couldn't parse date %s",
415 $expect = 'next heading or eof';
416 } elsif (m/^ \-\-/) {
417 $entry->{ERROR} = [ $file, $NR,
418 __g( "badly formatted trailer line" ), "$_" ];
419 $self->_do_parse_error(@{$entry->{ERROR}});
420 # $expect = 'next heading or eof'
421 # if $expect eq 'more change data or trailer';
422 } elsif (m/^\s{2,}(\S)/) {
423 $expect eq 'start of change data'
424 || $expect eq 'more change data or trailer'
426 $self->_do_parse_error($file, $NR,
427 __g( "found change data where expected %s",
429 if (($expect eq 'next heading or eof')
430 && !$entry->is_empty) {
431 # lets assume we have missed the actual header line
432 $entry->{'Closes'} = find_closes( $entry->{Changes} );
433 # print STDERR, Dumper($entry);
434 push @{$self->{data}}, $entry;
435 $entry = Parse::DebianChangelog::Entry->init();
437 $entry->{Distribution} = $entry->{Urgency} =
438 $entry->{Urgency_LC} = 'unknown';
439 $entry->{Version} = 'unknown'.($unknowncounter++);
440 $entry->{Urgency_Comment} = '';
441 $entry->{ERROR} = [ $file, $NR,
442 __g( "found change data where expected %s",
446 $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
447 if (!$entry->{'Items'} || ($1 eq '*')) {
448 $entry->{'Items'} ||= [];
449 push @{$entry->{'Items'}}, "$_\n";
451 $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
454 $expect = 'more change data or trailer';
456 next if $expect eq 'start of change data'
457 || $expect eq 'next heading or eof';
458 $expect eq 'more change data or trailer'
459 || $self->_do_parse_error($file, $NR,
460 __g( "found blank line where expected %s",
464 $self->_do_parse_error($file, $NR, __g( "unrecognised line" ),
466 ($expect eq 'start of change data'
467 || $expect eq 'more change data or trailer')
469 # lets assume change data if we expected it
470 $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
471 if (!$entry->{'Items'}) {
472 $entry->{'Items'} ||= [];
473 push @{$entry->{'Items'}}, "$_\n";
475 $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
478 $expect = 'more change data or trailer';
479 $entry->{ERROR} = [ $file, $NR, __g( "unrecognised line" ),
485 $expect eq 'next heading or eof'
487 $entry->{ERROR} = [ $file, $NR,
488 __g( "found eof where expected %s",
490 $self->_do_parse_error( @{$entry->{ERROR}} );
492 unless ($entry->is_empty) {
493 $entry->{'Closes'} = find_closes( $entry->{Changes} );
494 push @{$self->{data}}, $entry;
497 if ($self->{config}{infile}) {
499 $self->_do_fatal_error( __g( "can't close file %s: %s",
506 # print Dumper( $self );
515 C<data> returns an array (if called in list context) or a reference
516 to an array of Parse::DebianChangelog::Entry objects which each
517 represent one entry of the changelog.
519 This is currently merely a placeholder to enable users to get to the
520 raw data, expect changes to this API in the near future.
522 This method supports the common output options described in
523 section L<"COMMON OUTPUT OPTIONS">.
528 my ($self, $config) = @_;
530 my $data = $self->{data};
532 $self->{config}{DATA} = $config if $config;
533 $data = $self->_data_range( $config ) or return undef;
535 return @$data if wantarray;
539 sub __sanity_check_range {
540 my ( $data, $from, $to, $since, $until, $start, $end ) = @_;
542 if (($$start || $$end) && ($$from || $$since || $$to || $$until)) {
543 warn( __g( "you can't combine 'count' or 'offset' with any other range option" ) ."\n");
544 $$from = $$since = $$to = $$until = '';
546 if ($$from && $$since) {
547 warn( __g( "you can only specify one of 'from' and 'since'" ) ."\n");
550 if ($$to && $$until) {
551 warn( __g( "you can only specify one of 'to' and 'until'" ) ."\n");
554 if ($$since && ($data->[0]{Version} eq $$since)) {
555 warn( __g( "'since' option specifies most recent version" ) ."\n");
558 if ($$until && ($data->[$#{$data}]{Version} eq $$until)) {
559 warn( __g( "'until' option specifies oldest version" ) ."\n");
562 $$start = 0 if $$start < 0;
563 return if $$start > $#$data;
564 $$end = $#$data if $$end > $#$data;
566 $$end = $$start if $$end < $$start;
567 #TODO: compare versions
572 my ($self, $config) = @_;
574 my $data = $self->data or return undef;
576 return [ @$data ] if $config->{all};
578 my $since = $config->{since} || '';
579 my $until = $config->{until} || '';
580 my $from = $config->{from} || '';
581 my $to = $config->{to} || '';
582 my $count = $config->{count} || 0;
583 my $offset = $config->{offset} || 0;
585 return if $offset and not $count;
587 $offset -= ($count < 0);
588 } elsif ($offset < 0) {
589 $offset = $#$data + ($count > 0) + $offset;
591 $offset = $#$data if $count < 0;
593 my $start = my $end = $offset;
594 $start += $count+1 if $count < 0;
595 $end += $count-1 if $count > 0;
597 return unless __sanity_check_range( $data, \$from, \$to,
602 unless ($from or $to or $since or $until or $start or $end) {
603 return [ @$data ] if $config->{default_all} and not $count;
604 return [ $data->[0] ];
607 return [ @{$data}[$start .. $end] ] if $start or $end;
612 $include = 0 if $to or $until;
614 my $v = $_->{Version};
615 $include = 1 if $v eq $to;
616 last if $v eq $since;
618 push @result, $_ if $include;
620 $include = 1 if $v eq $until;
633 C<dpkg> returns a hash (in list context) or a hash reference
634 (in scalar context) where the keys are field names and the values are
635 field values. The following fields are given:
641 package name (in the first entry)
645 packages' version (from first entry)
649 target distribution (from first entry)
653 urgency (highest of all printed entries)
657 person that created the (first) entry
661 date of the (first) entry
665 bugs closed by the entry/entries, sorted by bug number
669 content of the the entry/entries
673 C<dpkg_str> returns a stringified version of this hash which should look
674 exactly like the output of L<dpkg-parsechangelog(1)>. The fields are
675 ordered like in the list above.
677 Both methods only support the common output options described in
678 section L<"COMMON OUTPUT OPTIONS">.
686 our ( %FIELDIMPS, %URGENCIES );
689 grep($FIELDIMPS{$_}=$i--,
690 qw(Source Version Distribution Urgency Maintainer Date Closes
693 grep($URGENCIES{$_}=$i++,
694 qw(low medium high critical emergency));
698 my ($self, $config) = @_;
700 $self->{config}{DPKG} = $config if $config;
702 $config = $self->{config}{DPKG} || {};
703 my $data = $self->_data_range( $config ) or return undef;
706 foreach my $field (qw( Urgency Source Version
707 Distribution Maintainer Date )) {
708 $f{$field} = $data->[0]{$field};
711 $f{Changes} = get_dpkg_changes( $data->[0] );
712 $f{Closes} = [ @{$data->[0]{Closes}} ];
714 my $first = 1; my $urg_comment = '';
715 foreach my $entry (@$data) {
716 $first = 0, next if $first;
718 my $oldurg = $f{Urgency} || '';
719 my $oldurgn = $URGENCIES{$f{Urgency}} || -1;
720 my $newurg = $entry->{Urgency_LC} || '';
721 my $newurgn = $URGENCIES{$entry->{Urgency_LC}} || -1;
722 $f{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
723 $urg_comment .= $entry->{Urgency_Comment};
725 $f{Changes} .= "\n .".get_dpkg_changes( $entry );
726 push @{$f{Closes}}, @{$entry->{Closes}};
729 $f{Closes} = join " ", sort { $a <=> $b } @{$f{Closes}};
730 $f{Urgency} .= $urg_comment;
732 return %f if wantarray;
737 return data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
746 C<rfc822> returns an array of hashes (in list context) or a reference
747 to this array (in scalar context) where each hash represents one entry
748 in the changelog. For the format of such a hash see the description
749 of the L<"dpkg"> method (while ignoring the remarks about which
750 values are taken from the first entry).
752 C<rfc822_str> returns a stringified version of this hash which looks
753 similar to the output of dpkg-parsechangelog but instead of one
754 stanza the output contains one stanza for each entry.
756 Both methods only support the common output options described in
757 section L<"COMMON OUTPUT OPTIONS">.
766 my ($self, $config) = @_;
768 $self->{config}{RFC822} = $config if $config;
770 $config = $self->{config}{RFC822} || {};
771 my $data = $self->_data_range( $config ) or return undef;
774 foreach my $entry (@$data) {
776 foreach my $field (qw( Urgency Source Version
777 Distribution Maintainer Date )) {
778 $f{$field} = $entry->{$field};
781 $f{Urgency} .= $entry->{Urgency_Comment};
782 $f{Changes} = get_dpkg_changes( $entry );
783 $f{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
787 return @out_data if wantarray;
792 return data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
797 $version =~ s/[^\w.:-]/_/go;
798 return "version$version";
807 C<xml> converts the changelog to some free-form (i.e. there is neither
808 a DTD or a schema for it) XML.
810 The method C<xml_str> is an alias for C<xml>.
812 Both methods support the common output options described in
813 section L<"COMMON OUTPUT OPTIONS"> and additionally the following
814 configuration options (as usual to give
815 in a hash reference as parameter to the method call):
821 directly write the output to the file specified
832 my ($self, $config) = @_;
834 $self->{config}{XML} = $config if $config;
835 $config = $self->{config}{XML} || {};
836 $config->{default_all} = 1 unless exists $config->{all};
837 my $data = $self->_data_range( $config ) or return undef;
839 $out_data{Entry} = [];
842 import XML::Simple qw( :strict );
844 foreach my $entry (@$data) {
846 foreach my $field (qw( Urgency Source Version
847 Distribution Closes )) {
848 $f{$field} = $entry->{$field};
850 foreach my $field (qw( Maintainer Changes )) {
851 $f{$field} = [ $entry->{$field} ];
854 $f{Urgency} .= $entry->{Urgency_Comment};
855 $f{Date} = { timestamp => $entry->{Timestamp},
856 content => $entry->{Date} };
857 push @{$out_data{Entry}}, \%f;
861 my %xml_opts = ( SuppressEmpty => 1, KeyAttr => {},
862 RootName => 'Changelog' );
863 $xml_str = XMLout( \%out_data, %xml_opts );
864 if ($config->{outfile}) {
865 open my $fh, '>', $config->{outfile} or return undef;
866 flock $fh, LOCK_EX or return undef;
870 close $fh or return undef;
886 C<html> converts the changelog to a HTML file with some nice features
887 such as a quick-link bar with direct links to every entry. The HTML
888 is generated with the help of HTML::Template. If you want to change
889 the output you should use the default template provided with this module
890 as a base and read the documentation of HTML::Template to understand
893 The method C<html_str> is an alias for C<html>.
895 Both methods support the common output options described in
896 section L<"COMMON OUTPUT OPTIONS"> and additionally the following
897 configuration options (as usual to give
898 in a hash reference as parameter to the method call):
904 directly write the output to the file specified
908 template file to use, defaults to tmpl/default.tmpl, so you
909 most likely want to override that.
910 NOTE: The plan is to provide a configuration file for the module
911 later to be able to use sane defaults here.
915 path to the CSS stylesheet to use (a default might be specified
916 in the template and will be honoured, see the default template
921 path to the CSS stylesheet to use for printing (see the notes for
922 C<style> about default values)
933 my ($self, $config) = @_;
935 $self->{config}{HTML} = $config if $config;
936 $config = $self->{config}{HTML} || {};
937 $config->{default_all} = 1 unless exists $config->{all};
938 my $data = $self->_data_range( $config ) or return undef;
941 import CGI qw( -no_xhtml -no_debug );
942 require HTML::Template;
944 my $template = HTML::Template->new(filename => $config->{template}
945 || 'tmpl/default.tmpl',
946 die_on_bad_params => 0);
947 $template->param( MODULE_NAME => ref($self),
948 MODULE_VERSION => $VERSION,
949 GENERATED_DATE => gmtime()." UTC",
950 SOURCE_NEWEST => $data->[0]{Source},
951 VERSION_NEWEST => $data->[0]{Version},
952 MAINTAINER_NEWEST => $data->[0]{Maintainer},
955 $template->param( CSS_FILE_SCREEN => $config->{style} )
957 $template->param( CSS_FILE_PRINT => $config->{print_style} )
958 if $config->{print_style};
965 foreach my $entry (@$data) {
966 my $year = $last_year; # try to deal gracefully with unparsable dates
967 if (defined $entry->{Timestamp}) {
968 $year = (gmtime($entry->{Timestamp}))[5] + 1900;
972 $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
974 $navigation{$year}{NAV_VERSIONS} ||= [];
975 $navigation{$year}{NAV_YEAR} ||= $year;
977 $entry->{Maintainer} ||= 'unknown';
978 $entry->{Date} ||= 'unknown';
979 push @{$navigation{$year}{NAV_VERSIONS}},
980 { NAV_VERSION_ID => __version2id($entry->{Version}),
981 NAV_VERSION => $entry->{Version},
982 NAV_MAINTAINER => $entry->{Maintainer},
983 NAV_DATE => $entry->{Date} };
986 foreach my $y (reverse sort keys %navigation) {
987 push @nav_years, $navigation{$y};
989 $template->param( OLDFORMAT => (($self->{oldformat}||'') ne ''),
990 NAV_YEARS => \@nav_years );
995 foreach my $entry (@$data) {
996 my $year = $last_year; # try to deal gracefully with unparsable dates
997 if (defined $entry->{Timestamp}) {
998 $year = (gmtime($entry->{Timestamp}))[5] + 1900;
1000 $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
1002 if (!$last_year || ($year < $last_year)) {
1006 $years{$last_year}{CONTENT_VERSIONS} ||= [];
1007 $years{$last_year}{CONTENT_YEAR} ||= $last_year;
1009 my $text = $self->apply_filters( 'html::changes',
1010 $entry->{Changes}, $cgi );
1012 (my $maint_name = $entry->{Maintainer} ) =~ s|<([a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,}))>||o;
1013 my $maint_mail = $1;
1016 $parse_error = $cgi->p( { -class=>'parse_error' },
1017 "(There has been a parse error in the entry above, if some values don't make sense please check the original changelog)" )
1020 push @{$years{$last_year}{CONTENT_VERSIONS}}, {
1021 CONTENT_VERSION => $entry->{Version},
1022 CONTENT_VERSION_ID => __version2id($entry->{Version}),
1023 CONTENT_URGENCY => $entry->{Urgency}.$entry->{Urgency_Comment},
1024 CONTENT_URGENCY_NORM => $entry->{Urgency_LC},
1025 CONTENT_DISTRIBUTION => $entry->{Distribution},
1026 CONTENT_DISTRIBUTION_NORM => lc($entry->{Distribution}),
1027 CONTENT_SOURCE => $entry->{Source},
1028 CONTENT_CHANGES => $text,
1029 CONTENT_CHANGES_UNFILTERED => $entry->{Changes},
1030 CONTENT_DATE => $entry->{Date},
1031 CONTENT_MAINTAINER_NAME => $maint_name,
1032 CONTENT_MAINTAINER_EMAIL => $maint_mail,
1033 CONTENT_PARSE_ERROR => $parse_error,
1037 foreach my $y (reverse sort keys %years) {
1038 push @content_years, $years{$y};
1040 $template->param( OLDFORMAT_CHANGES => $self->{oldformat},
1041 CONTENT_YEARS => \@content_years );
1043 my $html_str = $template->output;
1045 if ($config->{outfile}) {
1046 open my $fh, '>', $config->{outfile} or return undef;
1047 flock $fh, LOCK_EX or return undef;
1049 print $fh $html_str;
1051 close $fh or return undef;
1073 require Parse::DebianChangelog::ChangesFilters;
1075 $self->{filters} = {};
1077 $self->{filters}{'html::changes'} =
1078 [ @Parse::DebianChangelog::ChangesFilters::all_filters ];
1083 =head3 apply_filters
1090 my ($self, $filter_class, $text, $data) = @_;
1092 foreach my $f (@{$self->{filters}{$filter_class}}) {
1093 $text = &$f( $text, $data );
1100 =head3 add_filter, delete_filter, replace_filter
1107 my ($self, $filter_class, $filter, $pos) = @_;
1109 $self->{filters}{$filter_class} ||= [];
1111 push @{$self->{filters}{$filter_class}}, $filter;
1112 } elsif ($pos == 1) {
1113 unshift @{$self->{filters}{$filter_class}}, $filter;
1114 } elsif ($pos > 1) {
1115 my $length = @{$self->{filters}{$filter_class}};
1116 $self->{filters}{$filter_class} =
1117 [ @{$self->{filters}{$filter_class}[0 .. ($pos-2)]}, $filter,
1118 @{$self->{filters}{$filter_class}[($pos-1) .. ($length-1)]} ];
1125 my ($self, $filter_class, $filter) = @_;
1128 unless (ref $filter) {
1131 return delete $self->{filters}{$filter_class}[$pos];
1134 $self->{filters}{$filter_class} ||= [];
1136 for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
1137 push @deleted, delete $self->{filters}{$filter_class}[$i]
1138 if $self->{filters}{$filter_class}[$i] == $filter;
1144 sub replace_filter {
1145 my ($self, $filter_class, $filter, @new_filters) = @_;
1148 unless (ref $filter) {
1151 $self->{filters}{$filter_class} ||= [];
1152 for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
1154 if $self->{filters}{$filter_class}[$i] == $filter;
1158 foreach my $p (@pos) {
1159 $self->delete_filter( $filter_class, $p );
1161 foreach my $f (@new_filters) {
1162 $self->add_filter( $filter_class, $f, $p++);
1172 =head1 COMMON OUTPUT OPTIONS
1174 The following options are supported by all output methods,
1175 all take a version number as value:
1181 Causes changelog information from all versions strictly
1182 later than B<version> to be used.
1184 (works exactly like the C<-v> option of dpkg-parsechangelog).
1188 Causes changelog information from all versions strictly
1189 earlier than B<version> to be used.
1193 Similar to C<since> but also includes the information for the
1194 specified B<version> itself.
1198 Similar to C<until> but also includes the information for the
1199 specified B<version> itself.
1203 The following options also supported by all output methods but
1204 don't take version numbers as values:
1210 If set to a true value, all entries of the changelog are returned,
1211 this overrides all other options. While the XML and HTML formats
1212 default to all == true, this does of course not overwrite other
1213 options unless it is set explicitly with the call.
1217 Expects a signed integer as value. Returns C<value> entries from the
1218 top of the changelog if set to a positive integer, and C<abs(value)>
1219 entries from the tail if set to a negative integer.
1223 Expects a signed integer as value. Changes the starting point for
1224 C<count>, either counted from the top (positive integer) or from
1225 the tail (negative integer). C<offset> has no effect if C<count>
1226 wasn't given as well.
1230 Some examples for the above options. Imagine an example changelog with
1231 entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1.
1233 Call Included entries
1234 C<E<lt>formatE<gt>({ since =E<gt> '2.0' })> 3.1, 3.0, 2.2
1235 C<E<lt>formatE<gt>({ until =E<gt> '2.0' })> 1.3, 1.2
1236 C<E<lt>formatE<gt>({ from =E<gt> '2.0' })> 3.1, 3.0, 2.2, 2.1, 2.0
1237 C<E<lt>formatE<gt>({ to =E<gt> '2.0' })> 2.0, 1.3, 1.2
1238 C<E<lt>formatE<gt>({ count =E<gt> 2 }>> 3.1, 3.0
1239 C<E<lt>formatE<gt>({ count =E<gt> -2 }>> 1.3, 1.2
1240 C<E<lt>formatE<gt>({ count =E<gt> 3,
1241 offset=E<gt> 2 }>> 2.2, 2.1, 2.0
1242 C<E<lt>formatE<gt>({ count =E<gt> 2,
1243 offset=E<gt> -3 }>> 2.0, 1.3
1244 C<E<lt>formatE<gt>({ count =E<gt> -2,
1245 offset=E<gt> 3 }>> 3.0, 2.2
1246 C<E<lt>formatE<gt>({ count =E<gt> -2,
1247 offset=E<gt> -3 }>> 2.2, 2.1
1249 Any combination of one option of C<since> and C<from> and one of
1250 C<until> and C<to> returns the intersection of the two results
1251 with only one of the options specified.
1255 Parse::DebianChangelog::Entry, Parse::DebianChangelog::ChangesFilters
1257 Description of the Debian changelog format in the Debian policy:
1258 L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
1262 Frank Lichtenheld, E<lt>frank@lichtenheld.deE<gt>
1264 =head1 COPYRIGHT AND LICENSE
1266 Copyright (C) 2005 by Frank Lichtenheld
1268 This program is free software; you can redistribute it and/or modify
1269 it under the terms of the GNU General Public License as published by
1270 the Free Software Foundation; either version 2 of the License, or
1271 (at your option) any later version.
1273 This program is distributed in the hope that it will be useful,
1274 but WITHOUT ANY WARRANTY; without even the implied warranty of
1275 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1276 GNU General Public License for more details.
1278 You should have received a copy of the GNU General Public License
1279 along with this program; if not, write to the Free Software
1280 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA