diff options
Diffstat (limited to 'lib/Test/Pod/Coverage.pm')
| -rw-r--r-- | lib/Test/Pod/Coverage.pm | 318 |
1 files changed, 318 insertions, 0 deletions
diff --git a/lib/Test/Pod/Coverage.pm b/lib/Test/Pod/Coverage.pm new file mode 100644 index 0000000..f803b93 --- /dev/null +++ b/lib/Test/Pod/Coverage.pm @@ -0,0 +1,318 @@ +package Test::Pod::Coverage; + +=head1 NAME + +Test::Pod::Coverage - Check for pod coverage in your distribution. + +=head1 VERSION + +Version 1.10 + +=cut + +our $VERSION = "1.10"; + +=head1 SYNOPSIS + +In one of your dist's test files (eg C<t/pod-coverage.t>): + + use Test::Pod::Coverage tests=>1; + pod_coverage_ok( "Foo::Bar", "Foo::Bar is covered" ); + +=head1 DESCRIPTION + +Test::Pod::Coverage is used to create a test for your distribution, +to ensure that all relevant files in your distribution are appropriately +documented in pod. + +Can also be called with L<Pod::Coverage> parms. + + use Test::Pod::Coverage tests=>1; + pod_coverage_ok( + "Foo::Bar", + { also_private => [ qr/^[A-Z_]+$/ ], }, + "Foo::Bar, with all-caps functions as privates", + ); + +The L<Pod::Coverage> parms are also useful for subclasses that don't +re-document the parent class's methods. Here's an example from +L<Mail::SRS>. + + pod_coverage_ok( "Mail::SRS" ); # No exceptions + + # Define the three overridden methods. + my $trustme = { trustme => [qr/^(new|parse|compile)$/] }; + pod_coverage_ok( "Mail::SRS::DB", $trustme ); + pod_coverage_ok( "Mail::SRS::Guarded", $trustme ); + pod_coverage_ok( "Mail::SRS::Reversable", $trustme ); + pod_coverage_ok( "Mail::SRS::Shortcut", $trustme ); + +Alternately, you could use L<Pod::Coverage::CountParents>, which always allows +a subclass to reimplement its parents' methods without redocumenting them. For +example: + + my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' }; + pod_coverage_ok( "IO::Handle::Frayed", $trustparents ); + +(The C<coverage_class> parameter is not passed to the coverage class with other +parameters.) + +If you want POD coverage for your module, but don't want to make +Test::Pod::Coverage a prerequisite for installing, create the following +as your F<t/pod-coverage.t> file: + + use Test::More; + eval "use Test::Pod::Coverage"; + plan skip_all => "Test::Pod::Coverage required for testing pod coverage" if $@; + + plan tests => 1; + pod_coverage_ok( "Pod::Master::Html"); + +Finally, Module authors can include the following in a F<t/pod-coverage.t> +file and have C<Test::Pod::Coverage> automatically find and check all +modules in the module distribution: + + use Test::More; + eval "use Test::Pod::Coverage 1.00"; + plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; + all_pod_coverage_ok(); + +=cut + +use 5.006; +use strict; +use warnings; + +use Pod::Coverage; +use Test::Builder; + +my $Test = Test::Builder->new; + +sub import { + my $self = shift; + my $caller = caller; + no strict 'refs'; + *{$caller.'::pod_coverage_ok'} = \&pod_coverage_ok; + *{$caller.'::all_pod_coverage_ok'} = \&all_pod_coverage_ok; + *{$caller.'::all_modules'} = \&all_modules; + + $Test->exported_to($caller); + $Test->plan(@_); +} + +=head1 FUNCTIONS + +All functions listed below are exported to the calling namespace. + +=head2 all_pod_coverage_ok( [$parms, ] $msg ) + +Checks that the POD code in all modules in the distro have proper POD +coverage. + +If the I<$parms> hashref if passed in, they're passed into the +C<Pod::Coverage> object that the function uses. Check the +L<Pod::Coverage> manual for what those can be. + +The exception is the C<coverage_class> parameter, which specifies a class to +use for coverage testing. It defaults to C<Pod::Coverage>. + +=cut + +sub all_pod_coverage_ok { + my $parms = (@_ && (ref $_[0] eq "HASH")) ? shift : {}; + my $msg = shift; + + my $ok = 1; + my @modules = all_modules(); + if ( @modules ) { + $Test->plan( tests => scalar @modules ); + + for my $module ( @modules ) { + my $thismsg = defined $msg ? $msg : "Pod coverage on $module"; + + my $thisok = pod_coverage_ok( $module, $parms, $thismsg ); + $ok = 0 unless $thisok; + } + } + else { + $Test->plan( tests => 1 ); + $Test->ok( 1, "No modules found." ); + } + + return $ok; +} + + +=head2 pod_coverage_ok( $module, [$parms, ] $msg ) + +Checks that the POD code in I<$module> has proper POD coverage. + +If the I<$parms> hashref if passed in, they're passed into the +C<Pod::Coverage> object that the function uses. Check the +L<Pod::Coverage> manual for what those can be. + +The exception is the C<coverage_class> parameter, which specifies a class to +use for coverage testing. It defaults to C<Pod::Coverage>. + +=cut + +sub pod_coverage_ok { + my $module = shift; + my %parms = (@_ && (ref $_[0] eq "HASH")) ? %{(shift)} : (); + my $msg = @_ ? shift : "Pod coverage on $module"; + + my $pc_class = (delete $parms{coverage_class}) || 'Pod::Coverage'; + eval "require $pc_class" or die $@; + + my $pc = $pc_class->new( package => $module, %parms ); + + my $rating = $pc->coverage; + my $ok; + if ( defined $rating ) { + $ok = ($rating == 1); + $Test->ok( $ok, $msg ); + if ( !$ok ) { + my @nakies = sort $pc->naked; + my $s = @nakies == 1 ? "" : "s"; + $Test->diag( + sprintf( "Coverage for %s is %3.1f%%, with %d naked subroutine$s:", + $module, $rating*100, scalar @nakies ) ); + $Test->diag( "\t$_" ) for @nakies; + } + } + else { # No symbols + my $why = $pc->why_unrated; + my $nopublics = ( $why =~ "no public symbols defined" ); + my $verbose = $ENV{HARNESS_VERBOSE} || 0; + $ok = $nopublics; + $Test->ok( $ok, $msg ); + $Test->diag( "$module: $why" ) unless ( $nopublics && !$verbose ); + } + + return $ok; +} + +=head2 all_modules( [@dirs] ) + +Returns a list of all modules in I<$dir> and in directories below. If +no directories are passed, it defaults to F<blib> if F<blib> exists, +or F<lib> if not. + +Note that the modules are as "Foo::Bar", not "Foo/Bar.pm". + +The order of the files returned is machine-dependent. If you want them +sorted, you'll have to sort them yourself. + +=cut + +sub all_modules { + my @starters = @_ ? @_ : _starting_points(); + my %starters = map {$_,1} @starters; + + my @queue = @starters; + + my @modules; + while ( @queue ) { + my $file = shift @queue; + if ( -d $file ) { + local *DH; + opendir DH, $file or next; + my @newfiles = readdir DH; + closedir DH; + + @newfiles = File::Spec->no_upwards( @newfiles ); + @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles; + + push @queue, map "$file/$_", @newfiles; + } + if ( -f $file ) { + next unless $file =~ /\.pm$/; + + my @parts = File::Spec->splitdir( $file ); + shift @parts if @parts && exists $starters{$parts[0]}; + shift @parts if @parts && $parts[0] eq "lib"; + $parts[-1] =~ s/\.pm$// if @parts; + + # Untaint the parts + for ( @parts ) { + if ( /^([a-zA-Z0-9_\.\-]+)$/ && ($_ eq $1) ) { + $_ = $1; # Untaint the original + } + else { + die qq{Invalid and untaintable filename "$file"!}; + } + } + my $module = join( "::", @parts ); + push( @modules, $module ); + } + } # while + + return @modules; +} + +sub _starting_points { + return 'blib' if -e 'blib'; + return 'lib'; +} + +=head1 BUGS + +Please report any bugs or feature requests to +C<bug-test-pod-coverage at rt.cpan.org>, or through the web interface at +L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Pod-Coverage>. +I will be notified, and then you'll automatically be notified of progress on +your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Test::Pod::Coverage + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L<http://annocpan.org/dist/Test-Pod-Coverage> + +=item * CPAN Ratings + +L<http://cpanratings.perl.org/d/Test-Pod-Coverage> + +=item * RT: CPAN's request tracker + +L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Pod-Coverage> + +=item * Search CPAN + +L<http://search.cpan.org/dist/Test-Pod-Coverage> + +=back + +=head1 REPOSITORY + +L<https://github.com/neilbowers/Test-Pod-Coverage> + +=head1 AUTHOR + +Written by Andy Lester, C<< <andy at petdance.com> >>. + +=head1 ACKNOWLEDGEMENTS + +Thanks to Ricardo Signes for patches, and Richard Clamp for +writing Pod::Coverage. + +=head1 COPYRIGHT & LICENSE + +Copyright 2006, Andy Lester, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it +under the terms of the Artistic License version 2.0. + +See http://dev.perl.org/licenses/ for more information + +=cut + +1; |