File Coverage

inc/Test/Pod.pm
Criterion Covered Total %
statement 75 84 89.2
branch 23 36 63.8
condition 1 3 33.3
subroutine 13 13 100.0
pod 3 3 100.0
total 115 139 82.7


line stmt bran cond sub pod time code
1             #line 1
2             package Test::Pod;
3 1     1   702  
  1         2  
  1         42  
4             use strict;
5              
6             #line 13
7              
8             use vars qw( $VERSION );
9             $VERSION = '1.26';
10              
11             #line 63
12              
13             use 5.004;
14 1     1   7  
  1         2  
  1         56  
15             use Pod::Simple;
16             use Test::Builder;
17             use File::Spec;
18              
19             my $Test = Test::Builder->new;
20              
21             sub import {
22             my $self = shift;
23             my $caller = caller;
24              
25             for my $func ( qw( pod_file_ok all_pod_files all_pod_files_ok ) ) {
26             no strict 'refs';
27             *{$caller."::".$func} = \&$func;
28             }
29              
30             $Test->exported_to($caller);
31             $Test->plan(@_);
32             }
33              
34             #line 100
35              
36             sub pod_file_ok {
37             my $file = shift;
38             my $name = @_ ? shift : "POD test for $file";
39              
40             if ( !-f $file ) {
41             $Test->ok( 0, $name );
42             $Test->diag( "$file does not exist" );
43             return;
44             }
45              
46             my $checker = Pod::Simple->new;
47              
48             $checker->output_string( \my $trash ); # Ignore any output
49             $checker->parse_file( $file );
50              
51             my $ok = !$checker->any_errata_seen;
52             $Test->ok( $ok, $name );
53             if ( !$ok ) {
54             my $lines = $checker->{errata};
55             for my $line ( sort { $a<=>$b } keys %$lines ) {
56             my $errors = $lines->{$line};
57             $Test->diag( "$file ($line): $_" ) for @$errors;
58             }
59             }
60              
61             return $ok;
62             } # pod_file_ok
63              
64 1     1   27 #line 150
  1         4  
  1         41  
65              
66 1     1   1300 sub all_pod_files_ok {
  1         36241  
  1         34  
67 1     1   13 my @files = @_ ? @_ : all_pod_files();
  1         2  
  1         22  
68 1     1   7  
  1         3  
  1         68  
69             $Test->plan( tests => scalar @files );
70              
71             my $ok = 1;
72             foreach my $file ( @files ) {
73 1     1   34 pod_file_ok( $file, $file ) or undef $ok;
74 1         2 }
75             return $ok;
76 1         2 }
77 1     1   6  
  1         2  
  1         866  
78 3         7 #line 183
  3         15  
79              
80             sub all_pod_files {
81 1         27 my @queue = @_ ? @_ : _starting_points();
82 1         13 my @pod = ();
83              
84             while ( @queue ) {
85             my $file = shift @queue;
86             if ( -d $file ) {
87             local *DH;
88             opendir DH, $file or next;
89             my @newfiles = readdir DH;
90             closedir DH;
91              
92             @newfiles = File::Spec->no_upwards( @newfiles );
93             @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
94              
95             foreach my $newfile (@newfiles) {
96             my $filename = File::Spec->catfile( $file, $newfile );
97             if ( -f $filename ) {
98             push @queue, $filename;
99             }
100             else {
101             push @queue, File::Spec->catdir( $file, $newfile );
102 1     1 1 3 }
103 1 50       4 }
104             }
105 1 50       22 if ( -f $file ) {
106 0         0 push @pod, $file if _is_perl( $file );
107 0         0 }
108 0         0 } # while
109             return @pod;
110             }
111 1         10  
112             sub _starting_points {
113 1         34 return 'blib' if -e 'blib';
114 1         3432 return 'lib';
115             }
116 1         30640  
117 1         14 sub _is_perl {
118 1 50       757 my $file = shift;
119 0         0  
120 0         0 return 1 if $file =~ /\.PL$/;
  0         0  
121 0         0 return 1 if $file =~ /\.p(l|m|od)$/;
122 0         0 return 1 if $file =~ /\.t$/;
123              
124             local *FH;
125             open FH, $file or return;
126 1         42 my $first = <FH>;
127             close FH;
128              
129             return 1 if defined $first && ($first =~ /^#!.*perl/);
130              
131             return;
132             }
133              
134             #line 268
135              
136             1;