File Coverage

blib/lib/Test/Spelling.pm
Criterion Covered Total %
statement 86 139 61.8
branch 14 50 28.0
condition 4 15 26.6
subroutine 18 24 75.0
pod 9 11 81.8
total 131 239 54.8


line stmt bran cond sub pod time code
1             package Test::Spelling;
2              
3 4     4   276248 use strict;
  4         43  
  4         116  
4 4     4   28 use warnings;
  4         8  
  4         129  
5              
6 4     4   22 use Exporter qw(import);
  4         7  
  4         109  
7 4     4   1841 use Pod::Spell;
  4         40723  
  4         131  
8 4     4   26 use Test::Builder;
  4         7  
  4         75  
9 4     4   19 use Text::Wrap;
  4         7  
  4         184  
10 4     4   23 use File::Spec;
  4         6  
  4         75  
11 4     4   1996 use IPC::Run3;
  4         128151  
  4         243  
12 4     4   34 use Symbol 'gensym';
  4         10  
  4         6036  
13              
14             our $VERSION = '0.25';
15              
16             our @EXPORT = qw(
17             pod_file_spelling_ok
18             all_pod_files_spelling_ok
19             add_stopwords
20             set_spell_cmd
21             all_pod_files
22             set_pod_file_filter
23             has_working_spellchecker
24             set_pod_parser
25             );
26              
27             my $TEST = Test::Builder->new;
28              
29             my $SPELLCHECKER;
30             my $FILE_FILTER = sub { 1 };
31             my $POD_PARSER;
32             our %ALL_WORDS;
33              
34             sub spellchecker_candidates {
35             # if they've specified a spellchecker, use only that one
36 7 100   7 0 27 return $SPELLCHECKER if $SPELLCHECKER;
37              
38             return (
39 3         11 'hunspell -l', # hunspell is now the most common spell checker
40             'spell', # for back-compat, this is the top candidate ...
41             'aspell list -l en -p /dev/null', # ... but this should become first soon
42             'ispell -l',
43             );
44             }
45              
46             sub has_working_spellchecker {
47 3     3 1 866 my $dryrun_results = _get_spellcheck_results("dry run", 1);
48              
49 3 50       42 if (ref $dryrun_results) {
50 3         38 return;
51             }
52              
53 0         0 return $SPELLCHECKER;
54             }
55              
56             sub _get_spellcheck_results {
57 7     7   581 my $document = shift;
58 7         15 my $dryrun = shift;
59              
60 7         16 my @errors;
61              
62 7         21 for my $spellchecker (spellchecker_candidates()) {
63 16         43 my @words;
64 16         36 my $ok = eval {
65              
66 16         32 my ($spellcheck_results, $errors);
67 16         103 IPC::Run3::run3($spellchecker, \$document, \$spellcheck_results, \$errors);
68              
69 4         25124 @words = split /\n/, $spellcheck_results;
70              
71 4 100       57 die "spellchecker had errors: $errors" if length $errors;
72              
73 3         22 1;
74             };
75              
76 16 100       41956 if ($ok) {
77             # remember the one we used, so that it's consistent for all the files
78             # this run, and we don't keep retrying the same spellcheckers that will
79             # never work. also we need to expose the spellchecker we're using in
80             # has_working_spellchecker
81 3 50       32 set_spell_cmd($spellchecker)
82             if !$SPELLCHECKER;
83 3         47 return @words;
84             }
85              
86 13         130 push @errors, "Unable to run '$spellchecker': $@";
87             }
88              
89             # no working spellcheckers during a dry run
90 4 100       138 return \"no spellchecker" if $dryrun;
91              
92             # no working spellcheckers; report all the errors
93 1         22 require Carp;
94             Carp::croak
95             "Unable to find a working spellchecker:\n"
96 1         13 . join("\n", map { " $_\n" } @errors)
  1         478  
97             }
98              
99             sub invalid_words_in {
100 4     4 0 21 my $file = shift;
101              
102 4         9 my $document = '';
103 4     1   88 open my $handle, '>', \$document;
  1         6  
  1         2  
  1         6  
104             # the UTF-8 parsing seems to have broken many tests
105             #open my $infile, '<:encoding(UTF-8)', $file;
106              
107             # save digested POD to the string $document
108             #get_pod_parser()->parse_from_filehandle($infile, $handle);
109 4         717 get_pod_parser()->parse_from_file($file, $handle);
110 4         406013 my @words = _get_spellcheck_results($document);
111              
112 3         29 chomp for @words;
113 3         123 return @words;
114             }
115              
116             sub pod_file_spelling_ok {
117 4     4 1 324 my $file = shift;
118 4   33     38 my $name = shift || "POD spelling for $file";
119              
120 4 50       112 if (!-r $file) {
121 0         0 $TEST->ok(0, $name);
122 0         0 $TEST->diag("$file does not exist or is unreadable");
123 0         0 return;
124             }
125              
126 4         38 my @words = invalid_words_in($file);
127              
128             # remove stopwords, select unique errors
129 3         22 my $WL = \%Pod::Wordlist::Wordlist;
130 3   33     27 @words = grep { !$WL->{$_} && !$WL->{lc $_} } @words;
  1         51  
131 3         28 $ALL_WORDS{$_}++ for @words;
132 3         10 my %seen;
133 3         18 @seen{@words} = ();
134 3         23 @words = sort keys %seen;
135              
136             # emit output
137 3         24 my $ok = @words == 0;
138 3         149 $TEST->ok($ok, "$name");
139 3 100       3149 if (!$ok) {
140 1         18 $TEST->diag("Errors:\n" . join '', map { " $_\n" } @words);
  1         33  
141             }
142              
143 3         278 return $ok;
144             }
145              
146             sub all_pod_files_spelling_ok {
147 0     0 1 0 my @files = all_pod_files(@_);
148 0         0 local %ALL_WORDS;
149 0 0       0 if (!has_working_spellchecker()) {
150 0         0 return $TEST->plan(skip_all => "no working spellchecker found");
151             }
152              
153 0         0 $TEST->plan(tests => scalar @files);
154              
155 0         0 my $ok = 1;
156 0         0 for my $file (@files) {
157 0         0 local $Test::Builder::Level = $Test::Builder::Level + 1;
158 0 0       0 pod_file_spelling_ok($file) or undef $ok;
159             }
160 0 0       0 if ( keys %ALL_WORDS ) {
161             # Invert k => v to v => [ k ]
162 0         0 my %values;
163 0         0 push @{ $values{ $ALL_WORDS{$_} } }, $_ for keys %ALL_WORDS;
  0         0  
164              
165 0         0 my $labelformat = q[%6s: ];
166 0         0 my $indent = q[ ] x 10;
167              
168             $TEST->diag(qq[\nAll incorrect words, by number of occurrences:\n] .
169 0         0 join qq[\n], map { wrap( ( sprintf $labelformat, $_ ), $indent, join q[, ], sort @{ $values{$_} } ) }
  0         0  
170 0         0 sort { $a <=> $b } keys %values
  0         0  
171             );
172             }
173 0         0 return $ok;
174             }
175              
176             sub all_pod_files {
177 0 0   0 1 0 my @queue = @_ ? @_ : _starting_points();
178 0         0 my @pod;
179              
180 0         0 while (@queue) {
181 0         0 my $file = shift @queue;
182              
183             # recurse into subdirectories
184 0 0       0 if (-d $file) {
185 0 0       0 opendir(my $dirhandle, $file) or next;
186 0         0 my @newfiles = readdir($dirhandle);
187 0         0 closedir $dirhandle;
188              
189 0         0 @newfiles = File::Spec->no_upwards(@newfiles);
190 0 0       0 @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;
  0         0  
191              
192 0         0 push @queue, map "$file/$_", @newfiles;
193             }
194              
195             # add the file if it meets our criteria
196 0 0       0 if (-f $file) {
197 0 0       0 next unless _is_perl($file);
198 0 0       0 next unless $FILE_FILTER->($file);
199 0         0 push @pod, $file;
200             }
201             }
202              
203 0         0 return @pod;
204             }
205              
206             sub _starting_points {
207 0 0   0   0 return 'blib' if -d 'blib';
208 0         0 return 'lib';
209             }
210              
211             sub _is_perl {
212 0     0   0 my $file = shift;
213              
214 0 0       0 return 1 if $file =~ /\.PL$/;
215 0 0       0 return 1 if $file =~ /\.p(l|lx|m|od)$/;
216 0 0       0 return 1 if $file =~ /\.t$/;
217              
218 0 0       0 open my $handle, '<', $file or return;
219 0         0 my $first = <$handle>;
220              
221 0 0 0     0 return 1 if defined $first && ($first =~ /^#!.*perl/);
222              
223 0         0 return 0;
224             }
225              
226             sub add_stopwords {
227 1     1 1 10 for (@_) {
228             # explicit copy so we don't modify constants as in add_stopwords("SQLite")
229 1         31 my $word = $_;
230              
231             # XXX: the processing this performs is to support "perl t/spell.t 2>>
232             # t/spell.t" which is bunk. in the near future the processing here will
233             # become more modern
234 1         16 $word =~ s/^#?\s*//;
235 1         9 $word =~ s/\s+$//;
236 1 50 33     25 next if $word =~ /\s/ or $word =~ /:/;
237 1         15 $Pod::Wordlist::Wordlist{$word} = 1;
238             }
239             }
240              
241             sub set_spell_cmd {
242 2     2 1 116 $SPELLCHECKER = shift;
243             }
244              
245             sub set_pod_file_filter {
246 0     0 1 0 $FILE_FILTER = shift;
247             }
248              
249             # A new Pod::Spell object should be used for every file; people
250             # providing custom pod parsers will have to do this themselves
251             sub get_pod_parser {
252 4   33 4 1 102 return $POD_PARSER || Pod::Spell->new;
253             }
254              
255             sub set_pod_parser {
256 0     0 1 0 $POD_PARSER = shift;
257             }
258              
259             1;
260              
261             __END__