[libparse-debianchangelog-perl] 02/06: Merge 0.5 to MAIN
Intrigeri
intrigeri at moszumanska.debian.org
Sun May 24 12:37:48 UTC 2015
This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to tag debian_version_0_5-1
in repository libparse-debianchangelog-perl.
commit 0912623a6cb6daacda06de5b7695c5a1de548f66
Author: Frank Lichtenheld <frank at lichtenheld.de>
Date: Tue Jul 12 17:27:39 2005 +0000
Merge 0.5 to MAIN
---
lib/Parse/DebianChangelog.pm | 402 ++++++++++++++++++++++---------------------
t/Parse-DebianChangelog.t | 73 ++++++--
2 files changed, 271 insertions(+), 204 deletions(-)
diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm
index 0e2e7e9..f74dc57 100644
--- a/lib/Parse/DebianChangelog.pm
+++ b/lib/Parse/DebianChangelog.pm
@@ -52,8 +52,9 @@ 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:
+Beside giving access to the details of the parsed file via the
+L<"data"> method, Parse::DebianChangelog also supports converting these
+changelogs to various other formats. These are currently:
=over 4
@@ -78,15 +79,6 @@ 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
@@ -101,23 +93,11 @@ use warnings;
use Fcntl qw( :flock );
use English;
use Date::Parse;
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-
-our %EXPORT_TAGS = ( 'all' => [ qw(
-
-) ] );
-
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-our @EXPORT = qw(
-
-);
+use Parse::DebianChangelog::Util qw( :all );
+use Parse::DebianChangelog::Entry;
our $CLASSNAME = 'Parse::DebianChangelog';
-our $VERSION = 0.4;
+our $VERSION = 0.5;
=pod
@@ -148,6 +128,9 @@ sub init {
$self->parse;
}
+ $self->init_filters;
+ $self->reset_parse_errors;
+
return $self;
}
@@ -234,18 +217,6 @@ 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
@@ -276,7 +247,7 @@ sub parse {
# based on /usr/lib/dpkg/parsechangelog/debian
my $expect='first heading';
- my %entry = ();
+ my $entry = Parse::DebianChangelog::Entry->init();
my $blanklines = 0;
my $unknowncounter = 1; # to make version unique, e.g. for using as id
@@ -286,24 +257,23 @@ sub parse {
if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
unless ($expect eq 'first heading'
|| $expect eq 'next heading or eof') {
- $entry{ERROR} = [ $file, $NR,
+ $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) {
- $entry{'Closes'} = __find_closes( $entry{Changes} );
-
-# print STDERR, Dumper(%entry);
- push @{$self->{data}}, { %entry };
- %entry = ();
+ unless ($entry->is_empty) {
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+# print STDERR, Dumper($entry);
+ push @{$self->{data}}, $entry;
+ $entry = Parse::DebianChangelog::Entry->init();
}
{
- $entry{'Source'} = $1;
- $entry{'Version'} = $2;
- $entry{'Header'} = $_;
- ($entry{'Distribution'} = $3) =~ s/^\s+//;
- $entry{'Changes'} = $entry{'Urgency_Comment'} = '';
- $entry{'Urgency'} = $entry{'Urgency_LC'} = 'unknown';
+ $entry->{'Source'} = $1;
+ $entry->{'Version'} = $2;
+ $entry->{'Header'} = $_;
+ ($entry->{'Distribution'} = $3) =~ s/^\s+//;
+ $entry->{'Changes'} = $entry->{'Urgency_Comment'} = '';
+ $entry->{'Urgency'} = $entry->{'Urgency_LC'} = 'unknown';
}
(my $rhs = $POSTMATCH) =~ s/^\s+//;
my %kvdone;
@@ -320,17 +290,17 @@ sub parse {
$self->_do_parse_error($file, $NR,
"badly formatted urgency value",
$v);
- $entry{'Urgency'} = $1;
- $entry{'Urgency_LC'} = lc($1);
- $entry{'Urgency_Comment'} = $2 || '';
+ $entry->{'Urgency'} = $1;
+ $entry->{'Urgency_LC'} = lc($1);
+ $entry->{'Urgency_Comment'} = $2 || '';
} elsif ($k =~ m/^X[BCS]+-/i) {
# Extensions - XB for putting in Binary,
# XC for putting in Control, XS for putting in Source
- $entry{$k}= $v;
+ $entry->{$k}= $v;
} else {
$self->_do_parse_error($file, $NR,
"unknown key-value key $k - copying to XS-$k");
- $entry{"XS-$k"} = $v;
+ $entry->{ExtraFields}{"XS-$k"} = $v;
}
}
$expect= 'start of change data';
@@ -369,18 +339,18 @@ sub parse {
$self->_do_parse_error($file, $NR,
"badly formatted trailer line", "$_");
}
- $entry{'Trailer'} = $_;
- $entry{'Maintainer'} = "$1 <$2>" unless $entry{'Maintainer'};
- unless($entry{'Date'} && $entry{'Parsed_Date'}) {
- $entry{'Date'} = $4;
- $entry{'Parsed_Date'} = str2time($4)
+ $entry->{'Trailer'} = $_;
+ $entry->{'Maintainer'} = "$1 <$2>" unless $entry->{'Maintainer'};
+ 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" );
}
$expect = 'next heading or eof';
} elsif (m/^ \-\-/) {
- $entry{ERROR} = [ $file, $NR,
+ $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)/) {
@@ -390,28 +360,27 @@ sub parse {
$self->_do_parse_error($file, $NR,
"found change data where expected $expect", "$_");
if (($expect eq 'next heading or eof')
- && %entry) {
+ && !$entry->is_empty) {
# lets assume we have missed the actual header line
- $entry{'Closes'} = __find_closes( $entry{Changes} );
-
-# print STDERR, Dumper(%entry);
- push @{$self->{data}}, { %entry };
- %entry = ();
- $entry{Source} =
- $entry{Distribution} = $entry{Urgency} =
- $entry{Urgency_LC} = 'unknown';
- $entry{Version} = 'unknown'.($unknowncounter++);
- $entry{Urgency_Comment} = '';
- $entry{ERROR} = [ $file, $NR,
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+# print STDERR, Dumper($entry);
+ push @{$self->{data}}, $entry;
+ $entry = Parse::DebianChangelog::Entry->init();
+ $entry->{Source} =
+ $entry->{Distribution} = $entry->{Urgency} =
+ $entry->{Urgency_LC} = 'unknown';
+ $entry->{Version} = 'unknown'.($unknowncounter++);
+ $entry->{Urgency_Comment} = '';
+ $entry->{ERROR} = [ $file, $NR,
"found change data where expected $expect", "$_" ];
}
};
- $entry{'Changes'} .= (" \n" x $blanklines)." $_\n";
- if (!$entry{'Items'} || ($1 eq '*')) {
- $entry{'Items'} ||= [];
- push @{$entry{'Items'}}, "$_\n";
+ $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+ if (!$entry->{'Items'} || ($1 eq '*')) {
+ $entry->{'Items'} ||= [];
+ push @{$entry->{'Items'}}, "$_\n";
} else {
- $entry{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
}
$blanklines = 0;
$expect = 'more change data or trailer';
@@ -428,31 +397,30 @@ sub parse {
|| $expect eq 'more change data or trailer')
&& do {
# lets assume change data if we expected it
- $entry{'Changes'} .= (" \n" x $blanklines)." $_\n";
- if (!$entry{'Items'}) {
- $entry{'Items'} ||= [];
- push @{$entry{'Items'}}, "$_\n";
+ $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+ if (!$entry->{'Items'}) {
+ $entry->{'Items'} ||= [];
+ push @{$entry->{'Items'}}, "$_\n";
} else {
- $entry{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
}
$blanklines = 0;
$expect = 'more change data or trailer';
- $entry{ERROR} = [ $file, $NR, "unrecognised line", "$_" ];
+ $entry->{ERROR} = [ $file, $NR, "unrecognised line", "$_" ];
};
}
}
$expect eq 'next heading or eof'
|| do {
- $entry{ERROR} = [ $file, $NR, "found eof where expected $expect" ];
- $self->_do_parse_error( @{$entry{ERROR}} );
+ $entry->{ERROR} = [ $file, $NR, "found eof where expected $expect" ];
+ $self->_do_parse_error( @{$entry->{ERROR}} );
};
- if (%entry) {
- $entry{'Closes'} = __find_closes( $entry{Changes} );
-
- push @{$self->{data}}, \%entry;
+ unless ($entry->is_empty) {
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+ push @{$self->{data}}, $entry;
}
-
+
close $fh or return undef;
# use Data::Dumper;
@@ -461,52 +429,23 @@ sub parse {
return $self;
}
+=pod
-sub __data2rfc822_mult {
- my ($data, $fieldimps) = @_;
- my @rfc822 = ();
+=head3 data
- foreach my $entry (@$data) {
- push @rfc822, __data2rfc822($entry,$fieldimps);
- }
+C<data> returns an array (if called in list context) or a reference
+to an array of Parse::DebianChangelog::Entry objects which each
+represent one entry of the changelog.
- return join "\n", @rfc822;
-}
+This is currently merely a placeholder to enable users to get to the
+raw data, exepct changes to this API in the near future.
-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";
- }
-
- return $rfc822_str;
-}
-
-sub __get_dpkg_changes {
- my $changes = "\n $_[0]->{Header}\n .\n$_[0]->{Changes}";
- chomp $changes;
- $changes =~ s/^ $/ ./mgo;
- return $changes;
-}
+=cut
-our ( %FIELDIMPS, %URGENCIES );
-BEGIN {
- my $i=100;
- grep($FIELDIMPS{$_}=$i--,
- qw(Source Version Distribution Urgency Maintainer Date Closes
- Changes));
- $i=1;
- grep($URGENCIES{$_}=$i++,
- qw(low medium high critical emergency));
+sub data {
+ my ($self) = @_;
+ return @{$self->{data}} if wantarray;
+ return $self->{data};
}
=pod
@@ -564,6 +503,17 @@ like the C<-v> option of dpkg-parsechangelog.
=cut
+our ( %FIELDIMPS, %URGENCIES );
+BEGIN {
+ my $i=100;
+ grep($FIELDIMPS{$_}=$i--,
+ qw(Source Version Distribution Urgency Maintainer Date Closes
+ Changes));
+ $i=1;
+ grep($URGENCIES{$_}=$i++,
+ qw(low medium high critical emergency));
+}
+
sub dpkg {
my ($self, $config) = @_;
@@ -582,7 +532,7 @@ sub dpkg {
warn( "-v<since> option specifies most recent version" )
if $f{Version} eq $since;
- $f{Changes} = __get_dpkg_changes( $data->[0] );
+ $f{Changes} = get_dpkg_changes( $data->[0] );
$f{Closes} = [ @{$data->[0]{Closes}} ];
my $first = 1; my $urg_comment = '';
@@ -596,8 +546,8 @@ sub dpkg {
my $newurgn = $URGENCIES{$entry->{Urgency_LC}} || -1;
$f{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
$urg_comment .= $entry->{Urgency_Comment};
-
- $f{Changes} .= "\n .".__get_dpkg_changes( $entry );
+
+ $f{Changes} .= "\n .".get_dpkg_changes( $entry );
push @{$f{Closes}}, @{$entry->{Closes}};
}
@@ -610,7 +560,7 @@ sub dpkg {
}
sub dpkg_str {
- return __data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
+ return data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
}
=pod
@@ -659,7 +609,7 @@ sub rfc822 {
}
$f{Urgency} .= $entry->{Urgency_Comment};
- $f{Changes} = __get_dpkg_changes( $entry );
+ $f{Changes} = get_dpkg_changes( $entry );
$f{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
push @out_data, \%f;
}
@@ -669,7 +619,7 @@ sub rfc822 {
}
sub rfc822_str {
- return __data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
+ return data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
}
sub __version2id {
@@ -726,19 +676,18 @@ C<style> about default values)
sub html {
my ($self, $config) = @_;
-
+
$self->{config}{HTML} = $config if $config;
$config = $self->{config}{HTML} || {};
my $data = $self->{data} or return undef;
require CGI;
import CGI qw( -no_xhtml -no_debug );
- require HTML::Entities;
- import HTML::Entities;
require HTML::Template;
my $template = HTML::Template->new(filename => $config->{template}
- || '/usr/share/libparse-debianchangelog-perl/default.tmpl');
+ || '/usr/share/libparse-debianchangelog-perl/default.tmpl',
+ die_on_bad_params => 0);
$template->param( MODULE_NAME => $CLASSNAME,
MODULE_VERSION => $VERSION,
GENERATED_DATE => gmtime()." UTC",
@@ -791,8 +740,8 @@ sub html {
if ($entry->{Parsed_Date}) {
$year = (gmtime($entry->{Parsed_Date}))[5] + 1900;
}
- $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
-
+ $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
+
if (!$last_year || ($year < $last_year)) {
$last_year = $year;
}
@@ -800,48 +749,7 @@ sub html {
$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;
- $text=~ s|https?:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
- |$cgi->a({ -href=>$& }, $&)
- |xego;
- $text=~ s|ftp:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
- |$cgi->a({ -href=>$& }, $&)
- |xego;
- $text=~ 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;
- $text=~ s|Closes:\s*(?:Bug)?\#\d+(?:\s*,\s*(?:Bug)?\#\d+)*
- |my $tmp = $&; { no warnings;
- $tmp =~ s@(Bug)?\#(\d+)@<a class="buglink" href="http://bugs.debian.org/$2">$1\#$2</a>@ig; }
- "$tmp"
- |xiego;
- $text=~ s|\B\*([a-z][a-z -]*[a-z])\*\B
- |$cgi->em($1)
- |xiego;
- $text=~ s|\B\*([a-z])\*\B
- |$cgi->em($1)
- |xiego;
- $text=~ s|\B\#([a-z][a-z -]*[a-z])\#\B
- |$cgi->strong($1)
- |xego;
- $text=~ s|\B\#([a-z])\#\B
- |$cgi->strong($1)
- |xego;
- $text=~ s|/usr/share/common-licenses/GPL(?:-2)?
- |$cgi->a({ -href=>"http://www.gnu.org/copyleft/gpl.html" }, $&)
- |xego;
- $text=~ s|/usr/share/common-licenses/LGPL(?:-2(?:\.1)?)?
- |$cgi->a({ -href=>"http://www.gnu.org/copyleft/lgpl.html" }, $&)
- |xego;
- $text=~ s|/usr/share/common-licenses/Artistic
- |$cgi->a({ -href=>"http://www.opensource.org/licenses/artistic-license.php" }, $&)
- |xego;
- $text=~ s|/usr/share/common-licenses/BSD
- |$cgi->a({ -href=>"http://www.debian.org/misc/bsd.license" }, $&)
- |xego;
+ my $text = $self->apply_filters( 'html::changes', $entry->{Changes}, $cgi );
(my $maint_name = $entry->{Maintainer} ) =~ s|<([a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,}))>||o;
my $maint_mail = $1;
@@ -849,7 +757,7 @@ sub html {
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}),
@@ -859,12 +767,12 @@ sub html {
CONTENT_DISTRIBUTION_NORM => lc($entry->{Distribution}),
CONTENT_SOURCE => $entry->{Source},
CONTENT_CHANGES => $text,
+ CONTENT_CHANGES_UNFILTERED => $entry->{Changes},
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) {
@@ -891,10 +799,120 @@ sub html_str {
return html(@_);
}
+
+=pod
+
+=head3 init_filters
+
+not yet documented
+
+=cut
+
+sub init_filters {
+ my ($self) = @_;
+
+ require Parse::DebianChangelog::ChangesFilters;
+
+ $self->{filters} = {};
+
+ $self->{filters}{'html::changes'} =
+ [ @Parse::DebianChangelog::ChangesFilters::all_filters ];
+}
+
+=pod
+
+=head3 apply_filters
+
+not yet documented
+
+=cut
+
+sub apply_filters {
+ my ($self, $filter_class, $text, $data) = @_;
+
+ foreach my $f (@{$self->{filters}{$filter_class}}) {
+ $text = &$f( $text, $data );
+ }
+ return $text;
+}
+
+=pod
+
+=head3 add_filter, delete_filter, replace_filter
+
+not yet documented
+
+=cut
+
+sub add_filter {
+ my ($self, $filter_class, $filter, $pos) = @_;
+
+ $self->{filters}{$filter_class} ||= [];
+ unless ($pos) {
+ push @{$self->{filters}{$filter_class}}, $filter;
+ } elsif ($pos == 1) {
+ unshift @{$self->{filters}{$filter_class}}, $filter;
+ } elsif ($pos > 1) {
+ my $length = @{$self->{filters}{$filter_class}};
+ $self->{filters}{$filter_class} =
+ [ @{$self->{filters}{$filter_class}[0 .. ($pos-2)]}, $filter,
+ @{$self->{filters}{$filter_class}[($pos-1) .. ($length-1)]} ];
+ }
+
+ return $self;
+}
+
+sub delete_filter {
+ my ($self, $filter_class, $filter) = @_;
+
+ my $pos;
+ unless (ref $filter) {
+ $pos = $filter;
+
+ return delete $self->{filters}{$filter_class}[$pos];
+ }
+
+ $self->{filters}{$filter_class} ||= [];
+ my @deleted;
+ for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
+ push @deleted, delete $self->{filters}{$filter_class}[$i]
+ if $self->{filters}{$filter_class}[$i] == $filter;
+ }
+
+ return @deleted;
+}
+
+sub replace_filter {
+ my ($self, $filter_class, $filter, @new_filters) = @_;
+
+ my @pos;
+ unless (ref $filter) {
+ $pos[0] = $filter;
+ } else {
+ $self->{filters}{$filter_class} ||= [];
+ for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
+ push @pos, $i
+ if $self->{filters}{$filter_class}[$i] == $filter;
+ }
+ }
+
+ foreach my $p (@pos) {
+ $self->delete_filter( $filter_class, $p );
+
+ foreach my $f (@new_filters) {
+ $self->add_filter( $filter_class, $f, $p++);
+ }
+ }
+
+ return $self;
+}
+
1;
__END__
=head1 SEE ALSO
+Parse::DebianChangelog::Entry, Parse::DebianChangelog::ChangesFilters
+
Description of the Debian changelog format in the Debian policy:
L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
diff --git a/t/Parse-DebianChangelog.t b/t/Parse-DebianChangelog.t
index fe1d293..a62d183 100644
--- a/t/Parse-DebianChangelog.t
+++ b/t/Parse-DebianChangelog.t
@@ -11,35 +11,83 @@ use warnings;
use File::Basename;
-use Test::More tests => 7;
-BEGIN { use_ok('Parse::DebianChangelog') };
+BEGIN {
+ my $no_examples = 2;
+ my $no_tests = $no_examples * 11 + 6;
+
+ require Test::More;
+ import Test::More tests => $no_tests, ;
+}
+BEGIN {
+ use_ok('Parse::DebianChangelog');
+ use_ok('Parse::DebianChangelog::ChangesFilters', ':all' );
+};
#########################
-foreach my $file (qw(Changes)) {
+foreach my $code (qw(DebianChangelog.pm
+ DebianChangelog/Entry.pm
+ DebianChangelog/Util.pm
+ DebianChangelog/ChangesFilters.pm)) {
+ TODO: {
+ todo_skip("Linking error I couldn't resolve yet. Can be ignored for now",
+ 1) if $code eq 'DebianChangelog.pm';
+ ok( system('podchecker', "lib/Parse/$code") == 0 );
+ }
+}
+
+foreach my $file (qw(Changes t/examples/shadow)) {
- my $changes = Parse::DebianChangelog->init( { infile => $file } );
+ my $changes = Parse::DebianChangelog->init( { infile => $file,
+ quiet => 1 } );
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' } );
+ my $html_out = $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' );
+
+ ok( ($changes->delete_filter( 'html::changes',
+ \&common_licenses ))[0]
+ == \&common_licenses );
+ ok( ! $changes->delete_filter( 'html::changes',
+ \&common_licenses ) );
- ok( !`tidy -qe t/$basename.html.tmp 2>&1`, 'Generated HTML has no tidy errors' );
+ $changes->html( { outfile => "t/$basename.html.tmp.2" } );
+ ok( !`tidy -qe t/$basename.html.tmp.2 2>&1`,
+ 'Generated HTML has no tidy errors' );
- unlink "t/$basename.html.tmp";
+ $changes->add_filter( 'html::changes',
+ \&common_licenses );
+
+ my $html_out2 = $changes->html();
+
+ # remove timestamps since they will differ
+ $html_out =~ s/Generated .*? by//go;
+ $html_out2 =~ s/Generated .*? by//go;
+
+ ok( $html_out eq $html_out2 )
+ and unlink "t/$basename.html.tmp", "t/$basename.html.tmp.2";
my $str = $changes->dpkg_str();
- ok( $str eq `dpkg-parsechangelog -l$file`, 'Output of dpkg_out equal to output of dpkg-parsechangelog' );
+ 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};
+ my @data = $changes->data;
+ ok( 1 );
+
+ my $oldest_version = $data[-1]->Version;
$str = $changes->dpkg_str({ since => $oldest_version });
- ok( $str eq `dpkg-parsechangelog -v$oldest_version -l$file`, 'Output of dpkg_out equal to output of dpkg-parsechangelog' );
+ ok( $str eq `dpkg-parsechangelog -v$oldest_version -l$file 2>&1`,
+ 'Output of dpkg_out equal to output of dpkg-parsechangelog' )
+ or diag("oldest_version=$oldest_version");
$str = $changes->rfc822_str();
@@ -48,5 +96,6 @@ foreach my $file (qw(Changes)) {
$str = $changes->rfc822_str({ since => $oldest_version });
ok( 1 );
+
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libparse-debianchangelog-perl.git
More information about the Pkg-perl-cvs-commits
mailing list