Commit | Line | Data |
---|---|---|
6036a254 | 1 | ############################################################################## |
a73f4a71 JRT |
2 | # $URL$ |
3 | # $Date$ | |
4 | # $Author$ | |
5 | # $Revision$ | |
6036a254 | 6 | ############################################################################## |
5bf96118 CD |
7 | |
8 | package Perl::Critic::Document; | |
9 | ||
df6dee2b | 10 | use 5.006001; |
5bf96118 | 11 | use strict; |
58a9e587 | 12 | use warnings; |
267b39b4 ES |
13 | |
14 | use List::Util qw< max >; | |
5bf96118 | 15 | use PPI::Document; |
267b39b4 ES |
16 | use Scalar::Util qw< weaken >; |
17 | use version; | |
5bf96118 | 18 | |
6036a254 | 19 | #----------------------------------------------------------------------------- |
58a9e587 | 20 | |
173667ce | 21 | our $VERSION = '1.093_01'; |
5bf96118 | 22 | |
6036a254 | 23 | #----------------------------------------------------------------------------- |
5bf96118 CD |
24 | |
25 | our $AUTOLOAD; | |
937b8de0 | 26 | sub AUTOLOAD { ## no critic (ProhibitAutoloading,ArgUnpacking) |
6e7d6c9f CD |
27 | my ( $function_name ) = $AUTOLOAD =~ m/ ([^:\']+) \z /xms; |
28 | return if $function_name eq 'DESTROY'; | |
29 | my $self = shift; | |
30 | return $self->{_doc}->$function_name(@_); | |
5bf96118 CD |
31 | } |
32 | ||
6036a254 | 33 | #----------------------------------------------------------------------------- |
5bf96118 | 34 | |
58a9e587 JRT |
35 | sub new { |
36 | my ($class, $doc) = @_; | |
937b8de0 JRT |
37 | my $self = bless {}, $class; |
38 | $self->{_disabled_lines} = _unfix_shebang($doc); | |
39 | $self->{_doc} = $doc; | |
40 | return $self; | |
5bf96118 CD |
41 | } |
42 | ||
6036a254 | 43 | #----------------------------------------------------------------------------- |
58a9e587 | 44 | |
2b6293b2 CD |
45 | sub ppi_document { |
46 | my ($self) = @_; | |
47 | return $self->{_doc}; | |
48 | } | |
49 | ||
50 | #----------------------------------------------------------------------------- | |
51 | ||
47e1ff34 | 52 | sub isa { |
6e7d6c9f CD |
53 | my ($self, @args) = @_; |
54 | return $self->SUPER::isa(@args) | |
55 | || ( (ref $self) && $self->{_doc} && $self->{_doc}->isa(@args) ); | |
47e1ff34 CD |
56 | } |
57 | ||
6036a254 | 58 | #----------------------------------------------------------------------------- |
47e1ff34 | 59 | |
5bf96118 | 60 | sub find { |
6e7d6c9f | 61 | my ($self, $wanted, @more_args) = @_; |
5bf96118 | 62 | |
58a9e587 JRT |
63 | # This method can only find elements by their class names. For |
64 | # other types of searches, delegate to the PPI::Document | |
5bf96118 | 65 | if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) { |
6e7d6c9f | 66 | return $self->{_doc}->find($wanted, @more_args); |
5bf96118 | 67 | } |
58a9e587 JRT |
68 | |
69 | # Build the class cache if it doesn't exist. This happens at most | |
70 | # once per Perl::Critic::Document instance. %elements of will be | |
71 | # populated as a side-effect of calling the $finder_sub coderef | |
72 | # that is produced by the caching_finder() closure. | |
5bf96118 | 73 | if ( !$self->{_elements_of} ) { |
389109ec | 74 | |
58a9e587 | 75 | my %cache = ( 'PPI::Document' => [ $self ] ); |
389109ec JRT |
76 | |
77 | # The cache refers to $self, and $self refers to the cache. This | |
78 | # creates a circular reference that leaks memory (i.e. $self is not | |
79 | # destroyed until execution is complete). By weakening the reference, | |
80 | # we allow perl to collect the garbage properly. | |
81 | weaken( $cache{'PPI::Document'}->[0] ); | |
82 | ||
58a9e587 JRT |
83 | my $finder_coderef = _caching_finder( \%cache ); |
84 | $self->{_doc}->find( $finder_coderef ); | |
85 | $self->{_elements_of} = \%cache; | |
86 | } | |
87 | ||
88 | # find() must return false-but-defined on fail | |
89 | return $self->{_elements_of}->{$wanted} || q{}; | |
90 | } | |
91 | ||
6036a254 | 92 | #----------------------------------------------------------------------------- |
58a9e587 | 93 | |
fb21e21e | 94 | sub find_first { |
6e7d6c9f | 95 | my ($self, $wanted, @more_args) = @_; |
fb21e21e CD |
96 | |
97 | # This method can only find elements by their class names. For | |
98 | # other types of searches, delegate to the PPI::Document | |
99 | if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) { | |
6e7d6c9f | 100 | return $self->{_doc}->find_first($wanted, @more_args); |
fb21e21e CD |
101 | } |
102 | ||
103 | my $result = $self->find($wanted); | |
104 | return $result ? $result->[0] : $result; | |
105 | } | |
106 | ||
6036a254 | 107 | #----------------------------------------------------------------------------- |
fb21e21e | 108 | |
f5eeac3b | 109 | sub find_any { |
6e7d6c9f | 110 | my ($self, $wanted, @more_args) = @_; |
f5eeac3b CD |
111 | |
112 | # This method can only find elements by their class names. For | |
113 | # other types of searches, delegate to the PPI::Document | |
114 | if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) { | |
6e7d6c9f | 115 | return $self->{_doc}->find_any($wanted, @more_args); |
f5eeac3b CD |
116 | } |
117 | ||
118 | my $result = $self->find($wanted); | |
119 | return $result ? 1 : $result; | |
120 | } | |
121 | ||
6036a254 | 122 | #----------------------------------------------------------------------------- |
f5eeac3b | 123 | |
60108aef CD |
124 | sub filename { |
125 | my ($self) = @_; | |
126 | return $self->{_doc}->can('filename') ? $self->{_doc}->filename : undef; | |
127 | } | |
128 | ||
6036a254 | 129 | #----------------------------------------------------------------------------- |
60108aef | 130 | |
267b39b4 ES |
131 | sub highest_explicit_perl_version { |
132 | my ($self) = @_; | |
133 | ||
134 | my $highest_explicit_perl_version = | |
135 | $self->{_highest_explicit_perl_version}; | |
136 | ||
137 | if ( not exists $self->{_highest_explicit_perl_version} ) { | |
138 | my $includes = $self->find( \&_is_a_version_statement ); | |
139 | ||
140 | if ($includes) { | |
1ebef5a9 ES |
141 | # Note: this will complain about underscores, e.g. "use |
142 | # 5.008_000". However, nothing important should be depending upon | |
143 | # alpha perl versions and marking non-alpha versions as alpha is | |
144 | # bad in and of itself. Note that this contradicts an example in | |
145 | # perlfunc about "use". | |
267b39b4 ES |
146 | $highest_explicit_perl_version = |
147 | max map { version->new( $_->version() ) } @{$includes}; | |
148 | } | |
149 | else { | |
150 | $highest_explicit_perl_version = undef; | |
151 | } | |
152 | ||
153 | $self->{_highest_explicit_perl_version} = | |
154 | $highest_explicit_perl_version; | |
155 | } | |
156 | ||
157 | return $highest_explicit_perl_version if $highest_explicit_perl_version; | |
158 | return; | |
159 | } | |
160 | ||
937b8de0 JRT |
161 | #----------------------------------------------------------------------------- |
162 | ||
163 | sub mark_disabled_lines { | |
164 | my ($self, @site_policies) = @_; | |
165 | my %disabled_lines = _find_disabled_lines($self->{_doc}, @site_policies); | |
166 | ||
167 | # Ick. Need to merge the disabled lines hash with the shebang lines | |
168 | # that we alread disabled during the _unfix_shebang() process. Need | |
169 | # to find a better way to express this. | |
170 | ||
171 | $self->{_disabled_lines} = { %{$self->{_disabled_lines}}, %disabled_lines }; | |
172 | return $self; | |
173 | } | |
174 | ||
175 | #----------------------------------------------------------------------------- | |
176 | ||
afb2d8f5 | 177 | sub is_line_disabled { |
937b8de0 JRT |
178 | my ($self, $line, $policy_name) = @_; |
179 | return 0 if not exists $self->{_disabled_lines}->{$line}; | |
180 | return 1 if $self->{_disabled_lines}->{$line}->{$policy_name}; | |
181 | return 1 if $self->{_disabled_lines}->{$line}->{ALL}; | |
182 | return 0; | |
183 | } | |
184 | ||
185 | #----------------------------------------------------------------------------- | |
186 | ||
95ebf9b0 JRT |
187 | sub useless_no_critic_warnings { |
188 | my ($self, @violations) = @_; | |
4880392e | 189 | |
95ebf9b0 JRT |
190 | my %violation_lines = (); |
191 | for my $violation (@violations) { | |
192 | my $line = $violation->location()->[0]; | |
193 | my $policy_name = $violation->policy(); | |
194 | $violation_lines{$policy_name}->{$line} = 1; | |
195 | } | |
4880392e JRT |
196 | |
197 | ||
95ebf9b0 JRT |
198 | my @warnings = (); |
199 | my $file = $self->filename() || 'UNKNOWN'; | |
4880392e | 200 | |
95ebf9b0 JRT |
201 | my %disabled_lines = %{ $self->{_disabled_lines} }; |
202 | for my $line (keys %disabled_lines) { | |
203 | my %disabled_policies = %{ $disabled_lines{$line} }; | |
204 | for my $policy_name (keys %disabled_policies) { | |
4880392e | 205 | |
fb0f04cd ES |
206 | if ($policy_name eq 'ALL' and not exists $violation_lines{$line}) { |
207 | push | |
208 | @warnings, | |
209 | qq{Useless disabling of all Policies in file "$file" at line $line.}; | |
95ebf9b0 JRT |
210 | } |
211 | elsif (not $violation_lines{$line}->{$policy_name}) { | |
fb0f04cd ES |
212 | push |
213 | @warnings, | |
214 | qq{Useless disabling of $policy_name in file "$file" at line $line.}; | |
95ebf9b0 JRT |
215 | } |
216 | } | |
217 | } | |
4880392e | 218 | |
95ebf9b0 JRT |
219 | return @warnings; |
220 | } | |
221 | ||
222 | #----------------------------------------------------------------------------- | |
223 | ||
267b39b4 ES |
224 | sub _is_a_version_statement { |
225 | my (undef, $element) = @_; | |
226 | ||
227 | return 0 if not $element->isa('PPI::Statement::Include'); | |
228 | return 1 if $element->version(); | |
229 | return 0; | |
230 | } | |
231 | ||
232 | #----------------------------------------------------------------------------- | |
233 | ||
58a9e587 JRT |
234 | sub _caching_finder { |
235 | ||
236 | my $cache_ref = shift; # These vars will persist for the life | |
237 | my %isa_cache = (); # of the code ref that this sub returns | |
238 | ||
239 | ||
240 | # Gather up all the PPI elements and sort by @ISA. Note: if any | |
241 | # instances used multiple inheritance, this implementation would | |
242 | # lead to multiple copies of $element in the $elements_of lists. | |
243 | # However, PPI::* doesn't do multiple inheritance, so we are safe | |
244 | ||
245 | return sub { | |
6e7d6c9f | 246 | my (undef, $element) = @_; |
58a9e587 JRT |
247 | my $classes = $isa_cache{ref $element}; |
248 | if ( !$classes ) { | |
249 | $classes = [ ref $element ]; | |
250 | # Use a C-style loop because we append to the classes array inside | |
251 | for ( my $i = 0; $i < @{$classes}; $i++ ) { ## no critic(ProhibitCStyleForLoops) | |
252 | no strict 'refs'; ## no critic(ProhibitNoStrict) | |
253 | push @{$classes}, @{"$classes->[$i]::ISA"}; | |
254 | $cache_ref->{$classes->[$i]} ||= []; | |
5bf96118 | 255 | } |
58a9e587 JRT |
256 | $isa_cache{$classes->[0]} = $classes; |
257 | } | |
5bf96118 | 258 | |
58a9e587 JRT |
259 | for my $class ( @{$classes} ) { |
260 | push @{$cache_ref->{$class}}, $element; | |
261 | } | |
5bf96118 | 262 | |
58a9e587 JRT |
263 | return 0; # 0 tells find() to keep traversing, but not to store this $element |
264 | }; | |
5bf96118 CD |
265 | } |
266 | ||
6036a254 | 267 | #----------------------------------------------------------------------------- |
58a9e587 | 268 | |
937b8de0 JRT |
269 | sub _find_disabled_lines { |
270 | ||
271 | my ($doc, @site_policies)= @_; | |
272 | ||
273 | my $nodes_ref = $doc->find('PPI::Token::Comment') || return; | |
274 | my %disabled_lines; | |
275 | ||
276 | _disable_shebang_line($nodes_ref, \%disabled_lines, \@site_policies); | |
277 | _disable_other_lines($nodes_ref, \%disabled_lines, \@site_policies); | |
278 | return %disabled_lines; | |
279 | } | |
280 | ||
281 | #----------------------------------------------------------------------------- | |
282 | ||
283 | sub _disable_shebang_line { | |
284 | my ($nodes_ref, $disabled_lines, $site_policies) = @_; | |
285 | ||
286 | my $shebang_no_critic = qr{\A [#]! .*? [#][#] \s* no \s+ critic}xms; | |
287 | ||
288 | # Special case for the very beginning of the file: allow "##no critic" after the shebang | |
289 | if (0 < @{$nodes_ref}) { | |
290 | my $loc = $nodes_ref->[0]->location; | |
291 | if (1 == $loc->[0] && 1 == $loc->[1] && $nodes_ref->[0] =~ $shebang_no_critic) { | |
292 | my $pragma = shift @{$nodes_ref}; | |
293 | for my $policy (_parse_nocritic_import($pragma, $site_policies)) { | |
294 | $disabled_lines->{ 1 }->{$policy} = 1; | |
295 | } | |
296 | } | |
297 | } | |
298 | return; | |
299 | } | |
300 | ||
301 | #----------------------------------------------------------------------------- | |
302 | ||
303 | sub _disable_other_lines { | |
304 | my ($nodes_ref, $disabled_lines, $site_policies) = @_; | |
305 | ||
306 | my $no_critic = qr{\A \s* [#][#] \s* no \s+ critic}xms; | |
307 | my $use_critic = qr{\A \s* [#][#] \s* use \s+ critic}xms; | |
308 | ||
309 | PRAGMA: | |
310 | for my $pragma ( grep { $_ =~ $no_critic } @{$nodes_ref} ) { | |
311 | ||
312 | # Parse out the list of Policy names after the | |
313 | # 'no critic' pragma. I'm thinking of this just | |
314 | # like a an C<import> argument for real pragmas. | |
315 | my @no_policies = _parse_nocritic_import($pragma, $site_policies); | |
316 | ||
317 | # Grab surrounding nodes to determine the context. | |
318 | # This determines whether the pragma applies to | |
319 | # the current line or the block that follows. | |
320 | my $parent = $pragma->parent(); | |
321 | my $grandparent = $parent ? $parent->parent() : undef; | |
322 | my $sib = $pragma->sprevious_sibling(); | |
323 | ||
324 | ||
325 | # Handle single-line usage on simple statements | |
326 | if ( $sib && $sib->location->[0] == $pragma->location->[0] ) { | |
327 | my $line = $pragma->location->[0]; | |
328 | for my $policy ( @no_policies ) { | |
329 | $disabled_lines->{ $line }->{$policy} = 1; | |
330 | } | |
331 | next PRAGMA; | |
332 | } | |
333 | ||
334 | ||
335 | # Handle single-line usage on compound statements | |
336 | if ( ref $parent eq 'PPI::Structure::Block' ) { | |
337 | if ( ref $grandparent eq 'PPI::Statement::Compound' | |
338 | || ref $grandparent eq 'PPI::Statement::Sub' ) { | |
339 | if ( $parent->location->[0] == $pragma->location->[0] ) { | |
340 | my $line = $grandparent->location->[0]; | |
341 | for my $policy ( @no_policies ) { | |
342 | $disabled_lines->{ $line }->{$policy} = 1; | |
343 | } | |
344 | next PRAGMA; | |
345 | } | |
346 | } | |
347 | } | |
348 | ||
349 | ||
350 | # Handle multi-line usage. This is either a "no critic" .. | |
351 | # "use critic" region or a block where "no critic" persists | |
352 | # until the end of the scope. The start is the always the "no | |
353 | # critic" which we already found. So now we have to search | |
354 | # for the end. | |
355 | ||
356 | my $start = $pragma; | |
357 | my $end = $pragma; | |
358 | ||
359 | SIB: | |
360 | while ( my $esib = $end->next_sibling() ) { | |
361 | $end = $esib; # keep track of last sibling encountered in this scope | |
4880392e | 362 | last SIB if $esib->isa('PPI::Token::Comment') && $esib =~ $use_critic; |
937b8de0 JRT |
363 | } |
364 | ||
365 | # We either found an end or hit the end of the scope. | |
366 | # Flag all intervening lines | |
367 | for my $line ( $start->location->[0] .. $end->location->[0] ) { | |
368 | for my $policy ( @no_policies ) { | |
369 | $disabled_lines->{ $line }->{$policy} = 1; | |
370 | } | |
371 | } | |
372 | } | |
373 | ||
374 | return; | |
375 | } | |
376 | ||
377 | #----------------------------------------------------------------------------- | |
378 | ||
379 | sub _parse_nocritic_import { | |
380 | ||
381 | my ($pragma, $site_policies) = @_; | |
382 | ||
383 | my $module = qr{ [\w:]+ }xms; | |
384 | my $delim = qr{ \s* [,\s] \s* }xms; | |
385 | my $qw = qr{ (?: qw )? }xms; | |
386 | my $qualifier = qr{ $qw [(]? \s* ( $module (?: $delim $module)* ) \s* [)]? }xms; | |
387 | my $no_critic = qr{ \#\# \s* no \s+ critic \s* $qualifier }xms; ##no critic(EscapedMetacharacters) | |
388 | ||
389 | if ( my ($module_list) = $pragma =~ $no_critic ) { | |
390 | my @modules = split $delim, $module_list; | |
391 | ||
392 | # Compose the specified modules into a regex alternation. Wrap each | |
393 | # in a no-capturing group to permit "|" in the modules specification | |
394 | # (backward compatibility) | |
395 | my $re = join q{|}, map {"(?:$_)"} @modules; | |
396 | return grep {m/$re/ixms} @{$site_policies}; | |
397 | } | |
398 | ||
399 | # Default to disabling ALL policies. | |
400 | return qw(ALL); | |
401 | } | |
402 | ||
403 | #----------------------------------------------------------------------------- | |
404 | ||
405 | sub _unfix_shebang { | |
406 | ||
407 | # When you install a script using ExtUtils::MakeMaker or Module::Build, it | |
408 | # inserts some magical code into the top of the file (just after the | |
409 | # shebang). This code allows people to call your script using a shell, | |
410 | # like `sh my_script`. Unfortunately, this code causes several Policy | |
411 | # violations, so we just disable it as if a "## no critic" comment had | |
412 | # been attached. | |
413 | ||
414 | my $doc = shift; | |
415 | my $first_stmnt = $doc->schild(0) || return {}; | |
416 | ||
417 | # Different versions of MakeMaker and Build use slightly different shebang | |
418 | # fixing strings. This matches most of the ones I've found in my own Perl | |
419 | # distribution, but it may not be bullet-proof. | |
420 | ||
fb0f04cd | 421 | my $fixin_rx = qr<^eval 'exec .* \$0 \${1\+"\$@"}'\s*[\r\n]\s*if.+;>ms; ## no critic (RequireExtendedFormatting) |
937b8de0 JRT |
422 | if ( $first_stmnt =~ $fixin_rx ) { |
423 | my $line = $first_stmnt->location()->[0]; | |
fb0f04cd ES |
424 | |
425 | ## This is another case where PPI thinks something is a block when | |
426 | ## it's really a constructor. This isn't a | |
427 | ## ProhibitCommaSeparatedStatements bug. | |
428 | ## no critic (ProhibitCommaSeparatedStatements) | |
937b8de0 | 429 | return { $line => {ALL => 1}, $line + 1 => {ALL => 1} }; |
fb0f04cd | 430 | ## use critic |
937b8de0 JRT |
431 | } |
432 | ||
433 | #No magic shebang was found! | |
434 | return {}; | |
435 | } | |
436 | ||
437 | #----------------------------------------------------------------------------- | |
438 | ||
5bf96118 | 439 | 1; |
58a9e587 | 440 | |
5bf96118 CD |
441 | __END__ |
442 | ||
a73f4a71 JRT |
443 | =pod |
444 | ||
445 | =for stopwords pre-caches | |
446 | ||
5bf96118 CD |
447 | =head1 NAME |
448 | ||
c728943a | 449 | Perl::Critic::Document - Caching wrapper around a PPI::Document. |
5bf96118 | 450 | |
267b39b4 | 451 | |
5bf96118 CD |
452 | =head1 SYNOPSIS |
453 | ||
454 | use PPI::Document; | |
455 | use Perl::Critic::Document; | |
456 | my $doc = PPI::Document->new('Foo.pm'); | |
457 | $doc = Perl::Critic::Document->new($doc); | |
458 | ## Then use the instance just like a PPI::Document | |
459 | ||
267b39b4 | 460 | |
5bf96118 CD |
461 | =head1 DESCRIPTION |
462 | ||
463 | Perl::Critic does a lot of iterations over the PPI document tree via | |
464 | the C<PPI::Document::find()> method. To save some time, this class | |
465 | pre-caches a lot of the common C<find()> calls in a single traversal. | |
466 | Then, on subsequent requests we return the cached data. | |
467 | ||
468 | This is implemented as a facade, where method calls are handed to the | |
469 | stored C<PPI::Document> instance. | |
470 | ||
267b39b4 | 471 | |
5bf96118 CD |
472 | =head1 CAVEATS |
473 | ||
474 | This facade does not implement the overloaded operators from | |
11f53956 ES |
475 | L<PPI::Document|PPI::Document> (that is, the C<use overload ...> |
476 | work). Therefore, users of this facade must not rely on that syntactic | |
477 | sugar. So, for example, instead of C<my $source = "$doc";> you should | |
478 | write C<my $source = $doc->content();> | |
5bf96118 CD |
479 | |
480 | Perhaps there is a CPAN module out there which implements a facade | |
481 | better than we do here? | |
482 | ||
267b39b4 ES |
483 | |
484 | =head1 CONSTRUCTOR | |
485 | ||
486 | =over | |
487 | ||
488 | =item C<< new($doc) >> | |
489 | ||
490 | Create a new instance referencing a PPI::Document instance. | |
491 | ||
492 | ||
493 | =back | |
494 | ||
495 | ||
5bf96118 CD |
496 | =head1 METHODS |
497 | ||
498 | =over | |
499 | ||
267b39b4 | 500 | =item C<< new($doc) >> |
7076e807 CD |
501 | |
502 | Create a new instance referencing a PPI::Document instance. | |
503 | ||
267b39b4 ES |
504 | |
505 | =item C<< ppi_document() >> | |
2b6293b2 | 506 | |
11f53956 ES |
507 | Accessor for the wrapped PPI::Document instance. Note that altering |
508 | this instance in any way can cause unpredictable failures in | |
509 | Perl::Critic's subsequent analysis because some caches may fall out of | |
510 | date. | |
2b6293b2 | 511 | |
5bf96118 | 512 | |
267b39b4 ES |
513 | =item C<< find($wanted) >> |
514 | ||
515 | =item C<< find_first($wanted) >> | |
fb21e21e | 516 | |
267b39b4 | 517 | =item C<< find_any($wanted) >> |
f5eeac3b | 518 | |
fb21e21e | 519 | If C<$wanted> is a simple PPI class name, then the cache is employed. |
f5eeac3b CD |
520 | Otherwise we forward the call to the corresponding method of the |
521 | C<PPI::Document> instance. | |
5bf96118 | 522 | |
267b39b4 ES |
523 | |
524 | =item C<< filename() >> | |
e7f2d995 CD |
525 | |
526 | Returns the filename for the source code if applicable | |
527 | (PPI::Document::File) or C<undef> otherwise (PPI::Document). | |
528 | ||
267b39b4 ES |
529 | |
530 | =item C<< isa( $classname ) >> | |
242f7b08 | 531 | |
11f53956 ES |
532 | To be compatible with other modules that expect to get a |
533 | PPI::Document, the Perl::Critic::Document class masquerades as the | |
534 | PPI::Document class. | |
242f7b08 | 535 | |
267b39b4 ES |
536 | |
537 | =item C<< highest_explicit_perl_version() >> | |
538 | ||
11f53956 ES |
539 | Returns a L<version|version> object for the highest Perl version |
540 | requirement declared in the document via a C<use> or C<require> | |
541 | statement. Returns nothing if there is no version statement. | |
267b39b4 ES |
542 | |
543 | ||
937b8de0 JRT |
544 | =item C<< mark_disabled_lines( @policy_names ) >> |
545 | ||
546 | Scans the document for C<"## no critic"> pseudo-pragmas and builds | |
547 | an internal table of which of the listed C<@policy_names> have | |
548 | been disabled at each line. Returns C<$self>. | |
549 | ||
550 | ||
95ebf9b0 | 551 | =item C<< is_line_disabled($line, $policy_name) >> |
937b8de0 JRT |
552 | |
553 | Returns true if the given C<$policy_name> has been disabled for | |
554 | at C<$line> in this document. Otherwise, returns false. | |
555 | ||
95ebf9b0 JRT |
556 | =item C<< useless_no_critic_warnings(@violations) >> |
557 | ||
558 | Given a list of violation objects that are assumed to have been found | |
559 | in this Document, returns a warning message for each line where a | |
560 | policy was disabled using a C<"##no critic"> pseudo-pragma, but | |
561 | no violation was actually found on that line. If multiple policies | |
562 | are disabled on a given line, then you'll get a warning message | |
563 | for each policy. | |
564 | ||
937b8de0 | 565 | |
5bf96118 CD |
566 | =back |
567 | ||
267b39b4 | 568 | |
5bf96118 CD |
569 | =head1 AUTHOR |
570 | ||
571 | Chris Dolan <cdolan@cpan.org> | |
572 | ||
267b39b4 | 573 | |
5bf96118 CD |
574 | =head1 COPYRIGHT |
575 | ||
20dfddeb | 576 | Copyright (c) 2006-2008 Chris Dolan. All rights reserved. |
5bf96118 CD |
577 | |
578 | This program is free software; you can redistribute it and/or modify | |
579 | it under the same terms as Perl itself. The full text of this license | |
580 | can be found in the LICENSE file included with this module. | |
581 | ||
582 | =cut | |
737d3b65 CD |
583 | |
584 | # Local Variables: | |
585 | # mode: cperl | |
586 | # cperl-indent-level: 4 | |
587 | # fill-column: 78 | |
588 | # indent-tabs-mode: nil | |
589 | # c-indentation-style: bsd | |
590 | # End: | |
96fed375 | 591 | # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |