File Coverage

blib/lib/Test/Pod.pm
Criterion Covered Total %
statement 59 73 80.8
branch 17 32 53.1
condition 6 11 54.5
subroutine 12 14 85.7
pod 3 3 100.0
total 97 133 72.9


line stmt bran cond sub pod time code
1             package Test::Pod;
2              
3 9     9   197004 use strict;
  9         22  
  9         635  
4              
5             =head1 NAME
6              
7             Test::Pod - check for POD errors in files
8              
9             =head1 VERSION
10              
11             Version 1.50
12              
13             =cut
14              
15             our $VERSION = '1.50';
16              
17             =head1 SYNOPSIS
18              
19             C lets you check the validity of a POD file, and report
20             its results in standard C fashion.
21              
22             use Test::Pod tests => $num_tests;
23             pod_file_ok( $file, "Valid POD file" );
24              
25             Module authors can include the following in a F file and
26             have C automatically find and check all POD files in a
27             module distribution:
28              
29             use Test::More;
30             eval "use Test::Pod 1.00";
31             plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
32             all_pod_files_ok();
33              
34             You can also specify a list of files to check, using the
35             C function supplied:
36              
37             use strict;
38             use Test::More;
39             eval "use Test::Pod 1.00";
40             plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
41             my @poddirs = qw( blib script );
42             all_pod_files_ok( all_pod_files( @poddirs ) );
43              
44             Or even (if you're running under L):
45              
46             use strict;
47             use Test::More;
48             eval "use Test::Pod 1.00";
49             plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
50              
51             my @poddirs = qw( blib script );
52             use File::Spec::Functions qw( catdir updir );
53             all_pod_files_ok(
54             all_pod_files( map { catdir updir, $_ } @poddirs )
55             );
56              
57             =head1 DESCRIPTION
58              
59             Check POD files for errors or warnings in a test file, using
60             C to do the heavy lifting.
61              
62             =cut
63              
64 9     9   251 use 5.008;
  9         34  
  9         370  
65              
66 9     9   59 use Test::Builder;
  9         29  
  9         286  
67 9     9   6983 use Pod::Simple;
  9         288666  
  9         1037  
68              
69             our %ignore_dirs = (
70             '.bzr' => 'Bazaar',
71             '.git' => 'Git',
72             '.hg' => 'Mercurial',
73             '.pc' => 'quilt',
74             '.svn' => 'Subversion',
75             CVS => 'CVS',
76             RCS => 'RCS',
77             SCCS => 'SCCS',
78             _darcs => 'darcs',
79             _sgbak => 'Vault/Fortress',
80             );
81              
82             my $Test = Test::Builder->new;
83              
84             sub import {
85 9     9   98 my $self = shift;
86 9         28 my $caller = caller;
87              
88 9         25 for my $func ( qw( pod_file_ok all_pod_files all_pod_files_ok ) ) {
89 9     9   112 no strict 'refs';
  9         18  
  9         9013  
90 27         62 *{$caller."::".$func} = \&$func;
  27         175  
91             }
92              
93 9         54 $Test->exported_to($caller);
94 9         120 $Test->plan(@_);
95             }
96              
97             sub _additional_test_pod_specific_checks {
98 6     6   16 my ($ok, $errata, $file) = @_;
99              
100 6         17 return $ok;
101             }
102              
103             =head1 FUNCTIONS
104              
105             =head2 pod_file_ok( FILENAME[, TESTNAME ] )
106              
107             C will okay the test if the POD parses correctly. Certain
108             conditions are not reported yet, such as a file with no pod in it at all.
109              
110             When it fails, C will show any pod checking errors as
111             diagnostics.
112              
113             The optional second argument TESTNAME is the name of the test. If it
114             is omitted, C chooses a default test name "POD test
115             for FILENAME".
116              
117             =cut
118              
119             sub pod_file_ok {
120 8     8 1 2807 my $file = shift;
121 8 100       43 my $name = @_ ? shift : "POD test for $file";
122              
123 8 100       242 if ( !-f $file ) {
124 2         8 $Test->ok( 0, $name );
125 2         1055 $Test->diag( "$file does not exist" );
126 2         107 return;
127             }
128              
129 6         70 my $checker = Pod::Simple->new;
130              
131 6         229 $checker->output_string( \my $trash ); # Ignore any output
132 6         7401 $checker->parse_file( $file );
133              
134 6         31291 my $ok = !$checker->any_errata_seen;
135 6   100     78 $ok = _additional_test_pod_specific_checks( $ok, ($checker->{errata}||={}), $file );
136              
137 6 50       31 $name .= ' (no pod)' if !$checker->content_seen;
138 6         112 $Test->ok( $ok, $name );
139 6 100       2483 if ( !$ok ) {
140 3         8 my $lines = $checker->{errata};
141 3         14 for my $line ( sort { $a<=>$b } keys %$lines ) {
  4         12  
142 6         164 my $errors = $lines->{$line};
143 6         30 $Test->diag( "$file ($line): $_" ) for @$errors;
144             }
145             }
146              
147 6         394 return $ok;
148             } # pod_file_ok
149              
150             =head2 all_pod_files_ok( [@entries] )
151              
152             Checks all the files under C<@entries> for valid POD. It runs
153             L on directories and assumes everything else to be a file to
154             be tested. It calls the C function for you (one test for each file),
155             so you can't have already called C.
156              
157             If C<@entries> is empty or not passed, the function finds all POD files in
158             files in the F directory if it exists, or the F directory if not. A
159             POD file is one that ends with a Perl extension (F<.pod>, F<.pl>, F<.pm>,
160             F<.PL>, F<.t>), where the first line looks like a Perl shebang, or a batch
161             file (F<.bat>) starting with a line containing C<--*-Perl-*-->.
162              
163             If you're testing a module, just make a F:
164              
165             use Test::More;
166             eval "use Test::Pod 1.00";
167             plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
168             all_pod_files_ok();
169              
170             Returns true if all pod files are ok, or false if any fail.
171              
172             =cut
173              
174             sub all_pod_files_ok {
175 0 0   0 1 0 my @args = @_ ? @_ : _starting_points();
176 0 0       0 my @files = map { -d $_ ? all_pod_files($_) : $_ } @args;
  0         0  
177              
178 0 0       0 unless (@files) {
179 0         0 $Test->skip_all( "No files found in (@args)\n" );
180 0         0 return 1;
181             }
182              
183 0         0 $Test->plan( tests => scalar @files );
184              
185 0         0 my $ok = 1;
186 0         0 foreach my $file ( @files ) {
187 0 0       0 pod_file_ok( $file ) or undef $ok;
188             }
189 0         0 return $ok;
190             }
191              
192             =head2 all_pod_files( [@dirs] )
193              
194             Returns a list of all the Perl files in I<@dirs> and in directories below. If
195             no directories are passed, it defaults to F if F exists, or else
196             F if not. Skips any files in F, F<.svn>, F<.git> and similar
197             directories. See C<%Test::Pod::ignore_dirs> for a list of them.
198              
199             A Perl file is:
200              
201             =over 4
202              
203             =item * Any file that ends in F<.PL>, F<.pl>, F<.PL>, F<.pm>, F<.pod>, or F<.t>.
204              
205             =item * Any file that has a first line with a shebang and "perl" on it.
206              
207             =item * Any file that ends in F<.bat> and has a first line with "--*-Perl-*--" on it.
208              
209             =back
210              
211             The order of the files returned is machine-dependent. If you want them
212             sorted, you'll have to sort them yourself.
213              
214             =cut
215              
216             sub all_pod_files {
217 1     1 1 15 my @pod;
218 1         12 require File::Find;
219             File::Find::find({
220 12   33     119 preprocess => sub { grep {
221 3     3   7 !exists $ignore_dirs{$_}
222             || !-d File::Spec->catfile($File::Find::dir, $_)
223             } @_ },
224 8 100 66 8   204 wanted => sub { -f $_ && _is_perl($_) && push @pod, $File::Find::name },
225 1 50       127 no_chdir => 1,
226             }, @_ ? @_ : _starting_points());
227 1         10 return @pod;
228             }
229              
230             sub _starting_points {
231 0 0   0   0 return 'blib' if -e 'blib';
232 0         0 return 'lib';
233             }
234              
235             sub _is_perl {
236 5     5   8 my $file = shift;
237              
238             # accept as a Perl file everything that ends with a well known Perl suffix ...
239 5 100       86 return 1 if $file =~ /[.](?:PL|p(?:[lm]|od)|t)$/;
240              
241 2 50       54 open my $fh, '<', $file or return;
242 2         28 my $first = <$fh>;
243 2         10 close $fh;
244 2 50       7 return unless $first;
245              
246             # ... or that has a she-bang as first line ...
247 2 100       23 return 1 if $first =~ /^#!.*perl/;
248              
249             # ... or that is a .bat ad has a Perl comment line first
250 1 50 33     23 return 1 if $file =~ /[.]bat$/i && $first =~ /--[*]-Perl-[*]--/;
251              
252 0           return;
253             }
254              
255             =head1 SUPPORT
256              
257             This module is managed in an open L
258             repository|http://github.com/perl-pod/test-pod/>. Feel free to fork and
259             contribute, or to clone L and send
260             patches!
261              
262             Found a bug? Please L or
263             L a report!
264              
265             =head1 AUTHORS
266              
267             =over
268              
269             =item David E. Wheeler
270              
271             Current maintainer.
272              
273             =item Andy Lester C<< >>
274              
275             Maintainer emeritus.
276              
277             =item brian d foy
278              
279             Orinal author.
280              
281             =back
282              
283             =head1 ACKNOWLEDGEMENTS
284              
285             Thanks brian d foy for the original code, and to these folks for contributions:
286              
287             =over
288              
289             =item * Andy Lester
290              
291             =item * David E. Wheeler
292              
293             =item * Paul Miller
294              
295             =item * Peter Edwards
296              
297             =item * Luca Ferrari
298              
299             =back
300              
301             =head1 COPYRIGHT AND LICENSE
302              
303             Copyright 2006-2010, Andy Lester; 2010-2015 David E. Wheeler. Some Rights
304             Reserved.
305              
306             This module is free software; you can redistribute it and/or modify it under
307             the same terms as Perl itself.
308              
309             =cut
310              
311             1;