Pod-Coverage-0.23/0002755000175000017500000000000012140212363014025 5ustar richardcrichardcPod-Coverage-0.23/t/0002755000175000017500000000000012140212363014270 5ustar richardcrichardcPod-Coverage-0.23/t/03import.t0000644000175000017500000000205011423555254016141 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use lib 't/lib'; use Test::More tests => 3; is( capture(q{ use Pod::Coverage package => 'Simple2'; }), "Simple2 has a Pod::Coverage rating of 0.75\n'naked' is uncovered", "Simple2 works correctly in import form"); is( capture(q{ use Pod::Coverage package => 'Simple7' }), "Simple7 has a Pod::Coverage rating of 0\nThe following are uncovered: bar, foo", 'Simple7 import form'); is( capture(q{ use Pod::Coverage 'Simple7' }), "Simple7 has a Pod::Coverage rating of 0\nThe following are uncovered: bar, foo", 'Simple7 import form, implicit package'); sub capture { my $code = shift; open(FH, ">test.out") or die "Couldn't open test.out for writing: $!"; open(OLDOUT, ">&STDOUT"); select(select(OLDOUT)); open(STDOUT, ">&FH"); eval $code; close STDOUT; close FH; open(STDOUT, ">&OLDOUT"); open(FH, "; } chomp $result; close FH; unlink('test.out'); return $result; } Pod-Coverage-0.23/t/04cvgv.t0000644000175000017500000000065711423555254015610 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use Test::More tests => 4; use Pod::Coverage (); my $pc = Pod::Coverage->new(); isa_ok( $pc, 'Pod::Coverage' ); package wibble; sub bar {}; package main; sub foo {} sub baz::baz {}; *bar = \&wibble::bar; *baz = \&baz::baz; is ( $pc->_CvGV(\&foo), '*main::foo', 'foo checks out' ); is ( $pc->_CvGV(\&bar), '*wibble::bar', 'bar looks right' ); is ( $pc->_CvGV(\&baz), '*baz::baz', 'baz too' ); Pod-Coverage-0.23/t/lib/0002755000175000017500000000000012140212363015036 5ustar richardcrichardcPod-Coverage-0.23/t/lib/Trustme.pm0000644000175000017500000000074511423555254017057 0ustar richardcrichardcpackage Trustme; # test module - four subs, one with embedded pod item, one with a head2, one # with a method call, one with nowt sub foo {} sub bar {} sub baz {} sub naked {} sub private {} sub trustme {} sub trust_me {} 1; __END__ =head2 METHODS =over 4 =item foo foo does foo to things =item bar bar does bar to things =item baz baz does baz to things =back This paragraph should be considered to be the docs for any method containing the letter u in its name. =cut Pod-Coverage-0.23/t/lib/Earle.pm0000644000175000017500000000026111423555254016435 0ustar richardcrichardcpackage Earle; =head1 NAME Earle - ape Earle's odd layout stuff. =head2 C These subs are useful if you need example subs =cut sub foo {} sub bar {} 1; Pod-Coverage-0.23/t/lib/Args.pm0000644000175000017500000000030611423555254016301 0ustar richardcrichardcpackage Args; sub foo {} 1; __END__ # test module - one sub, documented with a head2 with sample arguments =head2 foo($bar, @baz) foo takes a bar and the rest of the stuff is an array of bazen Pod-Coverage-0.23/t/lib/Tie.pm0000644000175000017500000000210611423555254016126 0ustar richardcrichardcpackage Tie; =head1 NAME Tie - stubs to make sure that TIE* and friends are skipped =head1 METHODS =item foo blah blah =cut sub foo { print "I like pie\n"; } sub TIESCALAR { print "foo"; } sub TIEARRAY { print "foo"; } sub TIEHASH { print "foo"; } sub TIEHANDLE { print "foo"; } sub FETCH { print "foo"; } sub STORE { print "foo"; } sub UNTIE { print "foo"; } sub FETCHSIZE { print "foo"; } sub STORESIZE { print "foo"; } sub POP { print "foo"; } sub PUSH { print "foo"; } sub SHIFT { print "foo"; } sub UNSHIFT { print "foo"; } sub SPLICE { print "foo"; } sub DELETE { print "foo"; } sub EXISTS { print "foo"; } sub EXTEND { print "foo"; } sub CLEAR { print "foo"; } sub FIRSTKEY { print "foo"; } sub NEXTKEY { print "foo"; } sub PRINT { print "foo"; } sub PRINTF { print "foo"; } sub WRITE { print "foo"; } sub READLINE { print "foo"; } sub GETC { print "foo"; } sub READ { print "foo"; } sub CLOSE { print "foo"; } sub BINMODE { print "foo"; } sub OPEN { print "foo"; } sub EOF { print "foo"; } sub FILENO { print "foo"; } sub SEEK { print "foo"; } sub TELL { print "foo"; } 1; Pod-Coverage-0.23/t/lib/Simple1.pm0000644000175000017500000000035411423555254016722 0ustar richardcrichardcpackage Simple1; sub foo {} sub bar {} sub baz {} 1; __END__ # test module - three subs, one without, one with an item, one with a head2 =head2 Methods =over =item foo this is foo =back =head2 baz baz is very important =cut Pod-Coverage-0.23/t/lib/XS4ALL.pm0000644000175000017500000000045711423555254016363 0ustar richardcrichardcpackage XS4ALL; # some failing elements of XS4ALL's house style =head2 $self->classes; something somthing =cut sub classes {} =head2 $level = $mmdb->transaction_level; rhubarb rhubarb =cut sub transaction_level {} =head2 $self->frobnicate(); mushrooms mushrooms =cut sub frobnicate {} 1; Pod-Coverage-0.23/t/lib/GrandParent.pm0000644000175000017500000000015311423555254017612 0ustar richardcrichardcpackage GrandParent; sub dummy {}; 1; __END__ =head1 NAME GrandParent =head2 grandparent_method =cut Pod-Coverage-0.23/t/lib/Empty.pm0000644000175000017500000000025011423555254016501 0ustar richardcrichardcpackage Empty; sub foo {} sub bar {} 1; __END__ # test module - two subs, one with docs, one with empty pod section =head2 foo =head2 bar bar does things! =cut Pod-Coverage-0.23/t/lib/Child.pm0000644000175000017500000000011311423555254016424 0ustar richardcrichardcpackage Child; use Parent (); use base 'Parent'; sub foo { } 1; __END__ Pod-Coverage-0.23/t/lib/Simple2.pm0000644000175000017500000000044111423555254016720 0ustar richardcrichardcpackage Simple2; # test module - four subs, one with embedded pod item, one with a head2, one # with a method call, one with nowt sub foo {} sub baz {} sub qux {} sub naked {} 1; __END__ =head2 Methods =over =item foo this is foo =item $object->baz() =item B =back =cut Pod-Coverage-0.23/t/lib/Simple8.pm0000644000175000017500000000004612140211606016712 0ustar richardcrichardcpackage Simple8; 1; =item docs =cut Pod-Coverage-0.23/t/lib/Parent.pm0000644000175000017500000000026511423555254016642 0ustar richardcrichardcpackage Parent; use GrandParent (); use base 'GrandParent'; sub dummy {}; 1; __END__ =head1 NAME Parent demo class =head2 foo you must implement this in a derived class =cut Pod-Coverage-0.23/t/lib/Simple7.pm0000644000175000017500000000014711423555254016730 0ustar richardcrichardcpackage Simple7; =head1 NAME Simple7 - two, both uncovered =cut sub foo {} sub bar {} 1; __END__ Pod-Coverage-0.23/t/lib/Fully/0002755000175000017500000000000012140212363016131 5ustar richardcrichardcPod-Coverage-0.23/t/lib/Fully/Qualified.pm0000644000175000017500000000114711423555254020407 0ustar richardcrichardcpackage Fully::Qualified; use strict; use warnings; use vars qw( $VERSION @EXPORT_OK ); $VERSION=0.001; use base 'Exporter'; @EXPORT_OK = qw( &ex_sub2 ); =head1 NAME Fully::Qualified - Test for Pod::Coverage =head1 SYNOPSIS none =head1 DESCRIPTION This package is to see that L sees fully qualified subnames as documented. (Not all the world is OO) =over 4 =item C Okay, it is API; but not exported =cut sub api_sub1 { "in api_sub1" } =item Fully::Qualified::ex_sub2 This sub can be exported. =cut sub ex_sub2 { "in ex_sub2" } =back =cut 1; Pod-Coverage-0.23/t/lib/Simple4.pod0000644000175000017500000000007511423555254017073 0ustar richardcrichardc=head1 NAME Simple4 - ya test =over =item foo () =back Pod-Coverage-0.23/t/lib/Simple4.pm0000644000175000017500000000011011423555254016713 0ustar richardcrichardc# a package with external .pod package Simple4; sub foo {} 1; __END__ Pod-Coverage-0.23/t/lib/Simple3.pm0000644000175000017500000000026611423555254016726 0ustar richardcrichardcpackage Simple3; sub h3 {} sub has_parens {} 1; __END__ # test module - all covered, just make sure that we catch them properly =head3 h3 =head2 has_parens (stuff, here) =cut Pod-Coverage-0.23/t/lib/Simple9.pm0000644000175000017500000000006612140210302016705 0ustar richardcrichardcpackage Simple9; use Foo::Invalid; =item docs =cut Pod-Coverage-0.23/t/lib/Simple6.pm0000644000175000017500000000042711423555254016730 0ustar richardcrichardc# an exporter - 3 subs, 1 documented, 2 exportable package Simple6; use strict; require Exporter; use base 'Exporter'; use vars qw/@EXPORT @EXPORT_OK/; @EXPORT = qw(foo); @EXPORT_OK = qw(foo bar); sub foo {} sub bar {} sub baz {}; 1; __END__ =item bar this is bar =cut Pod-Coverage-0.23/t/lib/Sibling.pm0000644000175000017500000000013311423555254016772 0ustar richardcrichardcpackage Sibling; use Parent (); use base 'Parent'; sub grandparent_method { } 1; __END__ Pod-Coverage-0.23/t/lib/Simple5.pm0000644000175000017500000000016011423555254016721 0ustar richardcrichardcpackage Simple5; =head1 NAME =item get_foo set_foo frob foo =cut sub get_foo {} sub set_foo {} 1; __END__ Pod-Coverage-0.23/t/08tie.t0000644000175000017500000000045011423555254015417 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use Test::More tests => 4; use lib 't/lib'; BEGIN { use_ok( 'Pod::Coverage' ); use_ok( 'Pod::Coverage::ExportOnly' ); } my $obj = new Pod::Coverage package => 'Tie'; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 1, "yay, skipped TIE* and friends"); Pod-Coverage-0.23/t/05parentage.t0000644000175000017500000000067711423555254016614 0ustar richardcrichardc#!perl -w use strict; use lib 't/lib'; use Test::More tests => 5; BEGIN { use_ok( 'Pod::Coverage::CountParents' ); } my $pc = Pod::Coverage::CountParents->new(package => 'Child'); isa_ok( $pc, 'Pod::Coverage::CountParents' ); is( $pc->coverage, 1, 'picked up parent docs' ); $pc = Pod::Coverage::CountParents->new(package => 'Sibling'); isa_ok( $pc, 'Pod::Coverage::CountParents' ); is( $pc->coverage, 1, 'picked up grandparent docs' ); Pod-Coverage-0.23/t/06trustme.t0000644000175000017500000000155011423555254016341 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use Test::More tests => 10; use lib 't/lib'; BEGIN { use_ok( 'Pod::Coverage' ); use_ok( 'Pod::Coverage::ExportOnly' ); } my $obj = new Pod::Coverage package => 'Trustme'; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 3/7, "without private or trustme it gets it right"); $obj = new Pod::Coverage package => 'Trustme', private => [qr/^private$/]; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 3/6, "with just private it gets it right"); $obj = new Pod::Coverage package => 'Trustme', private => [qr/^private$/], trustme => [qr/u/]; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 5/6, "with private and trustme it gets it right"); $obj = new Pod::Coverage package => 'Trustme', trustme => [qr/u/]; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 5/7, "with just trustme it gets it right"); Pod-Coverage-0.23/t/09whitespace.t0000644000175000017500000000042111423555254016771 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use Test::More tests => 3; use lib 't/lib'; BEGIN { use_ok( 'Pod::Coverage' ); } my $obj = new Pod::Coverage package => 'Empty', nonwhitespace => 1; isa_ok( $obj, 'Pod::Coverage' ); is($obj->coverage, 0.5, "Noticed empty pod section"); Pod-Coverage-0.23/t/01compile.t0000644000175000017500000000027211423555254016261 0ustar richardcrichardc#!/usr/bin/perl -w use Test::More tests => 4; use_ok('Pod::Coverage'); use_ok('Pod::Coverage::ExportOnly'); use_ok('Pod::Coverage::Overloader'); use_ok('Pod::Coverage::CountParents'); Pod-Coverage-0.23/t/02simple.t0000644000175000017500000000522312140210337016107 0ustar richardcrichardc#!/usr/bin/perl -w use strict; use Test::More tests => 36; use lib 't/lib'; BEGIN { use_ok( 'Pod::Coverage' ); use_ok( 'Pod::Coverage::ExportOnly' ); } my $obj = new Pod::Coverage package => 'Simple1'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 2/3, "Simple1 has 2/3rds coverage"); $obj = new Pod::Coverage package => 'Simple2'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 0.75, "Simple2 has 75% coverage"); ok( eq_array([ $obj->naked ], [ 'naked' ]), "naked isn't covered"); ok( eq_array([ $obj->naked ], [ $obj->uncovered ]), "naked is uncovered"); $obj = new Pod::Coverage package => 'Simple2', private => [ 'naked' ]; isa_ok( $obj, 'Pod::Coverage' ); is ( $obj->coverage, 1, "nakedness is a private thing" ); $obj = new Pod::Coverage package => 'Simple1', also_private => [ 'bar' ]; isa_ok( $obj, 'Pod::Coverage' ); is ( $obj->coverage, 1, "it's also a private bar" ); ok( eq_array([ sort $obj->covered ], [ 'baz', 'foo' ]), "those guys are covered" ); $obj = new Pod::Coverage package => 'Pod::Coverage'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1, "Pod::Coverage is covered" ); $obj = new Pod::Coverage package => 'Simple3'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1, 'Simple3 is covered' ); $obj = new Pod::Coverage package => 'Simple4'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1, "External .pod grokked" ); $obj = new Pod::Coverage package => 'Simple5'; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1, "Multiple docs per item works" ); $obj = new Pod::Coverage package => "Simple6"; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1/3, "Simple6 is 2/3rds with no extra effort" ); $obj = new Pod::Coverage::ExportOnly package => "Simple6"; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, 1/2, "Simple6 is 50% if you only check exports" ); $obj = new Pod::Coverage package => "Simple8"; isa_ok( $obj, 'Pod::Coverage' ); is( $obj->coverage, undef, "can't deduce for Simple8" ); is( $obj->why_unrated, 'no public symbols defined', 'why is correct' ); $obj = Pod::Coverage->new(package => 'Simple9'); isa_ok($obj, 'Pod::Coverage'); is($obj->coverage, undef, 'Simple9 has no coverage'); is($obj->why_unrated, "requiring 'Simple9' failed", 'why is correct'); $obj = Pod::Coverage->new( package => 'Earle' ); is( $obj->coverage, 1, "earle is covered" ); is( scalar $obj->covered, 2 ); $obj = Pod::Coverage->new( package => 'Args' ); is( $obj->coverage, 1, "Args is covered" ); $obj = Pod::Coverage->new( package => 'XS4ALL' ); is( $obj->coverage, 1, "XS4ALL is covered" ); $obj = Pod::Coverage->new( package => 'Fully::Qualified' ); is( $obj->coverage, 1, "Fully::Qualified is covered" ); Pod-Coverage-0.23/t/07pod.t0000644000175000017500000000020111423555254015411 0ustar richardcrichardcuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Pod-Coverage-0.23/Changes0000644000175000017500000001237312140212112015314 0ustar richardcrichardc0.23 Wednesday 1st May, 2013 Distinguish 'package didn't compile' from 'package has no symbols' (Gareth Tunley) 0.22 Tuesday 7th February, 2012 POD spelling corrections. (rt #22113) Add "unimport" to the stoplist. (rt #33914) 0.21 Tuesday 27th July, 2010 Add SCALAR to the stoplist (implementaion method for tied hashes). Report by David Cantrell. 0.20 Thursday 19th February, 2009 Fix t/lib/Fully/Qualified.pm to have a 1; (Zefram) Ship t/09whitespace.t - had missed it before 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) Add the (FETCH|MODIFY)_$foo_ATTRIBUTES methods to the private stoplists. (rt #12451) Support documentation where the method name is documented in a ::qualified style (rt #14635) Ignores new (5.8) magic CLONE and CLONE_SKIP methods. (rt #17489) Added a nonwhitespace option (Alex - rt #14950) 0.17 Tuesday 23rd November, 2004 Fixed a further case reported by Jos Boumans where =head2 $self->foo(); was intepreted as documentation for a C method. (more XS4ALL house style) 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 method. (XS4ALL house style) 0.15 Tuesday 19th October, 2004 Correctly ignores tie subroutines (David Cantrell) 0.14 Sunday 9th May, 2004 Small fix from Andy Lester for when people entity escape the greater than in the method call arrow. 0.13 Monday 29th December, 2003 Fixed a case reported by Earle Martin, where =head2 C wasn't working correctly Pod and Test fixes by Andy Lester Now we install the pod_cover command line utility. 0.12 Tuesday 30th September, 2003 Added 'trustme' so that you don't have to lie about subs being private when the module fails to find their docs. Work by David Cantrell. Pulled HISTORY out into a Changes file. Deprecated and gutted Pod::Coverage::Overloader. The ignored patterns in the base class now include qr/^\(/ which is all it really did only in a stupidly complex manner. 0.11 2002-02-27 Sort the uncovered subs reported from the import form. From a bug report from Tels. 0.10 2002-02-18 Added Pod::Coverage::CountParents which counts the Pod sections from higher in the inheritance tree (it walks @ISA). Refactored C<_get_pods> into its own method to allow this. 0.09 2001-12-17 Fixed a typo in mstevens' name (oopsie) Added C based on an email exchange. Modified the import form so that if given one argument it's assumed to be the package. From a suggestion by Mark Fowler. Changed tracing to use optimisable constants. Added why_unrated. 0.08 2001-11-14 Paul Johnson beat me to making Pod::Coverage a Devel::Cover plugin, so that's one less thing in the TODO section. Ran the code through perltidy, made some of the changes it suggested. Worked over the parsing of the also_private flag to give it more consistent semantics Assimilated C from Tels 0.07 Implemented _CvGV based upon code from Robin Houston. This removes the dependency on Devel::Peek (the CPAN version of Devel::Peek doesn't supply CvGV). This also happily makes the module work with perl 5.005_03. Fixed a bug in the import routine which was preventing the use form of derived classes. Reports a module is unrated if coverage returns undef. Added Pod::Checker::Overloader. 0.06 First cut at making inheritance easy. Pod::Checker::ExportOnly isa Pod::Checker which only checks what Exporter is allowed to hand out. Fixed up bad docs from the 0.05 release. 0.05 Used Pod::Find to deal with alternative locations for pod files. Introduced pod_from. Merged some patches from Schwern. Added in covered. Assimilated C as contributed by Kirrily "Skud" Robert . Copes with multple functions documented by one section. Added uncovered as a synonym for naked. 0.04 Just 0.03 with a correctly generated README file 0.03 Applied a patch from Dave Rolsky (barely 6 hours after release of 0.02) to improve scanning of pod markers. 0.02 Fixed up the import form. Removed dependency on List::Util. Added naked method. Exposed private configuration. 0.01 As #london.pm invaded Brighton, people taked about documentation standards. mstevens scribbled something down, richardc coded it, the rest is ponies. Pod-Coverage-0.23/MANIFEST0000644000175000017500000000126112140212154015152 0ustar richardcrichardcMANIFEST Changes Makefile.PL META.yml bin/pod_cover lib/Pod/Coverage.pm lib/Pod/Coverage/ExportOnly.pm lib/Pod/Coverage/Overloader.pm lib/Pod/Coverage/CountParents.pm t/01compile.t t/02simple.t t/03import.t t/04cvgv.t t/05parentage.t t/06trustme.t t/07pod.t t/08tie.t t/09whitespace.t t/lib/Args.pm t/lib/Earle.pm t/lib/Empty.pm t/lib/Simple1.pm t/lib/Simple2.pm t/lib/Simple3.pm t/lib/Simple4.pm t/lib/Simple4.pod t/lib/Simple5.pm t/lib/Simple6.pm t/lib/Simple7.pm t/lib/Simple8.pm t/lib/Simple9.pm t/lib/Child.pm t/lib/GrandParent.pm t/lib/Parent.pm t/lib/Sibling.pm t/lib/Trustme.pm t/lib/Tie.pm t/lib/XS4ALL.pm t/lib/Fully/Qualified.pm examples/check_installed examples/script-covered Pod-Coverage-0.23/lib/0002755000175000017500000000000012140212363014573 5ustar richardcrichardcPod-Coverage-0.23/lib/Pod/0002755000175000017500000000000012140212363015315 5ustar richardcrichardcPod-Coverage-0.23/lib/Pod/Coverage.pm0000644000175000017500000003016212140212132017400 0ustar richardcrichardcuse strict; package Pod::Coverage; use Devel::Symdump; use B; use Pod::Find qw(pod_where); BEGIN { defined &TRACE_ALL or eval 'sub TRACE_ALL () { 0 }' } use vars qw/ $VERSION /; $VERSION = '0.23'; =head1 NAME Pod::Coverage - Checks if the documentation of a module is comprehensive =head1 SYNOPSIS # in the beginnning... perl -MPod::Coverage=Pod::Coverage -e666 # all in one invocation use Pod::Coverage package => 'Fishy'; # straight OO use Pod::Coverage; my $pc = Pod::Coverage->new(package => 'Pod::Coverage'); print "We rock!" if $pc->coverage == 1; =head1 DESCRIPTION Developers hate writing documentation. They'd hate it even more if their computer tattled on them, but maybe they'll be even more thankful in the long run. Even if not, F tells you to, so you must obey. This module provides a mechanism for determining if the pod for a given module is comprehensive. It expects to find either a C<< =head(n>1) >> or an C<=item> block documenting a subroutine. Consider: # an imaginary Foo.pm package Foo; =item foo The foo sub = cut sub foo {} sub bar {} 1; __END__ In this example C is covered, but C is not, so the C package is only 50% (0.5) covered =head2 Methods =over =item Pod::Coverage->new(package => $package) Creates a new Pod::Coverage object. C the name of the package to analyse C an array of regexen which define what symbols are regarded as private (and so need not be documented) defaults to [ qr/^_/, qr/^(un)?import$/, qr/^DESTROY$/, qr/^AUTOLOAD$/, qr/^bootstrap$/, qr/^(TIE( SCALAR | ARRAY | HASH | HANDLE ) | FETCH | STORE | UNTIE | FETCHSIZE | STORESIZE | POP | PUSH | SHIFT | UNSHIFT | SPLICE | DELETE | EXISTS | EXTEND | CLEAR | FIRSTKEY | NEXTKEY | PRINT | PRINTF | WRITE | READLINE | GETC | READ | CLOSE | BINMODE | OPEN | EOF | FILENO | SEEK | TELL | SCALAR )$/x, qr/^( MODIFY | FETCH )_( REF | SCALAR | ARRAY | HASH | CODE | GLOB | FORMAT | IO )_ATTRIBUTES$/x, qr/^CLONE(_SKIP)?$/, ] This should cover all the usual magical methods for tie()d objects, attributes, generally all the methods that are typically not called by a user, but instead being used internally by perl. C items are appended to the private list C an array of regexen which define what symbols you just want us to assume are properly documented even if we can't find any docs for them If C is supplied, that file is parsed for the documentation, rather than using Pod::Find If C is supplied, then only POD sections which have non-whitespace characters will count towards being documented. =cut sub new { my $referent = shift; my %args = @_; my $class = ref $referent || $referent; my $private = $args{private} || [ qr/^_/, qr/^(un)?import$/, qr/^DESTROY$/, qr/^AUTOLOAD$/, qr/^bootstrap$/, qr/^\(/, qr/^(TIE( SCALAR | ARRAY | HASH | HANDLE ) | FETCH | STORE | UNTIE | FETCHSIZE | STORESIZE | POP | PUSH | SHIFT | UNSHIFT | SPLICE | DELETE | EXISTS | EXTEND | CLEAR | FIRSTKEY | NEXTKEY | PRINT | PRINTF | WRITE | READLINE | GETC | READ | CLOSE | BINMODE | OPEN | EOF | FILENO | SEEK | TELL | SCALAR )$/x, 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 $nonwhitespace = $args{nonwhitespace} || undef; my $self = bless { @_, private => $private, trustme => $trustme, nonwhitespace => $nonwhitespace }, $class; } =item $object->coverage Gives the coverage as a value in the range 0 to 1 =cut sub coverage { my $self = shift; my $package = $self->{package}; my $pods = $self->_get_pods; return unless $pods; my %symbols = map { $_ => 0 } $self->_get_syms($package); if (!%symbols && $self->{why_unrated}) { # _get_syms failed violently return; } print "tying shoelaces\n" if TRACE_ALL; for my $pod (@$pods) { $symbols{$pod} = 1 if exists $symbols{$pod}; } foreach my $sym ( keys %symbols ) { $symbols{$sym} = 1 if $self->_trustme_check($sym); } # stash the results for later $self->{symbols} = \%symbols; if (TRACE_ALL) { require Data::Dumper; print Data::Dumper::Dumper($self); } my $symbols = scalar keys %symbols; my $documented = scalar grep {$_} values %symbols; unless ($symbols) { $self->{why_unrated} = "no public symbols defined"; return; } return $documented / $symbols; } =item $object->why_unrated C<< $object->coverage >> may return C, to indicate that it was unable to deduce coverage for a package. If this happens you should be able to check C to get a useful excuse. =cut sub why_unrated { my $self = shift; $self->{why_unrated}; } =item $object->naked/$object->uncovered Returns a list of uncovered routines, will implicitly call coverage if it's not already been called. Note, private and 'trustme' identifiers will be skipped. =cut sub naked { my $self = shift; $self->{symbols} or $self->coverage; return unless $self->{symbols}; return grep { !$self->{symbols}{$_} } keys %{ $self->{symbols} }; } *uncovered = \&naked; =item $object->covered Returns a list of covered routines, will implicitly call coverage if it's not previously been called. As with C, private and 'trustme' identifiers will be skipped. =cut sub covered { my $self = shift; $self->{symbols} or $self->coverage; return unless $self->{symbols}; return grep { $self->{symbols}{$_} } keys %{ $self->{symbols} }; } sub import { my $self = shift; return unless @_; # one argument - just a 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; 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 "'$looky_here[0]' is uncovered\n"; } } =back =head2 Debugging support In order to allow internals debugging, while allowing the optimiser to do its thang, C uses constant subs to define how it traces. Use them like so sub Pod::Coverage::TRACE_ALL () { 1 } use Pod::Coverage; Supported constants are: =over =item TRACE_ALL Trace everything. Well that's all there is so far, are you glad you came? =back =head2 Inheritance interface These abstract methods while functional in C may make your life easier if you want to extend C to fit your house style more closely. B Please consider this interface as in a state of flux until this comment goes away. =over =item $object->_CvGV($symbol) Return the GV for the coderef supplied. Used by C<_get_syms> to identify locally defined code. You probably won't need to override this one. =item $object->_get_syms($package) return a list of symbols to check for from the specified packahe =cut # this one walks the symbol tree sub _get_syms { my $self = shift; my $package = shift; print "requiring '$package'\n" if TRACE_ALL; eval qq{ require $package }; if ($@) { print "require failed with $@\n" if TRACE_ALL; $self->{why_unrated} = "requiring '$package' failed"; return; } print "walking symbols\n" if TRACE_ALL; my $syms = Devel::Symdump->new($package); my @symbols; for my $sym ( $syms->functions ) { # see if said method wasn't just imported from elsewhere 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}:://; next if $self->_private_check($sym); push @symbols, $sym; } return @symbols; } =item _get_pods Extract pod markers from the currently active package. Return an arrayref or undef on fail. =cut sub _get_pods { my $self = shift; my $package = $self->{package}; print "getting pod location for '$package'\n" if TRACE_ALL; $self->{pod_from} ||= pod_where( { -inc => 1 }, $package ); my $pod_from = $self->{pod_from}; unless ($pod_from) { $self->{why_unrated} = "couldn't find pod"; return; } print "parsing '$pod_from'\n" if TRACE_ALL; my $pod = Pod::Coverage::Extractor->new; $pod->{nonwhitespace} = $self->{nonwhitespace}; $pod->parse_from_file( $pod_from, '/dev/null' ); return $pod->{identifiers} || []; } =item _private_check($symbol) return true if the symbol should be considered private =cut sub _private_check { my $self = shift; my $sym = shift; return grep { $sym =~ /$_/ } @{ $self->{private} }; } =item _trustme_check($symbol) return true if the symbol is a 'trustme' symbol =cut sub _trustme_check { my ( $self, $sym ) = @_; return grep { $sym =~ /$_/ } @{ $self->{trustme} }; } sub _CvGV { my $self = shift; 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 }; # but for backcompat we're forced into this uglyness: no strict 'refs'; 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)/ ) { # take a closer look 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; # 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; # has arguments, or a semicolon $pod =~ /(\w+)\s*[;\(]/ and $pod = $1; print "Adding: '$pod'\n" if debug; 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} }; $self->{recent} = []; } } 1; __END__ =back =head1 BUGS Due to the method used to identify documented subroutines C may completely miss your house style and declare your code undocumented. Patches and/or failing tests welcome. =head1 TODO =over =item Widen the rules for identifying documentation =item Improve the code coverage of the test suite. C rocks so hard. =back =head1 SEE ALSO L, L =head1 AUTHORS Richard Clamp Michael Stevens some contributions from David Cantrell =head1 COPYRIGHT Copyright (c) 2001, 2003, 2004, 2006, 2007, 2009 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. =cut Pod-Coverage-0.23/lib/Pod/Coverage/0002755000175000017500000000000012140212363017050 5ustar richardcrichardcPod-Coverage-0.23/lib/Pod/Coverage/CountParents.pm0000644000175000017500000000325311423555254022050 0ustar richardcrichardcpackage Pod::Coverage::CountParents; use strict; use Pod::Coverage (); use base 'Pod::Coverage'; # this code considered lightly fugly :) sub _get_pods { my $self = shift; my $package = $self->{package}; eval qq{ require $package }; if ($@) { $self->{why_unrated} = "Couldn't compile '$package' to inspect: $@"; return; } my %pods; $pods{$package} = $self->SUPER::_get_pods; __walk_up($package, \%pods); my %flat = map { $_ => 1 } map { @{ $_ || [] } } values %pods; return [ keys %flat ]; } sub __walk_up { my $package = shift; my $pods = shift; $pods->{$package} = Pod::Coverage->new(package => $package)->_get_pods(); my @parents; { no strict 'refs'; @parents = @{"$package\::ISA"}; } do { $pods->{$_} || __walk_up($_, $pods) } for @parents; } 1; __END__ =head1 NAME Pod::Coverage::CountParents - subclass of Pod::Coverage that examines the inheritance tree =head1 SYNOPSIS # all in one invocation use Pod::Coverage::CountParents package => 'Fishy'; # straight OO use Pod::Coverage::CountParents; my $pc = new Pod::Coverage::CountParents package => 'Pod::Coverage'; print "We rock!" if $pc->coverage == 1; =head1 DESCRIPTION This module extends Pod::Coverage to include the documentation from parent classes when identifying the coverage of the code. If you want full documentation we suggest you check the L documentation. =head1 SEE ALSO L, L =head1 AUTHOR Copyright (c) 2002 Richard Clamp. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-Coverage-0.23/lib/Pod/Coverage/ExportOnly.pm0000644000175000017500000000235611714201674021546 0ustar richardcrichardcpackage Pod::Coverage::ExportOnly; use strict; use Pod::Coverage (); use base qw(Pod::Coverage); sub _get_syms { my $self = shift; my $package = shift; # lifted from UNIVERSAL::exports no strict 'refs'; my %exports = map { $_ => 1 } @{$package.'::EXPORT'}, @{$package.'::EXPORT_OK'}; return keys %exports; } 1; __END__ =head1 NAME Pod::Coverage::ExportOnly - subclass of Pod::Coverage than only examines exported functions =head1 SYNOPSIS # all in one invocation use Pod::Coverage::ExportOnly package => 'Fishy'; # straight OO use Pod::Coverage::ExportOnly; my $pc = new Pod::Coverage::ExportOnly package => 'Pod::Coverage'; print "We rock!" if $pc->coverage == 1; =head1 DESCRIPTION This module extends Pod::Coverage to only check things explicitly set up for export by the Exporter or UNIVERSAL::exports modules. If you want full documentation we suggest you check the L documentation =head1 SEE ALSO L, L, L =head1 AUTHORS Copyright (c) 2001 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. =cut Pod-Coverage-0.23/lib/Pod/Coverage/Overloader.pm0000644000175000017500000000134011714201674021515 0ustar richardcrichardcpackage Pod::Coverage::Overloader; use strict; use Pod::Coverage (); use base qw(Pod::Coverage); sub new { my $class = shift; warn "Pod::Coverage::Overloader is deprecated. Please use Pod::Coverage instead"; $class->SUPER::new( @_ ); } 1; __END__ =head1 NAME Pod::Coverage::Overloader - deprecated subclass of Pod::Coverage =head1 SYNOPSIS # Please do not use this module, it was an experiment that went # awry. Use Pod::Coverage instead =head1 DESCRIPTION =head1 SEE ALSO L, L =head1 AUTHORS Copyright (c) 2001 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. =cut Pod-Coverage-0.23/examples/0002755000175000017500000000000012140212363015643 5ustar richardcrichardcPod-Coverage-0.23/examples/script-covered0000644000175000017500000000053411423555254020533 0ustar richardcrichardc#!/usr/bin/perl -w use strict; my $file = shift || die "need something to test"; my $code; open F, $file; { local $/; $code = ; } close F; eval qq{ package testme; $code; 1; }; $INC{'testme.pm'} = 1; print testme::foo(); require Pod::Coverage; Pod::Coverage->import(pod_from => $file, package => 'testme'); Pod-Coverage-0.23/examples/check_installed0000644000175000017500000000112711423555254020715 0ustar richardcrichardc#!/usr/bin/perl -w # code contributed by Kirrily "Skud" Robert use strict; use Pod::Coverage; use ExtUtils::Installed; my $m = ExtUtils::Installed->new; my @modules = $m->modules(); print "Checking POD coverage...\n"; my %coverage; foreach my $mod (@modules) { my $pc = new Pod::Coverage package => $mod; $coverage{$mod} = $pc->coverage() || 0; } foreach my $out (sort by_coverage keys %coverage) { my $bar = "*" x ($coverage{$out} * 40); printf("%30s %3d%% %s\n", $out, $coverage{$out}*100, $bar); } sub by_coverage { $coverage{$b} <=> $coverage{$a}; } Pod-Coverage-0.23/META.yml0000644000175000017500000000101312140212363015267 0ustar richardcrichardc--- #YAML:1.0 name: Pod-Coverage version: 0.23 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 requires: Devel::Symdump: 2.01 Pod::Find: 0.21 Pod::Parser: 1.13 Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.48 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Pod-Coverage-0.23/bin/0002755000175000017500000000000012140212363014575 5ustar richardcrichardcPod-Coverage-0.23/bin/pod_cover0000644000175000017500000000261011423555254016511 0ustar richardcrichardc#!/usr/bin/perl -w # Run this to get a coverage analysis of the embedded documentation use Pod::Coverage; use lib 'lib'; # to test distribution inside './lib' use strict; print "Pod coverage analysis v1.00 (C) by Tels 2001.\n"; print "Using Pod::Coverage v$Pod::Coverage::VERSION\n\n"; print scalar localtime()," Starting analysis:\n\n"; my $covered = 0; my $uncovered; my $count = 0; my $c; open FILE, 'MANIFEST' or die "Can't read MANIFEST: $!"; while () { chomp; my ($file) = split /[\s\t]/,$_; next unless $file =~ /^lib.*\.pm$/; $file =~ s/^lib\///; # remove lib and .pm $file =~ s/\.pm$//; $file =~ s/\//::/g; # / => :: my $rc = Pod::Coverage->new( package => $file ); $covered += $rc->covered(); $uncovered += $rc->uncovered(); $count ++; $c = $rc->coverage() || 0; $c = int($c * 10000)/100; print "$file has a doc coverage of $c%.\n"; my @naked = $rc->naked(); if (@naked > 0) { print "Uncovered routines are:\n"; print " ",join("\n ",sort @naked),"\n"; # sort by name # could sort by line_num } print "\n"; } my $total = $covered+$uncovered; my $average = 'unknown'; $average = int(10000*$covered/$total)/100 if $total > 0; print "Summary:\n"; print " sub routines total : $total\n"; print " sub routines covered : $covered\n"; print " sub routines uncovered: $uncovered\n"; print " total coverage : $average%\n\n"; Pod-Coverage-0.23/Makefile.PL0000644000175000017500000000051011714202517015777 0ustar richardcrichardcuse ExtUtils::MakeMaker; WriteMakefile( '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' }, 'EXE_FILES' => [ 'bin/pod_cover', ], );