vcs.maemo.org Git - pkg-perl/blob - deb-src/libtest-pod-perl/libtest-pod-perl-1.26/Pod.pm

   1 package Test::Pod;
   2
   3 use strict;
   4
   5 =head1 NAME
   6
   7 Test::Pod - check for POD errors in files
   8
   9 =head1 VERSION
  10
  11 Version 1.26
  12
  13 =cut
  14
  15 use vars qw( $VERSION );
  16 $VERSION = '1.26';
  17
  18 =head1 SYNOPSIS
  19
  20 C<Test::Pod> lets you check the validity of a POD file, and report
  21 its results in standard C<Test::Simple> fashion.
  22
  23     use Test::Pod tests => $num_tests;
  24     pod_file_ok( $file, "Valid POD file" );
  25
  26 Module authors can include the following in a F<t/pod.t> file and
  27 have C<Test::Pod> automatically find and check all POD files in a
  28 module distribution:
  29
  30     use Test::More;
  31     eval "use Test::Pod 1.00";
  32     plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
  33     all_pod_files_ok();
  34
  35 You can also specify a list of files to check, using the
  36 C<all_pod_files()> function supplied:
  37
  38     use strict;
  39     use Test::More;
  40     eval "use Test::Pod 1.00";
  41     plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
  42     my @poddirs = qw( blib script );
  43     all_pod_files_ok( all_pod_files( @poddirs ) );
  44
  45 Or even (if you're running under L<Apache::Test>):
  46
  47     use strict;
  48     use Test::More;
  49     eval "use Test::Pod 1.00";
  50     plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
  51
  52     my @poddirs = qw( blib script );
  53     use File::Spec::Functions qw( catdir updir );
  54     all_pod_files_ok(
  55         all_pod_files( map { catdir updir, $_ } @poddirs )
  56     );
  57
  58 =head1 DESCRIPTION
  59
  60 Check POD files for errors or warnings in a test file, using
  61 C<Pod::Simple> to do the heavy lifting.
  62
  63 =cut
  64
  65 use 5.004;
  66
  67 use Pod::Simple;
  68 use Test::Builder;
  69 use File::Spec;
  70
  71 my $Test = Test::Builder->new;
  72
  73 sub import {
  74     my $self = shift;
  75     my $caller = caller;
  76
  77     for my $func ( qw( pod_file_ok all_pod_files all_pod_files_ok ) ) {
  78         no strict 'refs';
  79         *{$caller."::".$func} = \&$func;
  80     }
  81
  82     $Test->exported_to($caller);
  83     $Test->plan(@_);
  84 }
  85
  86 =head1 FUNCTIONS
  87
  88 =head2 pod_file_ok( FILENAME[, TESTNAME ] )
  89
  90 C<pod_file_ok()> will okay the test if the POD parses correctly.  Certain
  91 conditions are not reported yet, such as a file with no pod in it at all.
  92
  93 When it fails, C<pod_file_ok()> will show any pod checking errors as
  94 diagnostics.
  95
  96 The optional second argument TESTNAME is the name of the test.  If it
  97 is omitted, C<pod_file_ok()> chooses a default test name "POD test
  98 for FILENAME".
  99
 100 =cut
 101
 102 sub pod_file_ok {
 103     my $file = shift;
 104     my $name = @_ ? shift : "POD test for $file";
 105
 106     if ( !-f $file ) {
 107         $Test->ok( 0, $name );
 108         $Test->diag( "$file does not exist" );
 109         return;
 110     }
 111
 112     my $checker = Pod::Simple->new;
 113
 114     $checker->output_string( \my $trash ); # Ignore any output
 115     $checker->parse_file( $file );
 116
 117     my $ok = !$checker->any_errata_seen;
 118     $Test->ok( $ok, $name );
 119     if ( !$ok ) {
 120         my $lines = $checker->{errata};
 121         for my $line ( sort { $a<=>$b } keys %$lines ) {
 122             my $errors = $lines->{$line};
 123             $Test->diag( "$file ($line): $_" ) for @$errors;
 124         }
 125     }
 126
 127     return $ok;
 128 } # pod_file_ok
 129
 130 =head2 all_pod_files_ok( [@files/@directories] )
 131
 132 Checks all the files in C<@files> for valid POD.  It runs
 133 L<all_pod_files()> on each file/directory, and calls the C<plan()> function for you
 134 (one test for each function), so you can't have already called C<plan>.
 135
 136 If C<@files> is empty or not passed, the function finds all POD files in
 137 the F<blib> directory if it exists, or the F<lib> directory if not.
 138 A POD file is one that ends with F<.pod>, F<.pl> and F<.pm>, or any file
 139 where the first line looks like a shebang line.
 140
 141 If you're testing a module, just make a F<t/pod.t>:
 142
 143     use Test::More;
 144     eval "use Test::Pod 1.00";
 145     plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
 146     all_pod_files_ok();
 147
 148 Returns true if all pod files are ok, or false if any fail.
 149
 150 =cut
 151
 152 sub all_pod_files_ok {
 153     my @files = @_ ? @_ : all_pod_files();
 154
 155     $Test->plan( tests => scalar @files );
 156
 157     my $ok = 1;
 158     foreach my $file ( @files ) {
 159         pod_file_ok( $file, $file ) or undef $ok;
 160     }
 161     return $ok;
 162 }
 163
 164 =head2 all_pod_files( [@dirs] )
 165
 166 Returns a list of all the Perl files in I<$dir> and in directories below.
 167 If no directories are passed, it defaults to F<blib> if F<blib> exists,
 168 or else F<lib> if not.  Skips any files in CVS or .svn directories.
 169
 170 A Perl file is:
 171
 172 =over 4
 173
 174 =item * Any file that ends in F<.PL>, F<.pl>, F<.pm>, F<.pod> or F<.t>.
 175
 176 =item * Any file that has a first line with a shebang and "perl" on it.
 177
 178 =back
 179
 180 The order of the files returned is machine-dependent.  If you want them
 181 sorted, you'll have to sort them yourself.
 182
 183 =cut
 184
 185 sub all_pod_files {
 186     my @queue = @_ ? @_ : _starting_points();
 187     my @pod = ();
 188
 189     while ( @queue ) {
 190         my $file = shift @queue;
 191         if ( -d $file ) {
 192             local *DH;
 193             opendir DH, $file or next;
 194             my @newfiles = readdir DH;
 195             closedir DH;
 196
 197             @newfiles = File::Spec->no_upwards( @newfiles );
 198             @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
 199
 200             foreach my $newfile (@newfiles) {
 201                 my $filename = File::Spec->catfile( $file, $newfile );
 202                 if ( -f $filename ) {
 203                     push @queue, $filename;
 204                 }
 205                 else {
 206                     push @queue, File::Spec->catdir( $file, $newfile );
 207                 }
 208             }
 209         }
 210         if ( -f $file ) {
 211             push @pod, $file if _is_perl( $file );
 212         }
 213     } # while
 214     return @pod;
 215 }
 216
 217 sub _starting_points {
 218     return 'blib' if -e 'blib';
 219     return 'lib';
 220 }
 221
 222 sub _is_perl {
 223     my $file = shift;
 224
 225     return 1 if $file =~ /\.PL$/;
 226     return 1 if $file =~ /\.p(l|m|od)$/;
 227     return 1 if $file =~ /\.t$/;
 228
 229     local *FH;
 230     open FH, $file or return;
 231     my $first = <FH>;
 232     close FH;
 233
 234     return 1 if defined $first && ($first =~ /^#!.*perl/);
 235
 236     return;
 237 }
 238
 239 =head1 TODO
 240
 241 STUFF TO DO
 242
 243 Note the changes that are being made.
 244
 245 Note that you no longer can test for "no pod".
 246
 247 =head1 AUTHOR
 248
 249 Currently maintained by Andy Lester, C<< <andy at petdance.com> >>.
 250
 251 Originally by brian d foy.
 252
 253 =head1 ACKNOWLEDGEMENTS
 254
 255 Thanks to
 256 David Wheeler
 257 and
 258 Peter Edwards
 259 for contributions and to C<brian d foy> for the original code.
 260
 261 =head1 COPYRIGHT
 262
 263 Copyright 2006, Andy Lester, All Rights Reserved.
 264
 265 You may use, modify, and distribute this package under the
 266 same terms as Perl itself.
 267
 268 =cut
 269
 270 1;