git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/Documentation/PodSpelling.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Documentation/PodSpelling.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::Documentation::PodSpelling;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15 use Readonly;
  16
  17 use File::Spec;
  18 use File::Temp;
  19 use List::MoreUtils qw(uniq);
  20
  21 use Perl::Critic::Utils qw{
  22     :characters
  23     :booleans
  24     :severities
  25     words_from_string
  26 };
  27 use Perl::Critic::Exception::Fatal::Generic qw{ throw_generic };
  28
  29 use base 'Perl::Critic::Policy';
  30
  31 our $VERSION = '1.088';
  32
  33 #-----------------------------------------------------------------------------
  34
  35 Readonly::Scalar my $POD_RX => qr{\A = (?: for|begin|end ) }mx;
  36 Readonly::Scalar my $DESC => q{Check the spelling in your POD};
  37 Readonly::Scalar my $EXPL => [148];
  38
  39 #-----------------------------------------------------------------------------
  40
  41 sub supported_parameters {
  42     return (
  43         {
  44             name            => 'spell_command',
  45             description     => 'The command to invoke to check spelling.',
  46             default_string  => 'aspell list',
  47             behavior        => 'string',
  48         },
  49         {
  50             name            => 'stop_words',
  51             description     => 'The words to not consider as misspelled.',
  52             default_string  => $EMPTY,
  53             behavior        => 'string list',
  54         },
  55     );
  56 }
  57
  58 sub default_severity     { return $SEVERITY_LOWEST        }
  59 sub default_themes       { return qw( core cosmetic pbp ) }
  60 sub applies_to           { return 'PPI::Document'         }
  61
  62 #-----------------------------------------------------------------------------
  63
  64 my $got_sigpipe = 0;
  65 sub got_sigpipe {
  66     return $got_sigpipe;
  67 }
  68
  69 #-----------------------------------------------------------------------------
  70
  71 sub initialize_if_enabled {
  72     my ( $self, $config ) = @_;
  73
  74     eval {
  75         require File::Which;
  76         require Text::ParseWords;
  77         require Pod::Spell;
  78         require IO::String;
  79     }
  80         or return $FALSE;
  81
  82     return $FALSE if not $self->_derive_spell_command_line();
  83
  84     return $FALSE if not $self->_run_spell_command( <<'END_TEST_CODE' );
  85 =pod
  86
  87 =head1 Test The Spell Command
  88
  89 =cut
  90 END_TEST_CODE
  91
  92     return $TRUE;
  93 }
  94
  95 #-----------------------------------------------------------------------------
  96
  97 sub violates {
  98     my ( $self, $elem, $doc ) = @_;
  99
 100     my $code = $doc->serialize();
 101
 102     my $words = $self->_run_spell_command($code);
 103
 104     return if not $words;       # error running spell command
 105
 106     return if not @{$words};    # no problems found
 107
 108     return $self->violation( "$DESC: @{$words}", $EXPL, $doc );
 109 }
 110
 111 #-----------------------------------------------------------------------------
 112
 113 sub _derive_spell_command_line {
 114     my ($self) = @_;
 115
 116     my @words = Text::ParseWords::shellwords($self->_get_spell_command());
 117     if (!@words) {
 118         return;
 119     }
 120     if (! File::Spec->file_name_is_absolute($words[0])) {
 121        $words[0] = File::Which::which($words[0]);
 122     }
 123     if (! $words[0] || ! -x $words[0]) {
 124         return;
 125     }
 126     $self->_set_spell_command_line(\@words);
 127
 128     return $self->_get_spell_command_line();
 129 }
 130
 131 #-----------------------------------------------------------------------------
 132
 133 sub _get_spell_command {
 134     my ( $self ) = @_;
 135
 136     return $self->{_spell_command};
 137 }
 138
 139 sub _set_spell_command {
 140     my ( $self, $spell_command ) = @_;
 141
 142     $self->{_spell_command} = $spell_command;
 143
 144     return;
 145 }
 146
 147 #-----------------------------------------------------------------------------
 148
 149 sub _get_spell_command_line {
 150     my ( $self ) = @_;
 151
 152     return $self->{_spell_command_line};
 153 }
 154
 155 sub _set_spell_command_line {
 156     my ( $self, $spell_command_line ) = @_;
 157
 158     $self->{_spell_command_line} = $spell_command_line;
 159
 160     return;
 161 }
 162
 163 #-----------------------------------------------------------------------------
 164
 165 sub _get_stop_words {
 166     my ( $self ) = @_;
 167
 168     return $self->{_stop_words};
 169 }
 170
 171 sub _set_stop_words {
 172     my ( $self, $stop_words ) = @_;
 173
 174     $self->{_stop_words} = $stop_words;
 175
 176     return;
 177 }
 178
 179 #-----------------------------------------------------------------------------
 180
 181 sub _run_spell_command {
 182     my ($self, $code) = @_;
 183
 184     my $infh = IO::String->new( $code );
 185
 186     my $outfh = File::Temp->new()
 187       or throw_generic "Unable to create tempfile: $OS_ERROR";
 188
 189     my $outfile = $outfh->filename();
 190     my @words;
 191
 192     local $EVAL_ERROR = undef;
 193
 194     eval {
 195         # temporarily add our special wordlist to this annoying global
 196         local %Pod::Wordlist::Wordlist =    ##no critic(ProhibitPackageVars)
 197             %{ $self->_get_stop_words() };
 198
 199         Pod::Spell->new()->parse_from_filehandle($infh, $outfh);
 200         close $outfh or throw_generic "Failed to close pod temp file: $OS_ERROR";
 201         return if not -s $outfile; # Bail out if no words to spellcheck
 202
 203         # run spell command and fetch output
 204         local $SIG{PIPE} = sub { $got_sigpipe = 1; };
 205         my $command_line = join $SPACE, @{$self->_get_spell_command_line()};
 206         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         @words = uniq( <$aspell_out_fh> );
 210         close $aspell_out_fh
 211             or throw_generic "Failed to close handle to spelling program: $OS_ERROR";
 212
 213         for (@words) {
 214             chomp;
 215         }
 216
 217         # Why is this extra step needed???
 218         @words = grep { not exists $Pod::Wordlist::Wordlist{$_} } @words;  ## no critic(ProhibitPackageVars)
 219         1;
 220     }
 221         or do {
 222             # Eat anything we did ourselves above, propagate anything else.
 223             if (
 224                     $EVAL_ERROR
 225                 and not ref Perl::Critic::Exception::Fatal::Generic->caught()
 226             ) {
 227                 ref $EVAL_ERROR ? $EVAL_ERROR->rethrow() : die $EVAL_ERROR;  ## no critic (ErrorHandling::RequireCarping)
 228             }
 229
 230             return;
 231         };
 232
 233     return [ @words ];
 234 }
 235
 236 #-----------------------------------------------------------------------------
 237
 238 1;
 239
 240 __END__
 241
 242 #-----------------------------------------------------------------------------
 243
 244 =pod
 245
 246 =for stopwords Hmm stopwords
 247
 248 =head1 NAME
 249
 250 Perl::Critic::Policy::Documentation::PodSpelling - Check your spelling.
 251
 252 =head1 AFFILIATION
 253
 254 This Policy is part of the core L<Perl::Critic> distribution.
 255
 256
 257 =head1 DESCRIPTION
 258
 259 Did you write the documentation?  Check.
 260
 261 Did you document all of the public methods?  Check.
 262
 263 Is your documentation readable?  Hmm...
 264
 265 Ideally, we'd like Perl::Critic to tell you when your documentation is
 266 inadequate.  That's hard to code, though.  So, inspired by
 267 L<Test::Spelling>, this module checks the spelling of your POD.  It
 268 does this by pulling the prose out of the code and passing it to an
 269 external spell checker.  It skips over words you flagged to ignore.
 270 If the spell checker returns any misspelled words, this policy emits a
 271 violation.
 272
 273 If anything else goes wrong -- you don't have Pod::Spell installed or
 274 we can't locate the spell checking program or (gasp!) your module has
 275 no POD -- then this policy passes.
 276
 277 To add exceptions on a module-by-module basis, add "stopwords" as
 278 described in L<Pod::Spell>.  For example:
 279
 280    =for stopword gibbles
 281
 282    =head1 Gibble::Manip -- manipulate your gibbles
 283
 284    =cut
 285
 286 =head1 CONFIGURATION
 287
 288 This policy can be configured to tell which spell checker to use or to
 289 set a global list of spelling exceptions.  To do this, put entries in
 290 a F<.perlcriticrc> file like this:
 291
 292   [Documentation::PodSpelling]
 293   spell_command = aspell list
 294   stop_words = gibbles foobar
 295
 296 The default spell command is C<aspell list> and it is interpreted as a
 297 shell command.  We parse the individual arguments via
 298 L<Text::ParseWords> so feel free to use quotes around your arguments.
 299 If the executable path is an absolute file name, it is used as-is.  If
 300 it is a relative file name, we employ L<File::Which> to convert it to
 301 an absolute path via the C<PATH> environment variable.  As described
 302 in Pod::Spell and Test::Spelling, the spell checker must accept text
 303 on STDIN and print misspelled words one per line on STDOUT.
 304
 305 =head1 NOTES
 306
 307 L<Pod::Spell> is not included with Perl::Critic, nor is a spell
 308 checking program.
 309
 310 =head1 CREDITS
 311
 312 Initial development of this policy was supported by a grant from the Perl Foundation.
 313
 314 =head1 AUTHOR
 315
 316 Chris Dolan <cdolan@cpan.org>
 317
 318 =head1 COPYRIGHT
 319
 320 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 321
 322 This program is free software; you can redistribute it and/or modify
 323 it under the same terms as Perl itself.  The full text of this license
 324 can be found in the LICENSE file included with this module
 325
 326 =cut
 327
 328 # Local Variables:
 329 #   mode: cperl
 330 #   cperl-indent-level: 4
 331 #   fill-column: 78
 332 #   indent-tabs-mode: nil
 333 #   c-indentation-style: bsd
 334 # End:
 335 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :