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 <fr...@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

_______________________________________________
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

Reply via email to