This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to tag debian_version_0_4-1
in repository libparse-debianchangelog-perl.
commit 6d0d728e3de3cb26bb31795ba8c19dc48188a799
Author: Frank Lichtenheld <fr...@lichtenheld.de>
Date: Tue Jul 5 01:40:03 2005 +0000
* New upstream release
- adapt Build-Depends-Indep and Recommends to new requirements
- install new TODO file
- install templates and CSS files to
/usr/share/libparse-debianchangelog-perl/ and adapt the default
paths in the module
---
debian/changelog | 11 +
debian/control | 4 +-
debian/install | 1 +
debian/rules | 3 +-
lib/Parse/DebianChangelog.pm | 648 +++++++++++++++++++++++++++++++------------
t/Parse-DebianChangelog.t | 44 ++-
6 files changed, 530 insertions(+), 181 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index e3c4e03..cbadea5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,14 @@
+libparse-debianchangelog-perl (0.4-1) unstable; urgency=low
+
+ * New upstream release
+ - adapt Build-Depends-Indep and Recommends to new requirements
+ - install new TODO file
+ - install templates and CSS files to
+ /usr/share/libparse-debianchangelog-perl/ and adapt the default
+ paths in the module
+
+ -- Frank Lichtenheld <dj...@debian.org> Tue, 5 Jul 2005 03:28:10 +0200
+
libparse-debianchangelog-perl (0.3a-1) unstable; urgency=low
* Initial Release (Closes: #314559).
diff --git a/debian/control b/debian/control
index 963fb36..e9ed9d3 100644
--- a/debian/control
+++ b/debian/control
@@ -2,14 +2,14 @@ Source: libparse-debianchangelog-perl
Section: perl
Priority: optional
Build-Depends: debhelper (>= 4.0.2)
-Build-Depends-Indep: perl (>= 5.8.0-7), libtimedate-perl
+Build-Depends-Indep: perl (>= 5.8.0-7), libtimedate-perl, libhtml-parser-perl,
libhtml-template-perl, tidy
Maintainer: Frank Lichtenheld <dj...@debian.org>
Standards-Version: 3.6.2
Package: libparse-debianchangelog-perl
Architecture: all
Depends: ${perl:Depends}, ${misc:Depends}, libtimedate-perl
-Recommends: dpkg-dev, libhtml-parser-perl, liburi-perl
+Recommends: libhtml-parser-perl, libhtml-template-perl
Description: parse Debian changelogs and output them in other formats
Replacement for the very limited dpkg-parsechangelog.
.
diff --git a/debian/install b/debian/install
new file mode 100644
index 0000000..19290db
--- /dev/null
+++ b/debian/install
@@ -0,0 +1 @@
+tmpl/* usr/share/libparse-debianchangelog-perl
diff --git a/debian/rules b/debian/rules
index f86eb26..a6035df 100755
--- a/debian/rules
+++ b/debian/rules
@@ -59,8 +59,9 @@ binary-arch:
binary-indep: build install
dh_testdir
dh_testroot
+ dh_install
# dh_installexamples
- dh_installdocs
+ dh_installdocs TODO
dh_installchangelogs Changes
dh_perl
dh_link
diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm
index e607c90..0e2e7e9 100644
--- a/lib/Parse/DebianChangelog.pm
+++ b/lib/Parse/DebianChangelog.pm
@@ -29,17 +29,68 @@ Parse::DebianChangelog - parse Debian changelogs and output
them in other format
my $chglog = Parse::DebianChangelog->init( { infile => 'debian/changelog',
HTML => { outfile =>
'changelog.html' } );
- $chglog->html_out;
+ $chglog->html;
# the following is semantically equivalent
my $chglog = Parse::DebianChangelog->init();
$chglog->parse( { infile => 'debian/changelog' } );
- $chglog->html_out( { outfile => 'changelog.html' } );
- $chglog->dpkg_out( { since => '1.0-1' } );
+ $chglog->html( { outfile => 'changelog.html' } );
+ my $changes = $chglog->dpkg_str( { since => '1.0-1' } );
+ print $changes;
=head1 DESCRIPTION
+Parse::DebianChangelog parses Debian changelogs as desribed in the Debian
+policy (version 3.6.2.1 at the time of this writing). See section
+L<"SEE ALSO"> for locations where to find this definition.
+
+The parser tries to ignore most cruft like # or /* */ style comments,
+CVS comments, vim variables, 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.
+
+Parse::DebianChangelog also supports converting these changelogs then
+to various other formats. These are currently:
+
+=over 4
+
+=item dpkg
+
+Format as know from L<dpkg-parsechangelog(1)>. All requested entries
+(see L<"METHODS"> for an explanation what this means) are returned in
+the usual Debian control format, merged in one stanza, ready to be used
+a F<.changes> file.
+
+=item rfc822
+
+Similar to the C<dpkg> format, but the requested entries are returned
+as one stanza each, i.e. they are not merged. This is probably the format
+to use if you want a machine-usable representation of the changelog.
+
+=item html
+
+The changelog is converted to a somewhat nice looking HTML file with
+some niće features as a quicklink bar with direct links to every entry.
+NOTE: This is not very configurable yet and was specifically designed
+to be used on L<http://packages.debian.org/>. This is planned to be
+changed until version 1.0.
+
+=item custom
+
+All the nitty-gritty details of what the parser found out in a
+machine-usable format.
+NOTE: Not implemented yet. You can of course use the internal
+representation but don't expect that to work in future versions of
+this module. It is planned to encapsulate each entry's data in an
+own object and then make these available to the user...
+
+=back
+
+=head2 METHODS
+
=cut
package Parse::DebianChangelog;
@@ -66,7 +117,22 @@ our @EXPORT = qw(
);
our $CLASSNAME = 'Parse::DebianChangelog';
-our $VERSION = 0.3;
+our $VERSION = 0.4;
+
+=pod
+
+=head3 init
+
+Creates a new object instance. Takes a reference to a hash as
+optional argument, which is interpreted as configuration options.
+There are currently no supported general configuration options, but
+see the other methods for more specifc configuration options which
+can also specified to C<init>.
+
+If C<infile> is specified (see L<parse>), C<parse()> is called
+from C<init>.
+
+=cut
sub init {
my $classname = shift;
@@ -85,13 +151,22 @@ sub init {
return $self;
}
+=pod
+
+=head3 reset_parse_errors
+
+Can be used to delete all information about errors ocurred during
+previous L<parse> runs. Note that C<parse()> also calls this method.
+
+=cut
+
sub reset_parse_errors {
my ($self) = @_;
$self->{errors}{parser} = [];
}
-sub do_parse_error {
+sub _do_parse_error {
my ($self, $file, $line_nr, $error, $line) = @_;
shift;
@@ -107,6 +182,40 @@ sub do_parse_error {
}
}
+=pod
+
+=head3 get_parse_errors
+
+Returns all error messages from the last L<parse> run.
+If called in scalar context returns a human readable
+string represenation. If called in list context returns
+a reference to an array of arrays. Each of these arrays contains
+
+=over 4
+
+=item 1.
+
+the filename of the parsed file
+
+=item 2.
+
+the line number where the error occoured
+
+=item 3.
+
+an error description
+
+=item 4.
+
+the original line
+
+=back
+
+NOTE: This format isn't stable yet and may change in later versions
+of this module.
+
+=cut
+
sub get_parse_errors {
my ($self) = @_;
@@ -125,6 +234,31 @@ sub get_parse_errors {
}
}
+sub __find_closes {
+ my $changes = shift;
+ my @closes = ();
+
+ while ($changes && ($changes =~
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
+ push(@closes, $& =~ /\#?\s?(\d+)/g);
+ }
+
+ @closes = sort { $a <=> $b } @closes;
+ return \@closes;
+}
+
+=pod
+
+=head3 parse
+
+Parses the file that is saved in the configuration item C<infile>.
+Accepts a hash ref as optional argument which can contains configuration
+items.
+
+Returns undef in case of error (e.g. "file not found", B<not> parse errors)
+and the object if successfull.
+
+=cut
+
sub parse {
my ($self, $config) = @_;
@@ -154,14 +288,10 @@ sub parse {
|| $expect eq 'next heading or eof') {
$entry{ERROR} = [ $file, $NR,
"found start of entry where expected
$expect", "$_" ];
- $self->do_parse_error(@{$entry{ERROR}});
+ $self->_do_parse_error(@{$entry{ERROR}});
}
if (%entry) {
- my @closes;
- while ($entry{'Changes'} && ($entry{'Changes'} =~
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
- push(@closes, $& =~ /\#?\s?(\d+)/g);
- }
- $entry{'Closes'} = [ sort { $a <=> $b } @closes ];
+ $entry{'Closes'} = __find_closes( $entry{Changes} );
# print STDERR, Dumper(%entry);
push @{$self->{data}}, { %entry };
@@ -180,14 +310,14 @@ sub parse {
# print STDERR "RHS: $rhs\n";
for my $kv (split(/\s*,\s*/,$rhs)) {
$kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
- $self->do_parse_error($file, $NR, "bad key-value after
\`;': \`$kv'");
+ $self->_do_parse_error($file, $NR, "bad key-value after
\`;': \`$kv'");
my $k = ucfirst $1;
my $v = $2;
- $kvdone{$k}++ && $self->do_parse_error($file, $NR,
+ $kvdone{$k}++ && $self->_do_parse_error($file, $NR,
"repeated key-value $k");
if ($k eq 'Urgency') {
$v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"badly formatted urgency value",
$v);
$entry{'Urgency'} = $1;
@@ -198,7 +328,7 @@ sub parse {
# XC for putting in Control, XS for putting in Source
$entry{$k}= $v;
} else {
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"unknown key-value key $k - copying
to XS-$k");
$entry{"XS-$k"} = $v;
}
@@ -229,14 +359,14 @@ sub parse {
$self->{oldformat} = "$_\n";
$self->{oldformat} .= join "", <$fh>;
} elsif (m/^\S/) {
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"badly formatted heading line", "$_");
} 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)
{
$expect eq 'more change data or trailer' ||
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"found trailer where expected $expect", "$_");
if ($3 ne ' ') {
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"badly formatted trailer line", "$_");
}
$entry{'Trailer'} = $_;
@@ -244,29 +374,25 @@ sub parse {
unless($entry{'Date'} && $entry{'Parsed_Date'}) {
$entry{'Date'} = $4;
$entry{'Parsed_Date'} = str2time($4)
- or $self->do_parse_error( $file, $NR, "couldn't parse date
$4" );
+ or $self->_do_parse_error( $file, $NR, "couldn't parse date
$4" );
}
$expect = 'next heading or eof';
} elsif (m/^ \-\-/) {
$entry{ERROR} = [ $file, $NR,
"badly formatted trailer line", "$_" ];
- $self->do_parse_error(@{$entry{ERROR}});
+ $self->_do_parse_error(@{$entry{ERROR}});
# $expect = 'next heading or eof'
# if $expect eq 'more change data or trailer';
} elsif (m/^\s{2,}(\S)/) {
$expect eq 'start of change data'
|| $expect eq 'more change data or trailer'
|| do {
- $self->do_parse_error($file, $NR,
+ $self->_do_parse_error($file, $NR,
"found change data where expected $expect", "$_");
if (($expect eq 'next heading or eof')
&& %entry) {
# lets assume we have missed the actual header line
- my @closes;
- while ($entry{'Changes'} && ($entry{'Changes'} =~
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/igo)) {
- push(@closes, $& =~ /\#?\s?(\d+)/g);
- }
- $entry{'Closes'} = [ sort { $a <=> $b } @closes ];
+ $entry{'Closes'} = __find_closes( $entry{Changes} );
# print STDERR, Dumper(%entry);
push @{$self->{data}}, { %entry };
@@ -293,11 +419,11 @@ sub parse {
next if $expect eq 'start of change data'
|| $expect eq 'next heading or eof';
$expect eq 'more change data or trailer'
- || $self->do_parse_error($file, $NR,
+ || $self->_do_parse_error($file, $NR,
"found blank line where expected
$expect");
$blanklines++;
} else {
- $self->do_parse_error($file, $NR, "unrecognised line", "$_");
+ $self->_do_parse_error($file, $NR, "unrecognised line", "$_");
($expect eq 'start of change data'
|| $expect eq 'more change data or trailer')
&& do {
@@ -319,14 +445,10 @@ sub parse {
$expect eq 'next heading or eof'
|| do {
$entry{ERROR} = [ $file, $NR, "found eof where expected $expect" ];
- $self->do_parse_error( @{$entry{ERROR}} );
+ $self->_do_parse_error( @{$entry{ERROR}} );
};
if (%entry) {
- my @closes;
- while ($entry{'Changes'} =~
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
- push(@closes, $& =~ /\#?\s?(\d+)/g);
- }
- $entry{'Closes'} = join(' ', sort { $a <=> $b } @closes);
+ $entry{'Closes'} = __find_closes( $entry{Changes} );
push @{$self->{data}}, \%entry;
}
@@ -339,66 +461,270 @@ sub parse {
return $self;
}
-sub dpkg_out {
- my ($self, $config) = @_;
- $self->{config}{DPKG} = $config if $config;
+sub __data2rfc822_mult {
+ my ($data, $fieldimps) = @_;
+ my @rfc822 = ();
- $config = $self->{config}{DPKG} || {};
- my $data = $self->{data} or return undef;
- my $since = $config->{since} || '';
+ foreach my $entry (@$data) {
+ push @rfc822, __data2rfc822($entry,$fieldimps);
+ }
- my $dpkglibdir="/usr/lib/dpkg";
- push @INC, $dpkglibdir;
- require 'controllib.pl';
+ return join "\n", @rfc822;
+}
+
+sub __data2rfc822 {
+ my ($data, $fieldimps) = @_;
+ my $rfc822_str = '';
+
+# based on /usr/lib/dpkg/controllib.pl
+ for my $f (sort { $fieldimps->{$b} <=> $fieldimps->{$a} } keys %$data) {
+ my $v= $data->{$f};
+ $v =~ m/\S/o || next; # delete whitespace-only fields
+ $v =~ m/\n\S/o && warn("field $f has newline then non whitespace
>$v<");
+ $v =~ m/\n[ \t]*\n/o && warn("field $f has blank lines >$v<");
+ $v =~ m/\n$/o && warn("field $f has trailing newline >$v<");
+ $v =~ s/\$\{\}/\$/go;
+ $rfc822_str .= "$f: $v\n";
+ }
- our ( %fieldimps, %urgencies, %f );
+ return $rfc822_str;
+}
+
+sub __get_dpkg_changes {
+ my $changes = "\n $_[0]->{Header}\n .\n$_[0]->{Changes}";
+ chomp $changes;
+ $changes =~ s/^ $/ ./mgo;
+ return $changes;
+}
+
+our ( %FIELDIMPS, %URGENCIES );
+BEGIN {
my $i=100;
- grep($fieldimps{$_}=$i--,
+ grep($FIELDIMPS{$_}=$i--,
qw(Source Version Distribution Urgency Maintainer Date Closes
Changes));
$i=1;
- grep($urgencies{$_}=$i++,
+ grep($URGENCIES{$_}=$i++,
qw(low medium high critical emergency));
+}
+
+=pod
+
+=head3 dpkg
+
+(and B<dpkg_str>)
+
+C<dpkg> returns a hash (in list context) or a hash reference
+(in scalar context) where the keys are field names and the values are
+field values. The following fields are given:
+
+=over 4
+
+=item Source
+
+package name (in the first entry)
+
+=item Version
+
+packages' version (from first entry)
+
+=item Distribution
+
+target distribution (from first entry)
+
+=item Urgency
+
+urgency (highest of all printed entries)
+
+=item Maintainer
+
+person that created the (first) entry
+
+=item Date
+
+date of the (first) entry
+
+=item Closes
+
+bugs closed by the entry/entries, sorted by bug number
+
+=item Changes
+
+content of the the entry/entries
+
+=back
+C<dpkg_str> returns a stringified version of this hash which should look
+exactly like the output of L<dpkg-parsechangelog(1)>. The fields are
+ordered like in the list above.
+
+Both methods support the configuration item C<since> which works exactly
+like the C<-v> option of dpkg-parsechangelog.
+
+=cut
+
+sub dpkg {
+ my ($self, $config) = @_;
+
+ $self->{config}{DPKG} = $config if $config;
+
+ $config = $self->{config}{DPKG} || {};
+ my $data = $self->{data} or return undef;
+ my $since = $config->{since} || '';
+
+ my %f;
foreach my $field (qw( Urgency Source Version
Distribution Maintainer Date )) {
$f{$field} = $data->[0]{$field};
}
- error( "-v<since> option specifies most recent version" )
+ warn( "-v<since> option specifies most recent version" )
if $f{Version} eq $since;
- $f{Changes} = "\n $data->[0]{Header}\n .\n$data->[0]{Changes}";
- chomp $f{Changes};
- $f{Closes} = "@{$data->[0]{Closes}}";
+ $f{Changes} = __get_dpkg_changes( $data->[0] );
+ $f{Closes} = [ @{$data->[0]{Closes}} ];
- my $first = 1;
+ my $first = 1; my $urg_comment = '';
foreach my $entry (@$data) {
$first = 0, next if $first;
last if !$since or $entry->{Version} eq $since;
my $oldurg = $f{Urgency} || '';
- my $oldurgn = $urgencies{$f{Urgency}} || -1;
+ my $oldurgn = $URGENCIES{$f{Urgency}} || -1;
my $newurg = $entry->{Urgency_LC} || '';
- my $newurgn = $urgencies{$entry->{Urgency_LC}} || -1;
+ my $newurgn = $URGENCIES{$entry->{Urgency_LC}} || -1;
$f{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
- $f{Urgency_Comment} .= $entry->{Urgency_Comment};
+ $urg_comment .= $entry->{Urgency_Comment};
- $f{Changes} .= "\n .\n $entry->{Header}\n .\n$entry->{Changes}";
- chomp $f{Changes};
- $f{Closes} .= " @{$entry->{Closes}}";
+ $f{Changes} .= "\n .".__get_dpkg_changes( $entry );
+ push @{$f{Closes}}, @{$entry->{Closes}};
}
- $f{Changes} =~ s/^ $/ ./mgo;
- $f{Urgency} .= $f{Urgency_Comment};
- delete $f{Urgency_Comment};
+ $f{Closes} = join " ", sort { $a <=> $b } @{$f{Closes}};
+ $f{Urgency} .= $urg_comment;
+
+ return %f if wantarray;
+ return \%f;
+}
- outputclose(0);
+sub dpkg_str {
+ return __data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
}
-sub html_out {
+=pod
+
+=head3 rfc822
+
+(and B<rfc822_str>)
+
+C<rfc822> returns an array of hashes (in list context) or a reference
+to this array (in scalar context) where each hash represents one entry
+in the changelog. For the format of such a hash see the description
+of the L<"dpkg"> method (while ignoring the remarks about which
+values are taken from the first entry).
+
+C<rfc822_str> returns a stringified version of this hash which looks
+similar to the output of dpkg-parsechangelog but instead of one
+stanza the output contains one stanza for each entry.
+
+Both methods support the configuration item C<since> which works exactly
+like the C<-v> option of dpkg-parsechangelog.
+
+=cut
+
+sub rfc822 {
+ my ($self, $config) = @_;
+
+ $self->{config}{RFC822} = $config if $config;
+
+ $config = $self->{config}{RFC822} || {};
+ my $data = $self->{data} or return undef;
+ my $since = $config->{since} || '';
+
+ my @out_data;
+ warn( "-v<since> option specifies most recent version" )
+ if $data->[0]{Version} eq $since;
+
+ my $first = 1;
+ foreach my $entry (@$data) {
+ last if (!$since and !$first) or $entry->{Version} eq $since;
+ $first = 0;
+
+ my %f;
+ foreach my $field (qw( Urgency Source Version
+ Distribution Maintainer Date )) {
+ $f{$field} = $entry->{$field};
+ }
+
+ $f{Urgency} .= $entry->{Urgency_Comment};
+ $f{Changes} = __get_dpkg_changes( $entry );
+ $f{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
+ push @out_data, \%f;
+ }
+
+ return @out_data if wantarray;
+ return \@out_data;
+}
+
+sub rfc822_str {
+ return __data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
+}
+
+sub __version2id {
+ my $version = shift;
+ $version =~ s/[^\w.:-]/_/go;
+ return "version$version";
+}
+
+=pod
+
+=head3 html
+
+(and B<html_str>)
+
+C<html> converts the changelog to a HTML file with some nice features
+such as a quicklink bar with direct links to every entry. The HTML
+is generated with the help of HTML::Template. If you want to change
+the output you should use the default template provided with this module
+as a base and read the documentation of HTML::Template to understand
+how to edit it.
+
+The method C<html_str> is an alias for C<html>.
+
+Both methods support the following configuration items (as usual to give
+in a hash reference as parameter to the method call):
+
+=over 4
+
+=item outfile
+
+directly write the output to the file specified
+
+=item template
+
+template file to use, defaults to
+/usr/share/libparse-debianchangelog-perl/default.tmpl.
+NOTE: The plan is to provide a configuration file for the module
+later to be able to use sane defaults here.
+
+=item style
+
+path to the CSS stylesheet to use (a default might be specified
+in the template and will be honoured, see the default template
+for an example)
+
+=item print_style
+
+path to the CSS stylesheet to use for printing (see the notes for
+C<style> about default values)
+
+=back
+
+=cut
+
+sub html {
my ($self, $config) = @_;
$self->{config}{HTML} = $config if $config;
@@ -409,52 +735,25 @@ sub html_out {
import CGI qw( -no_xhtml -no_debug );
require HTML::Entities;
import HTML::Entities;
- require URI::Escape;
- import URI::Escape;
+ require HTML::Template;
+
+ my $template = HTML::Template->new(filename => $config->{template}
+ ||
'/usr/share/libparse-debianchangelog-perl/default.tmpl');
+ $template->param( MODULE_NAME => $CLASSNAME,
+ MODULE_VERSION => $VERSION,
+ GENERATED_DATE => gmtime()." UTC",
+ SOURCE_NEWEST => $data->[0]{Source},
+ VERSION_NEWEST => $data->[0]{Version},
+ MAINTAINER_NEWEST => $data->[0]{Maintainer},
+ );
+
+ $template->param( CSS_FILE_SCREEN => $config->{style} )
+ if $config->{style};
+ $template->param( CSS_FILE_PRINT => $config->{print_style} )
+ if $config->{print_style};
- my $outfile = $config->{outfile} or return undef;
my $cgi = new CGI;
- open my $fh, '>', $outfile or return undef;
- flock $fh, LOCK_EX or return undef;
-
- print $fh $cgi->start_html( -title => $config->{title}
- || "Debian Changelog $data->[0]{Source}
($data->[0]{Version})",
- -author => $config->{author}
- || $data->[0]{Maintainer},
- -meta=>{ keywords => $config->{keywords}
- || "Debian Changelog
$data->[0]{Source} $data->[0]{Version}",
- generator => "$CLASSNAME (v$VERSION)"
},
- -head=>[ $cgi->meta({ -http_equiv =>
'Content-Type',
- -content => 'text/html;
charset=UTF-8' }),
- $cgi->Link({-rel=>'stylesheet',
- -href => $config->{style}
- || 'changelogs.css',
- -type => 'text/css',
- -media => 'screen' }),
- $cgi->Link({-rel=>'stylesheet',
- -href =>
$config->{print_style}
- || 'changelogs-print.css',
- -type => 'text/css',
- -media => 'print' }),
- ],
- );
-
- print $fh $cgi->p({ -class=>'hide' },
- $cgi->a({ -href=>'#content' },
- 'Skip to content' ));
-
- print $fh $cgi->ul( { -class=>'navbar' },
- $cgi->li( [
- $cgi->a({
-href=>"http://packages.debian.org/src:$data->[0]{Source}" }, 'Package
Information' ),
- $cgi->a({
-href=>"http://packages.qa.debian.org/$data->[0]{Source}" }, 'Package Developer
Information' ),
- $cgi->a({
-href=>"http://bugs.debian.org/src:$data->[0]{Source}" }, 'Bug Information' ),
- ] ) );
-
- print $fh $cgi->h1( { -class=>"document_header" },
- $config->{title}
- || "Debian Changelog $data->[0]{Source}
($data->[0]{Version})" );
-
my %navigation;
my $last_year;
foreach my $entry (@$data) {
@@ -463,27 +762,29 @@ sub html_out {
$year = (gmtime($entry->{Parsed_Date}))[5] + 1900;
$last_year = $year;
}
-
+
$year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
- $navigation{$year} ||= [];
- $entry->{Maintainer} ||= 'unkown';
- $entry->{Date} ||= 'unkown';
- push @{$navigation{$year}}, $cgi->a({-href=>"#version$entry->{Version}",
-
-title=>encode_entities("$entry->{Maintainer} $entry->{Date}",'<>&"')},
- $entry->{Version});
+
+ $navigation{$year}{NAV_VERSIONS} ||= [];
+ $navigation{$year}{NAV_YEAR} ||= $year;
+
+ $entry->{Maintainer} ||= 'unknown';
+ $entry->{Date} ||= 'unknown';
+ push @{$navigation{$year}{NAV_VERSIONS}},
+ { NAV_VERSION_ID => __version2id($entry->{Version}),
+ NAV_VERSION => $entry->{Version},
+ NAV_MAINTAINER => $entry->{Maintainer},
+ NAV_DATE => $entry->{Date} };
}
- print $fh $cgi->start_ul( { -class=>'outline' } );
+ my @nav_years;
foreach my $y (reverse sort keys %navigation) {
- print $fh $cgi->li(
- $cgi->a({ -href=>"#year$y" },$y).": ".
- $cgi->ul( $cgi->li( $navigation{$y} ) ) );
- }
- if ($self->{oldformat}) {
- print $fh $cgi->li($cgi->a({ -href=>'#oldformat' }, 'old format'));
+ push @nav_years, $navigation{$y};
}
- print $fh $cgi->end_ul;
-
- print $fh $cgi->start_div({ -id=>'content'});
+ $template->param( OLDFORMAT => (($self->{oldformat}||'') ne ''),
+ NAV_YEARS => \@nav_years );
+
+
+ my %years;
$last_year = undef;
foreach my $entry (@$data) {
my $year = $last_year; # try to deal gracefully with unparsable dates
@@ -491,29 +792,15 @@ sub html_out {
$year = (gmtime($entry->{Parsed_Date}))[5] + 1900;
}
$year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] +
1900);
-
+
if (!$last_year || ($year < $last_year)) {
- print $fh $cgi->h2( { -class=>'year_header',
- -id=>"year$year" }, $year );
$last_year = $year;
}
- my $pkg = $cgi->a({ -href=>"http://packages.debian.org/src:";.
- uri_escape($entry->{Source}),
- -class=>'packagelink' },
- $entry->{Source} );
-
- print $fh $cgi->h3( { -class=>'entry_header',
- -id=>"version$entry->{Version}" },
- "$pkg ($entry->{Version}) ".
- $cgi->span( { -class=>$entry->{Distribution} },
- $entry->{Distribution} ).
- "; urgency=".
- $cgi->span( { -class=>$entry->{Urgency_LC} },
- $entry->{Urgency}.
- $entry->{Urgency_Comment} ) );
-
- my $text = encode_entities( $entry->{Changes}, '<>&"' ) || "";
+ $years{$last_year}{CONTENT_VERSIONS} ||= [];
+ $years{$last_year}{CONTENT_YEAR} ||= $last_year;
+
+ my $text = encode_entities( $entry->{Changes}, '<>&"' ) || '';
$text=~ s|<URL:([-\w\.\/:~_\@]+):([a-zA-Z0-9\'() ]+)>
|$cgi->a({ -href=>$1 }, $2)
|xego;
@@ -556,48 +843,61 @@ sub html_out {
|$cgi->a({ -href=>"http://www.debian.org/misc/bsd.license"; },
$&)
|xego;
- print $fh $cgi->pre($text);
+ (my $maint_name = $entry->{Maintainer} ) =~
s|<([a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,}))>||o;
+ my $maint_mail = $1;
+
+ my $parse_error;
+ $parse_error = $cgi->p( { -class=>'parse_error' },
+ "(There has been a parse error in the entry
above, if some values don't make sense please check the original changelog)" )
if $entry->{ERROR};
+
+ push @{$years{$last_year}{CONTENT_VERSIONS}}, {
+ CONTENT_VERSION => $entry->{Version},
+ CONTENT_VERSION_ID => __version2id($entry->{Version}),
+ CONTENT_URGENCY => $entry->{Urgency}.$entry->{Urgency_Comment},
+ CONTENT_URGENCY_NORM => $entry->{Urgency_LC},
+ CONTENT_DISTRIBUTION => $entry->{Distribution},
+ CONTENT_DISTRIBUTION_NORM => lc($entry->{Distribution}),
+ CONTENT_SOURCE => $entry->{Source},
+ CONTENT_CHANGES => $text,
+ CONTENT_DATE => $entry->{Date},
+ CONTENT_MAINTAINER_NAME => $maint_name,
+ CONTENT_MAINTAINER_EMAIL => $maint_mail,
+ CONTENT_PARSE_ERROR => $parse_error,
+ };
+
+ }
+ my @content_years;
+ foreach my $y (reverse sort keys %years) {
+ push @content_years, $years{$y};
+ }
+ $template->param( OLDFORMAT_CHANGES => $self->{oldformat},
+ CONTENT_YEARS => \@content_years );
+
+ my $html_str = $template->output;
- my $maint = encode_entities( $entry->{Maintainer}, '<>&"' );
- $maint =~ s|[a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,})
- |$cgi->a({
-href=>"http://qa.debian.org/developer.php?login=$&"; }, $&)
- |xego;
+ if ($config->{outfile}) {
+ open my $fh, '>', $config->{outfile} or return undef;
+ flock $fh, LOCK_EX or return undef;
- print $fh $cgi->p( { -class=>'trailer' }, " -- $maint $entry->{Date}"
);
- print $fh $cgi->p( { -class=>'parse_error' },
- "(There has been a parse error in the entry above,
if some values don't make sense please check the original changelog)" ) if
$entry->{ERROR};
+ print $fh $html_str;
+ close $fh or return undef;
}
- if ($self->{oldformat}) {
- print $fh $cgi->h2({ -class=>'year_header', -id=>'oldformat' },
- 'Old changelog format(s), not parsed' );
- print $fh $cgi->pre({ -class=>'oldformat' },
- encode_entities( $self->{oldformat}, '<>&"' ) );
- }
- print $fh $cgi->end_div; # content
-
- print $fh $cgi->div({-class=>'footer'},
- $cgi->hr({-class=>'hide'}).
- $cgi->address(
- 'Generated '.
- gmtime().
- ' UTC by '.
- $cgi->tt("$CLASSNAME (v$VERSION)").
- $cgi->br().
- 'Contact '.
- $cgi->a({
-href=>'mailto:debian-...@lists.debian.org' },
- 'debian-...@lists.debian.org' ).
- ' in case of problems.'
- ) );
-
- print $fh $cgi->end_html;
- close $fh or return undef;
- return $self;
+ return $html_str;
+}
+
+sub html_str {
+ return html(@_);
}
1;
__END__
+=head1 SEE ALSO
+
+Description of the Debian changelog format in the Debian policy:
+L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
+
=head1 AUTHOR
Frank Lichtenheld, E<lt>fr...@lichtenheld.dee<gt>
diff --git a/t/Parse-DebianChangelog.t b/t/Parse-DebianChangelog.t
index 1a46d28..12c6791 100644
--- a/t/Parse-DebianChangelog.t
+++ b/t/Parse-DebianChangelog.t
@@ -1,3 +1,4 @@
+# -*- perl -*-
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl
Parse-DebianChangelog.t'
@@ -5,12 +6,47 @@
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 2;
+use strict;
+use warnings;
+
+use File::Basename;
+
+use Test::More tests => 7;
BEGIN { use_ok('Parse::DebianChangelog') };
#########################
-my $changes = Parse::DebianChangelog->init( { infile => 'Changes' } );
-my $errors = $changes->get_parse_errors();
+foreach my $file (qw(Changes)) {
+
+ my $changes = Parse::DebianChangelog->init( { infile => $file } );
+ my $errors = $changes->get_parse_errors();
+ my $basename = basename( $file );
+
+ ok( !$errors, "Parse example changelog $file without errors" );
+
+ $changes->html( { outfile => "t/$basename.html.tmp",
+ template => 'tmpl/default.tmpl' } );
+
+ ok( !`tidy -qe t/$basename.html.tmp 2>&1`, 'Generated HTML has no tidy
errors' );
+
+ unlink "t/$basename.html.tmp";
+
+ my $str = $changes->dpkg_str();
+
+ ok( $str eq `dpkg-parsechangelog -l$file 2>&1`, 'Output of dpkg_out equal
to output of dpkg-parsechangelog' );
+
+ my $oldest_version = $changes->{data}[-1]{Version};
+
+ $str = $changes->dpkg_str({ since => $oldest_version });
+
+ ok( $str eq `dpkg-parsechangelog -v$oldest_version -l$file 2>&1`, 'Output
of dpkg_out equal to output of dpkg-parsechangelog' );
+
+ $str = $changes->rfc822_str();
+
+ ok( 1 );
+
+ $str = $changes->rfc822_str({ since => $oldest_version });
+
+ ok( 1 );
+}
-ok( !$errors, 'Parse the own changelog without errors' );
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libparse-debianchangelog-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
