File Coverage

blib/lib/Perl/Critic/Policy/Documentation/PodSpelling.pm
Criterion Covered Total %
statement 57 131 43.5
branch 5 42 11.9
condition 1 6 16.6
subroutine 20 31 64.5
pod 5 7 71.4
total 88 217 40.5


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::Documentation::PodSpelling;
2              
3 40     40   28799 use 5.010001;
  40         181  
4 40     40   236 use strict;
  40         101  
  40         858  
5 40     40   203 use warnings;
  40         104  
  40         1276  
6              
7 40     40   238 use English qw(-no_match_vars);
  40         96  
  40         241  
8 40     40   14672 use Readonly;
  40         100  
  40         1938  
9              
10 40     40   271 use File::Spec;
  40         117  
  40         1014  
11 40     40   10966 use File::Temp;
  40         122120  
  40         3902  
12 40     40   317 use List::SomeUtils qw(uniq);
  40         98  
  40         2211  
13 40     40   21389 use Pod::Spell qw< >;
  40         1380148  
  40         1150  
14 40     40   19319 use Text::ParseWords qw< >;
  40         55034  
  40         1472  
15              
16 40         3365 use Perl::Critic::Utils qw{
17             :characters
18             :booleans
19             :severities
20             words_from_string
21 40     40   348 };
  40         126  
22 40     40   14985 use Perl::Critic::Exception::Fatal::Generic qw{ throw_generic };
  40         124  
  40         3532  
23              
24 40     40   314 use parent 'Perl::Critic::Policy';
  40         109  
  40         352  
25              
26             our $VERSION = '1.146';
27              
28             #-----------------------------------------------------------------------------
29              
30             Readonly::Scalar my $POD_RX => qr{\A = (?: for|begin|end ) }xms;
31             Readonly::Scalar my $DESC => q{Check the spelling in your POD};
32             Readonly::Scalar my $EXPL => [148];
33              
34             #-----------------------------------------------------------------------------
35              
36             sub supported_parameters {
37             return (
38             {
39 94     94 0 2554 name => 'spell_command',
40             description => 'The command to invoke to check spelling.',
41             default_string => 'aspell list',
42             behavior => 'string',
43             },
44             {
45             name => 'stop_words',
46             description => 'The words to not consider as misspelled.',
47             default_string => $EMPTY,
48             behavior => 'string list',
49             },
50             {
51             name => 'stop_words_file',
52             description => 'A file containing words to not consider as misspelled.',
53             default_string => $EMPTY,
54             behavior => 'string',
55             },
56             );
57             }
58              
59 84     84 1 376 sub default_severity { return $SEVERITY_LOWEST }
60 89     89 1 406 sub default_themes { return qw( core cosmetic pbp ) }
61 0     0 1 0 sub applies_to { return 'PPI::Document' }
62              
63             #-----------------------------------------------------------------------------
64              
65             my $got_sigpipe = 0;
66             sub got_sigpipe {
67 0     0 0 0 return $got_sigpipe;
68             }
69              
70             #-----------------------------------------------------------------------------
71              
72             sub initialize_if_enabled {
73 22     22 1 94 my ( $self, $config ) = @_;
74              
75 22 50       67 eval { require File::Which; 1 } or return $FALSE;
  22         3773  
  22         6128  
76              
77 22 50       142 return $FALSE if not $self->_derive_spell_command_line();
78              
79 0         0 my $test_code = <<'END_TEST_CODE';
80             ;pod
81              
82             ;head1 Test The Spell Command
83              
84             ;cut
85             END_TEST_CODE
86 0         0 $test_code =~ s/^;/=/msx;
87 0 0       0 return $FALSE if not $self->_run_spell_command($test_code);
88              
89 0         0 $self->_load_stop_words_file();
90              
91 0         0 return $TRUE;
92             }
93              
94             #-----------------------------------------------------------------------------
95              
96             sub violates {
97 0     0 1 0 my ( $self, $elem, $doc ) = @_;
98              
99 0         0 my $code = $doc->serialize();
100              
101 0         0 my $words = $self->_run_spell_command($code);
102              
103 0 0       0 return if not $words; # error running spell command
104              
105 0 0       0 return if not @{$words}; # no problems found
  0         0  
106              
107 0         0 return $self->violation( "$DESC: @{$words}", $EXPL, $doc );
  0         0  
108             }
109              
110             #-----------------------------------------------------------------------------
111              
112             sub _derive_spell_command_line {
113 22     22   77 my ($self) = @_;
114              
115 22         122 my @words = Text::ParseWords::shellwords($self->_get_spell_command());
116 22 50       2873 if (!@words) {
117 0         0 return;
118             }
119 22 50       295 if (! File::Spec->file_name_is_absolute($words[0])) {
120 22         446 $words[0] = File::Which::which($words[0]);
121             }
122 22 50 33     6024 if (! $words[0] || ! -x $words[0]) {
123 22         167 return;
124             }
125 0         0 $self->_set_spell_command_line(\@words);
126              
127 0         0 return $self->_get_spell_command_line();
128             }
129              
130             #-----------------------------------------------------------------------------
131              
132             sub _get_spell_command {
133 22     22   68 my ( $self ) = @_;
134              
135 22         162 return $self->{_spell_command};
136             }
137              
138             #-----------------------------------------------------------------------------
139              
140             sub _get_spell_command_line {
141 1     1   7 my ( $self ) = @_;
142              
143 1         29 return $self->{_spell_command_line};
144             }
145              
146             sub _set_spell_command_line {
147 0     0     my ( $self, $spell_command_line ) = @_;
148              
149 0           $self->{_spell_command_line} = $spell_command_line;
150              
151 0           return;
152             }
153              
154             #-----------------------------------------------------------------------------
155              
156             sub _get_stop_words {
157 0     0     my ( $self ) = @_;
158              
159 0           return $self->{_stop_words};
160             }
161              
162             sub _set_stop_words {
163 0     0     my ( $self, $stop_words ) = @_;
164              
165 0           $self->{_stop_words} = $stop_words;
166              
167 0           return;
168             }
169              
170             #-----------------------------------------------------------------------------
171              
172             sub _get_stop_words_file {
173 0     0     my ( $self ) = @_;
174              
175 0           return $self->{_stop_words_file};
176             }
177              
178             #-----------------------------------------------------------------------------
179              
180             sub _run_spell_command {
181 0     0     my ($self, $code) = @_;
182              
183 0           my $outfh = File::Temp->new();
184              
185 0           my $outfile = $outfh->filename();
186 0           my @words;
187              
188 0           local $EVAL_ERROR = undef;
189              
190             eval {
191             # temporarily add our special wordlist to this annoying global
192             local %Pod::Wordlist::Wordlist = ## no critic (ProhibitPackageVars)
193 0           %{ $self->_get_stop_words() };
  0            
194              
195 0 0         open my $infh, '<', \$code
196             or throw_generic "error opening scalar: $OS_ERROR";
197              
198 0           Pod::Spell->new()->parse_from_filehandle($infh, $outfh);
199 0 0         close $infh or throw_generic "Failed to close in memory file: $OS_ERROR";
200 0 0         close $outfh or throw_generic "Failed to close pod temp file: $OS_ERROR";
201 0 0         return if not -s $outfile; # Bail out if no words to spellcheck
202              
203             # run spell command and fetch output
204 0     0     local $SIG{PIPE} = sub { $got_sigpipe = 1; };
  0            
205 0           my $command_line = join $SPACE, @{$self->_get_spell_command_line()};
  0            
206 0 0         open my $aspell_out_fh, q{-|}, "$command_line < $outfile" ## Is this portable??
207             or throw_generic "Failed to open handle to spelling program: $OS_ERROR";
208              
209 0           @words = uniq( <$aspell_out_fh> );
210 0 0         close $aspell_out_fh
211             or throw_generic "Failed to close handle to spelling program: $OS_ERROR";
212              
213 0           chomp @words;
214              
215             # Why is this extra step needed???
216 0           @words = grep { not exists $Pod::Wordlist::Wordlist{$_} } @words; ## no critic (ProhibitPackageVars)
  0            
217 0           1;
218             }
219 0 0         or do {
220             # Eat anything we did ourselves above, propagate anything else.
221 0 0 0       if (
222             $EVAL_ERROR
223             and not ref Perl::Critic::Exception::Fatal::Generic->caught()
224             ) {
225 0 0         ref $EVAL_ERROR ? $EVAL_ERROR->rethrow() : die $EVAL_ERROR; ## no critic (ErrorHandling::RequireCarping)
226             }
227              
228 0           return;
229             };
230              
231 0           return [ @words ];
232             }
233              
234             #-----------------------------------------------------------------------------
235              
236             sub _load_stop_words_file {
237 0     0     my ($self) = @_;
238              
239 0           my %stop_words = %{ $self->_get_stop_words() };
  0            
240              
241 0 0         my $file_name = $self->_get_stop_words_file() or return;
242              
243             open my $handle, '<', $file_name
244 0 0         or do { warn qq<Could not open "$file_name": $OS_ERROR\n>; return; };
  0            
  0            
245              
246 0           while ( my $line = <$handle> ) {
247 0 0         if ( my $word = _word_from_line($line) ) {
248 0           $stop_words{$word} = 1;
249             }
250             }
251              
252 0 0         close $handle or warn qq<Could not close "$file_name": $OS_ERROR\n>;
253              
254 0           $self->_set_stop_words(\%stop_words);
255              
256 0           return;
257             }
258              
259             sub _word_from_line {
260 0     0     my ($line) = @_;
261              
262 0           $line =~ s< [#] .* \z ><>xms;
263 0           $line =~ s< \s+ \z ><>xms;
264 0           $line =~ s< \A \s+ ><>xms;
265              
266 0           return $line;
267             }
268              
269             #-----------------------------------------------------------------------------
270              
271             1;
272              
273             __END__
274              
275             #-----------------------------------------------------------------------------
276              
277             =pod
278              
279             =for stopwords foobie foobie-bletch Hmm stopwords
280              
281             =head1 NAME
282              
283             Perl::Critic::Policy::Documentation::PodSpelling - Check your spelling.
284              
285              
286             =head1 AFFILIATION
287              
288             This Policy is part of the core L<Perl::Critic|Perl::Critic>
289             distribution.
290              
291              
292             =head1 DESCRIPTION
293              
294             Did you write the documentation? Check.
295              
296             Did you document all of the public methods? Check.
297              
298             Is your documentation readable? Hmm...
299              
300             Ideally, we'd like Perl::Critic to tell you when your documentation is
301             inadequate. That's hard to code, though. So, inspired by
302             L<Test::Spelling|Test::Spelling>, this module checks the spelling of
303             your POD. It does this by pulling the prose out of the code and
304             passing it to an external spell checker. It skips over words you
305             flagged to ignore. If the spell checker returns any misspelled words,
306             this policy emits a violation.
307              
308             If anything else goes wrong -- we can't locate the spell checking program or
309             (gasp!) your module has no POD -- then this policy passes.
310              
311             To add exceptions on a module-by-module basis, add "stopwords" as
312             described in L<Pod::Spell|Pod::Spell>. For example:
313              
314             =for stopwords gibbles
315              
316             =head1 Gibble::Manip -- manipulate your gibbles
317              
318             =cut
319              
320              
321             =head1 CONFIGURATION
322              
323             This policy can be configured to tell which spell checker to use or to
324             set a global list of spelling exceptions. To do this, put entries in
325             a F<.perlcriticrc> file like this:
326              
327             [Documentation::PodSpelling]
328             spell_command = aspell list
329             stop_words = gibbles foobar
330             stop_words_file = some/path/with/stop/words.txt
331              
332             The default spell command is C<aspell list> and it is interpreted as a
333             shell command. We parse the individual arguments via
334             L<Text::ParseWords|Text::ParseWords> so feel free to use quotes around
335             your arguments. If the executable path is an absolute file name, it
336             is used as-is. If it is a relative file name, we employ
337             L<File::Which|File::Which> to convert it to an absolute path via the
338             C<PATH> environment variable. As described in Pod::Spell and
339             Test::Spelling, the spell checker must accept text on STDIN and print
340             misspelled words one per line on STDOUT.
341              
342             You can specify global stop words via the C<stop_words> and
343             C<stop_words_file> options. The former is simply split up on
344             whitespace. The latter is looked at line by line, with anything after
345             an octothorp ("#") removed and then leading and trailing whitespace
346             removed. Silly example valid file contents:
347              
348             # It's a comment!
349              
350             foo
351             arglbargl # Some other comment.
352             bar
353              
354             The values from C<stop_words> and C<stop_words_file> are merged
355             together into a single list of exemptions.
356              
357              
358             =head1 NOTES
359              
360             A spell checking program is not included with Perl::Critic.
361              
362             The results of failures for this policy can be confusing when F<aspell>
363             complains about words containing punctuation such as hyphens and apostrophes.
364             In this situation F<aspell> will often only emit part of the word that it
365             thinks is misspelled. For example, if you ask F<aspell> to check
366             "foobie-bletch", the output only complains about "foobie". Unfortunately,
367             you'll have to look through your POD to figure out what the real word that
368             F<aspell> is complaining about is. One thing to try is looking at the output
369             of C<< perl -MPod::Spell -e 'print
370             Pod::Spell->new()->parse_from_file("lib/Your/Module.pm")' >> to see what is
371             actually being checked for spelling.
372              
373              
374             =head1 PREREQUISITES
375              
376             This policy will disable itself if L<File::Which|File::Which> is not
377             available.
378              
379              
380             =head1 CREDITS
381              
382             Initial development of this policy was supported by a grant from the
383             Perl Foundation.
384              
385              
386             =head1 AUTHOR
387              
388             Chris Dolan <cdolan@cpan.org>
389              
390              
391             =head1 COPYRIGHT
392              
393             Copyright (c) 2007-2021 Chris Dolan. Many rights reserved.
394              
395             This program is free software; you can redistribute it and/or modify
396             it under the same terms as Perl itself. The full text of this license
397             can be found in the LICENSE file included with this module
398              
399             =cut
400              
401             # Local Variables:
402             # mode: cperl
403             # cperl-indent-level: 4
404             # fill-column: 78
405             # indent-tabs-mode: nil
406             # c-indentation-style: bsd
407             # End:
408             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :