[libparse-debianchangelog-perl] 02/03: Merge 0.9 to MAIN
Intrigeri
intrigeri at moszumanska.debian.org
Sun May 24 12:37:55 UTC 2015
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 <frank at lichtenheld.de>
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
More information about the Pkg-perl-cvs-commits
mailing list