This is an automated email from the git hooks/post-receive script. intrigeri pushed a commit to tag debian_version_0_9-1 in repository libparse-debianchangelog-perl.
commit ed847d0ab8983e53a80db469b0a787ac6178e376 Author: Frank Lichtenheld <[email protected]> Date: Tue Oct 4 02:52:13 2005 +0000 Merge 0.9 to MAIN --- lib/Parse/DebianChangelog.pm | 68 ++++++++++++++++++++---- t/Parse-DebianChangelog.t | 122 ++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 171 insertions(+), 19 deletions(-) diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm index 1d4c2bb..75bba2a 100644 --- a/lib/Parse/DebianChangelog.pm +++ b/lib/Parse/DebianChangelog.pm @@ -103,7 +103,7 @@ use Parse::DebianChangelog::Util qw( :all ); use Parse::DebianChangelog::Entry; our $CLASSNAME = 'Parse::DebianChangelog'; -our $VERSION = 0.8; +our $VERSION = 0.9; =pod @@ -134,7 +134,7 @@ sub init { $self->reset_parse_errors; if ($self->{config}{infile}) { - $self->parse; + defined($self->parse) or return undef; } return $self; @@ -446,17 +446,30 @@ represent one entry of the changelog. This is currently merely a placeholder to enable users to get to the raw data, exepct changes to this API in the near future. +This method supports the common output options described in +section L<"COMMON OUTPUT OPTIONS">. + =cut sub data { - my ($self) = @_; - return @{$self->{data}} if wantarray; - return $self->{data}; + my ($self, $config) = @_; + + my $data = $self->{data}; + if ($config) { + $self->{config}{DATA} = $config if $config; + $data = $self->_data_range( $config ) or return undef; + } + return @$data if wantarray; + return $data; } sub __sanity_check_range { - my ( $data, $from, $to, $since, $until ) = @_; + my ( $data, $from, $to, $since, $until, $count ) = @_; + if ($$count && ($$from || $$since || $$to || $$until)) { + warn( "you can't combine 'count' with any other range option\n" ); + $$from = $$since = $$to = $$until = ''; + } if ($$from && $$since) { warn( "you can only specify one of 'from' and 'since'\n" ); $$from = ''; @@ -473,6 +486,12 @@ sub __sanity_check_range { warn( "'until' option specifies oldest version\n" ); $$until = ''; } + if ($$count && ($$count > $#$data)) { + $$count = $#$data+1; + } + if ($$count && ($$count < -$#$data)) { + $$count = -($#$data+1); + } #TODO: compare versions } @@ -484,15 +503,21 @@ sub _data_range { my $until = $config->{until} || ''; my $from = $config->{from} || ''; my $to = $config->{to} || ''; + my $count = $config->{count} || 0; - return $data if $config->{all}; + return [ @$data ] if $config->{all}; - __sanity_check_range( $data, \$from, \$to, \$since, \$until ); + __sanity_check_range( $data, \$from, \$to, \$since, \$until, \$count ); + $count-- if $count > 0; - unless ($from or $to or $since or $until) { + unless ($from or $to or $since or $until or $count) { + return [ @$data ] if $config->{default_all} && !$config->{count}; return [ $data->[0] ]; } + return [ @{$data}[0 .. $count] ] if $count > 0; + return [ reverse((reverse @$data)[0 .. -($count+1)]) ] if $count < 0; + my @result; my $include = 1; @@ -708,7 +733,7 @@ sub xml { $self->{config}{XML} = $config if $config; $config = $self->{config}{XML} || {}; - $config->{all} = 1 unless exists $config->{all}; + $config->{default_all} = 1 unless exists $config->{all}; my $data = $self->_data_range( $config ) or return undef; my %out_data; $out_data{Entry} = []; @@ -805,7 +830,7 @@ sub html { $self->{config}{HTML} = $config if $config; $config = $self->{config}{HTML} || {}; - $config->{all} = 1 unless exists $config->{all}; + $config->{default_all} = 1 unless exists $config->{all}; my $data = $self->_data_range( $config ) or return undef; require CGI; @@ -1039,6 +1064,7 @@ sub replace_filter { 1; __END__ + =head1 COMMON OUTPUT OPTIONS The following options are supported by all output methods, @@ -1070,6 +1096,26 @@ specified B<version> itself. =back +The following options also supported by all output methods but +don't take version numbers as values: + +=over 4 + +=item all + +If set to a true value, all entries of the changelog are returned, +this overrides all other options. While the XML and HTML formats +default to all == true, this does of course not overwrite other +options unless it is set explicetly with the call. + +=item count + +Expects a signed integer as value. Returns C<value> entries from the +top of the changelog if set to a positve integer, and C<abs(value)> +entries from the tail if set to a negative integer. + +=back + Some examples for the above options. Imagine an example changelog with entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1. diff --git a/t/Parse-DebianChangelog.t b/t/Parse-DebianChangelog.t index 04607f8..c4ac351 100644 --- a/t/Parse-DebianChangelog.t +++ b/t/Parse-DebianChangelog.t @@ -13,8 +13,8 @@ use File::Basename; use XML::Simple; BEGIN { - my $no_examples = 2; - my $no_tests = $no_examples * 13 + 7; + my $no_examples = 3; + my $no_tests = $no_examples * 13 + 35; require Test::More; import Test::More tests => $no_tests, ; @@ -37,19 +37,30 @@ foreach my $code (qw(DebianChangelog.pm } } -foreach my $file (qw(Changes t/examples/shadow)) { +my $test = Parse::DebianChangelog->init( { infile => '/nonexistant', + quiet => 1 } ); +ok( !defined($test), "fatal parse errors lead to init() returning undef"); + +foreach my $file (qw(Changes t/examples/countme t/examples/shadow)) { my $changes = Parse::DebianChangelog->init( { infile => $file, quiet => 1 } ); my $errors = $changes->get_parse_errors(); my $basename = basename( $file ); +# use Data::Dumper; +# diag(Dumper($changes)); + ok( !$errors, "Parse example changelog $file without errors" ); + my @data = $changes->data; + + ok( @data, "data is not empty" ); + my $html_out = $changes->html( { outfile => "t/$basename.html.tmp", template => "tmpl/default.tmpl" } ); - ok( !`tidy -qe t/$basename.html.tmp 2>&1`, + is( `tidy -qe t/$basename.html.tmp 2>&1`, '', 'Generated HTML has no tidy errors' ); ok( ($changes->delete_filter( 'html::changes', @@ -60,7 +71,7 @@ foreach my $file (qw(Changes t/examples/shadow)) { $changes->html( { outfile => "t/$basename.html.tmp.2", template => "tmpl/default.tmpl" } ); - ok( !`tidy -qe t/$basename.html.tmp.2 2>&1`, + is( `tidy -qe t/$basename.html.tmp.2 2>&1`, '', 'Generated HTML has no tidy errors' ); $changes->add_filter( 'html::changes', @@ -80,9 +91,104 @@ foreach my $file (qw(Changes t/examples/shadow)) { is( $str, `dpkg-parsechangelog -l$file`, 'Output of dpkg_str equal to output of dpkg-parsechangelog' ); - my @data = $changes->data; - - ok( 1 ); + if ($file eq 't/examples/countme') { + # test range options + use Data::Dumper; + cmp_ok( @data, '==', 7, "no options -> count" ); + my $all_versions = join( '/', map { $_->Version } @data); + + # positve count + my @cnt = $changes->data( { count => 3 } ); + cmp_ok( @cnt, '==', 3, "count => 3 -> count" ) or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2', "count => 3 -> versions" ); + + # negative count + @cnt = $changes->data( { count => -3 } ); + cmp_ok( @cnt, '==', 3, "count => -3 -> count" ) or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1', + "count => -3 -> versions" ); + + # count => 1 + @cnt = $changes->data( { count => 1 } ); + cmp_ok( @cnt, '==', 1, "count => 1 -> count" ) or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '2:2.0-1', "count => 1 -> versions" ); + + # count => 1 with default_all => 1 + @cnt = $changes->data( { count => 1, default_all => 1 } ); + cmp_ok( @cnt, '==', 1, "count => 1 (d_a)-> count" ) + or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '2:2.0-1', "count => 1 (d_a) -> versions" ); + + # count => -1 + @cnt = $changes->data( { count => -1 } ); + cmp_ok( @cnt, '==', 1, "count => -1 -> count" ) or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '1.5-1', + "count => -1 -> versions" ); + + # count => 7 + @cnt = $changes->data( { count => 7 } ); + cmp_ok( @cnt, '==', 7, "count => 7 -> count" ) or diag(Dumper(\@cnt)); + is_deeply( \@cnt, \@data, "count => 7 returns all" ); + + # count => -7 + @cnt = $changes->data( { count => -7 } ); + cmp_ok( @cnt, '==', 7, "count => -7 -> count" ) or diag(Dumper(\@cnt)); + is_deeply( \@cnt, \@data, "count => -7 returns all" ); + + # count => 100 + @cnt = $changes->data( { count => 100 } ); + cmp_ok( @cnt, '==', 7, "count => 100 -> count" ) + or diag(Dumper(\@cnt)); + is_deeply( \@cnt, \@data, "count => 100 returns all" ); + + # count => -100 + @cnt = $changes->data( { count => -100 } ); + cmp_ok( @cnt, '==', 7, "count => -100 -> count" ) + or diag(Dumper(\@cnt)); + is_deeply( \@cnt, \@data, "count => -100 returns all" ); + + # from + @cnt = $changes->data( { from => '1:2.0~rc2-1sarge3' } ); + cmp_ok( @cnt, '==', 4, + "from => '1:2.0~rc2-1sarge3' -> count" ) + or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2/1:2.0~rc2-1sarge3', + "from => '1:2.0~rc2-1sarge3' -> versions" ); + + # since + @cnt = $changes->data( { since => '1:2.0~rc2-1sarge3' } ); + cmp_ok( @cnt, '==', 3, + "since => '1:2.0~rc2-1sarge3' -> count" ) or + diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '2:2.0-1/1:2.0~rc2-3/1:2.0~rc2-2', + "since => '1:2.0~rc2-1sarge3' -> versions" ); + + # to + @cnt = $changes->data( { to => '1:2.0~rc2-1sarge2' } ); + cmp_ok( @cnt, '==', 3, + "to => '1:2.0~rc2-1sarge2' -> count" ) or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '1:2.0~rc2-1sarge2/1:2.0~rc2-1sarge1/1.5-1', + "to => '1:2.0~rc2-1sarge2' -> versions" ); + + # until + @cnt = $changes->data( { until => '1:2.0~rc2-1sarge2' } ); + cmp_ok( @cnt, '==', 2, + "until => '1:2.0~rc2-1sarge2' -> count" ) + or diag(Dumper(\@cnt)); + is( join( "/", map { $_->Version } @cnt), + '1:2.0~rc2-1sarge1/1.5-1', + "until => '1:2.0~rc2-1sarge2' -> versions" ); + + #TODO: test combinations + } if ($file eq 'Changes') { my $v = $data[0]->Version; -- 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 [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
