r10841 - in /trunk/libpod-coverage-perl: Changes META.yml Makefile.PL README debian/changelog lib/Pod/Coverage.pm

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Wed Dec 5 19:12:59 UTC 2007


Author: gregoa-guest
Date: Wed Dec  5 19:12:59 2007
New Revision: 10841

URL: http://svn.debian.org/wsvn/?sc=1&rev=10841
Log:
New upstream release.

Modified:
    trunk/libpod-coverage-perl/Changes
    trunk/libpod-coverage-perl/META.yml
    trunk/libpod-coverage-perl/Makefile.PL
    trunk/libpod-coverage-perl/README
    trunk/libpod-coverage-perl/debian/changelog
    trunk/libpod-coverage-perl/lib/Pod/Coverage.pm

Modified: trunk/libpod-coverage-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/Changes?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/Changes (original)
+++ trunk/libpod-coverage-perl/Changes Wed Dec  5 19:12:59 2007
@@ -1,3 +1,9 @@
+0.19	Thursday 13th September, 2007
+	Don't use _CvGV to determine if a sub was imported, there's a handy
+	flag - GVf_IMPORTED_CV.  Fixes 5.9.5 and future perls
+	(solution by Nicholas Clark)
+
+
 0.18    Friday 4th August, 2006
 	Rewrite _CvGV in terms of B::CV - no xs dependency anymore
 	(suggested by Tim Bunce)

Modified: trunk/libpod-coverage-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/META.yml?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/META.yml (original)
+++ trunk/libpod-coverage-perl/META.yml Wed Dec  5 19:12:59 2007
@@ -1,9 +1,14 @@
 ---
 name: Pod-Coverage
-version: 0.18
-author: ~
+version: 0.19
+author:
+  - 'Richard Clamp <richardc at unixbeard.net>'
+  - 'Michael Stevens <mstevens at etla.org>'
+  - 'some contributions from David Cantrell <david at cantrell.org.uk>'
 abstract: Checks if the documentation of a module is comprehensive
 license: perl
+resources:
+  license: http://dev.perl.org/licenses/
 requires:
   Devel::Symdump: 2.01
   Pod::Find: 0.21
@@ -13,14 +18,16 @@
 provides:
   Pod::Coverage:
     file: lib/Pod/Coverage.pm
-    version: 0.18
+    version: 0.19
   Pod::Coverage::CountParents:
     file: lib/Pod/Coverage/CountParents.pm
   Pod::Coverage::ExportOnly:
     file: lib/Pod/Coverage/ExportOnly.pm
   Pod::Coverage::Extractor:
     file: lib/Pod/Coverage.pm
-    version: 0.18
   Pod::Coverage::Overloader:
     file: lib/Pod/Coverage/Overloader.pm
-generated_by: Module::Build version 0.25
+generated_by: Module::Build version 0.2808
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.2.html
+  version: 1.2

Modified: trunk/libpod-coverage-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/Makefile.PL?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/Makefile.PL (original)
+++ trunk/libpod-coverage-perl/Makefile.PL Wed Dec  5 19:12:59 2007
@@ -2,18 +2,18 @@
 use ExtUtils::MakeMaker;
 WriteMakefile
 (
+          'PL_FILES' => {},
+          'INSTALLDIRS' => 'site',
           'NAME' => 'Pod::Coverage',
-          'VERSION_FROM' => 'lib/Pod/Coverage.pm',
-          'PREREQ_PM' => {
-                           'Devel::Symdump' => '2.01',
-                           'Pod::Find' => '0.21',
-                           'Pod::Parser' => '1.13',
-                           'Test::More' => '0'
-                         },
-          'INSTALLDIRS' => 'site',
           'EXE_FILES' => [
                            'bin/pod_cover'
                          ],
-          'PL_FILES' => {}
+          'VERSION_FROM' => 'lib/Pod/Coverage.pm',
+          'PREREQ_PM' => {
+                           'Test::More' => 0,
+                           'Pod::Parser' => '1.13',
+                           'Devel::Symdump' => '2.01',
+                           'Pod::Find' => '0.21'
+                         }
         )
 ;

Modified: trunk/libpod-coverage-perl/README
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/README?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/README (original)
+++ trunk/libpod-coverage-perl/README Wed Dec  5 19:12:59 2007
@@ -1,4 +1,4 @@
-README for Pod::Coverage 0.18
+README for Pod::Coverage 0.19
 
 =head1 NAME
 
@@ -42,6 +42,14 @@
 
 =over
 
+=item 0.19	Thursday 13th September, 2007
+
+	Don't use _CvGV to determine if a sub was imported, there's a handy
+	flag - GVf_IMPORTED_CV.  Fixes 5.9.5 and future perls
+	(solution by Nicholas Clark)
+
+
+
 =item 0.18    Friday 4th August, 2006
 
 	Rewrite _CvGV in terms of B::CV - no xs dependency anymore
@@ -65,14 +73,6 @@
     	=head2 $self->foo(); was intepreted as documentation for a
         C<foo()> method.  (more XS4ALL house style)
 
-
-=item 0.16	Wednesday 20th October, 2004
-
-	Fixed a MANIFEST bug.
-	Fixed a case reported by Jos Boumans where
-    	=head2 $self->foo; was intepreted as documentation for a
-        C<foo;> method.  (XS4ALL house style)
-	
 =back
 
 =head1 SEE ALSO
@@ -89,7 +89,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (c) 2001, 2003, 2004, 2006 Richard Clamp, Michael
+Copyright (c) 2001, 2003, 2004, 2006, 2007 Richard Clamp, Michael
 Stevens. All rights reserved.  This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl itself.
 

Modified: trunk/libpod-coverage-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/debian/changelog?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/debian/changelog (original)
+++ trunk/libpod-coverage-perl/debian/changelog Wed Dec  5 19:12:59 2007
@@ -1,5 +1,6 @@
-libpod-coverage-perl (0.18-2) UNRELEASED; urgency=low
+libpod-coverage-perl (0.19-1) UNRELEASED; urgency=low
 
+  * New upstream release.
   * debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
     field (source stanza); Homepage field (source stanza).
   * Set Maintainer to Debian Perl Group.

Modified: trunk/libpod-coverage-perl/lib/Pod/Coverage.pm
URL: http://svn.debian.org/wsvn/trunk/libpod-coverage-perl/lib/Pod/Coverage.pm?rev=10841&op=diff
==============================================================================
--- trunk/libpod-coverage-perl/lib/Pod/Coverage.pm (original)
+++ trunk/libpod-coverage-perl/lib/Pod/Coverage.pm Wed Dec  5 19:12:59 2007
@@ -5,10 +5,10 @@
 use B;
 use Pod::Find qw(pod_where);
 
-BEGIN { defined &TRACE_ALL or eval 'sub TRACE_ALL () { 0 }' };
+BEGIN { defined &TRACE_ALL or eval 'sub TRACE_ALL () { 0 }' }
 
 use vars qw/ $VERSION /;
-$VERSION = '0.18';
+$VERSION = '0.19';
 
 =head1 NAME
 
@@ -123,12 +123,17 @@
         qr/^( MODIFY | FETCH )_( REF | SCALAR | ARRAY | HASH | CODE |
                                  GLOB | FORMAT | IO)_ATTRIBUTES $/x,
         qr/^CLONE(_SKIP)?$/,
-       ];
+    ];
     push @$private, @{ $args{also_private} || [] };
-    my $trustme = $args{trustme} || [];
+    my $trustme       = $args{trustme}       || [];
     my $nonwhitespace = $args{nonwhitespace} || undef;
 
-    my $self = bless { @_, private => $private, trustme => $trustme, nonwhitespace => $nonwhitespace }, $class;
+    my $self = bless {
+        @_,
+        private       => $private,
+        trustme       => $trustme,
+        nonwhitespace => $nonwhitespace
+    }, $class;
 }
 
 =item $object->coverage
@@ -137,22 +142,21 @@
 
 =cut
 
-
 sub coverage {
     my $self = shift;
 
     my $package = $self->{package};
-    my $pods = $self->_get_pods;
+    my $pods    = $self->_get_pods;
     return unless $pods;
 
     my %symbols = map { $_ => 0 } $self->_get_syms($package);
 
     print "tying shoelaces\n" if TRACE_ALL;
-    for my $pod ( @$pods ) {
+    for my $pod (@$pods) {
         $symbols{$pod} = 1 if exists $symbols{$pod};
     }
 
-    foreach my $sym (keys %symbols) {
+    foreach my $sym ( keys %symbols ) {
         $symbols{$sym} = 1 if $self->_trustme_check($sym);
     }
 
@@ -164,8 +168,8 @@
         print Data::Dumper::Dumper($self);
     }
 
-    my $symbols    = scalar keys %symbols;
-    my $documented = scalar grep { $_ } values %symbols;
+    my $symbols = scalar keys %symbols;
+    my $documented = scalar grep {$_} values %symbols;
     unless ($symbols) {
         $self->{why_unrated} = "no public symbols defined";
         return;
@@ -183,9 +187,8 @@
 
 sub why_unrated {
     my $self = shift;
-    $self->{why_unrated}
-}
-
+    $self->{why_unrated};
+}
 
 =item $object->naked/$object->uncovered
 
@@ -226,19 +229,19 @@
     return unless @_;
 
     # one argument - just a package
-    scalar @_ == 1  and  unshift @_, 'package';
+    scalar @_ == 1 and unshift @_, 'package';
 
     # we were called with arguments
     my $pc     = $self->new(@_);
     my $rating = $pc->coverage;
-    $rating = 'unrated ('. $pc->why_unrated .')'
-      unless defined $rating;
+    $rating = 'unrated (' . $pc->why_unrated . ')'
+        unless defined $rating;
     print $pc->{package}, " has a $self rating of $rating\n";
     my @looky_here = $pc->naked;
     if ( @looky_here > 1 ) {
-        print "The following are uncovered: ", join(", ", sort @looky_here), "\n";
-    }
-    elsif (@looky_here) {
+        print "The following are uncovered: ", join( ", ", sort @looky_here ),
+            "\n";
+    } elsif (@looky_here) {
         print "'$looky_here[0]' is uncovered\n";
     }
 }
@@ -306,10 +309,14 @@
 
     my @symbols;
     for my $sym ( $syms->functions ) {
+
         # see if said method wasn't just imported from elsewhere
-        my $owner = $self->_CvGV( \&{ $sym } );
-        $owner =~ s/^\*(.*)::.*?$/$1/;
-        next if $owner ne $self->{package};
+        my $glob = do { no strict 'refs'; \*{$sym} };
+        my $o = B::svref_2object($glob);
+
+        # in 5.005 this flag is not exposed via B, though it exists
+        my $imported_cv = eval { B::GVf_IMPORTED_CV() } || 0x80;
+        next if $o->GvFLAGS & $imported_cv;
 
         # check if it's on the whitelist
         $sym =~ s/$self->{package}:://;
@@ -350,7 +357,6 @@
     return $pod->{identifiers} || [];
 }
 
-
 =item _private_check($symbol)
 
 return true if the symbol should be considered private
@@ -359,7 +365,7 @@
 
 sub _private_check {
     my $self = shift;
-    my $sym = shift;
+    my $sym  = shift;
     return grep { $sym =~ /$_/ } @{ $self->{private} };
 }
 
@@ -370,14 +376,15 @@
 =cut
 
 sub _trustme_check {
-    my($self, $sym) = @_;
+    my ( $self, $sym ) = @_;
     return grep { $sym =~ /$_/ } @{ $self->{trustme} };
 }
 
 sub _CvGV {
     my $self = shift;
-    my $cv = shift;
-    my $b_cv = B::svref_2object( $cv );
+    my $cv   = shift;
+    my $b_cv = B::svref_2object($cv);
+
     # perl 5.6.2's B doesn't have an object_2svref.  in 5.8 you can
     # just do this:
     # return *{ $b_cv->GV->object_2svref };
@@ -386,46 +393,52 @@
     return *{ $b_cv->GV->STASH->NAME . "::" . $b_cv->GV->NAME };
 }
 
-
 package Pod::Coverage::Extractor;
 use Pod::Parser;
 use base 'Pod::Parser';
 
 use constant debug => 0;
+
 # extract subnames from a pod stream
 sub command {
     my $self = shift;
-    my ($command, $text, $line_num) = @_;
-    if ($command eq 'item' || $command =~ /^head(?:2|3|4)/) {
+    my ( $command, $text, $line_num ) = @_;
+    if ( $command eq 'item' || $command =~ /^head(?:2|3|4)/ ) {
+
         # take a closer look
-        my @pods = ($text =~ /\s*([^\s\|,\/]+)/g);
+        my @pods = ( $text =~ /\s*([^\s\|,\/]+)/g );
         $self->{recent} = [];
 
         foreach my $pod (@pods) {
             print "Considering: '$pod'\n" if debug;
 
             # it's dressed up like a method cal
-            $pod =~ /-E<\s*gt\s*>(.*)/  and $pod = $1;
-            $pod =~ /->(.*)/            and $pod = $1;
+            $pod =~ /-E<\s*gt\s*>(.*)/ and $pod = $1;
+            $pod =~ /->(.*)/           and $pod = $1;
+
             # it's used as a (bare) fully qualified name
             $pod =~ /\w+(?:::\w+)*::(\w+)/ and $pod = $1;
+
             # it's wrapped in a pod style B<>
             $pod =~ s/[A-Z]<//g;
             $pod =~ s/>//g;
+
             # has arguments, or a semicolon
-            $pod =~ /(\w+)\s*[;\(]/   and $pod = $1;
+            $pod =~ /(\w+)\s*[;\(]/ and $pod = $1;
 
             print "Adding: '$pod'\n" if debug;
-            push @{$self->{$self->{nonwhitespace} ? "recent" : "identifiers"}}, $pod;
+            push @{ $self->{ $self->{nonwhitespace}
+                    ? "recent"
+                    : "identifiers" } }, $pod;
         }
     }
 }
 
 sub textblock {
     my $self = shift;
-    my ($text, $line_num) = shift;
-    if ($self->{nonwhitespace} and $text =~ /\S/ and $self->{recent}) {
-        push @{$self->{identifiers}}, @{$self->{recent}};
+    my ( $text, $line_num ) = shift;
+    if ( $self->{nonwhitespace} and $text =~ /\S/ and $self->{recent} ) {
+        push @{ $self->{identifiers} }, @{ $self->{recent} };
         $self->{recent} = [];
     }
 }
@@ -466,7 +479,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (c) 2001, 2003, 2004, 2006 Richard Clamp, Michael
+Copyright (c) 2001, 2003, 2004, 2006, 2007 Richard Clamp, Michael
 Stevens. All rights reserved.  This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl itself.
 




More information about the Pkg-perl-cvs-commits mailing list