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