Login
RT #77510: Left curlys as literals in regexps are deprecated.
[gknop/Perl-Critic.git] / lib / Perl / Critic / Document.pm
CommitLineData
6036a254 1##############################################################################
a73f4a71
JRT
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6036a254 6##############################################################################
5bf96118
CD
7
8package Perl::Critic::Document;
9
df6dee2b 10use 5.006001;
5bf96118 11use strict;
58a9e587 12use warnings;
267b39b4 13
d5835ca8 14use Carp qw< confess >;
2d2fd196 15
81e74a91 16use List::Util qw< reduce >;
f79ca4e8 17use Scalar::Util qw< blessed refaddr weaken >;
267b39b4 18use version;
5bf96118 19
013aa3aa
ES
20use PPI::Document;
21use PPI::Document::File;
22use PPIx::Utilities::Node qw< split_ppi_node_by_namespace >;
23
d5835ca8 24use Perl::Critic::Annotation;
d533eee5 25use Perl::Critic::Exception::Parse qw< throw_parse >;
48b61139 26use Perl::Critic::Utils qw< :booleans :characters shebang_line >;
d5835ca8 27
f79ca4e8
TW
28use PPIx::Regexp 0.010 qw< >;
29
6036a254 30#-----------------------------------------------------------------------------
58a9e587 31
73c61a84 32our $VERSION = '1.117';
5bf96118 33
6036a254 34#-----------------------------------------------------------------------------
5bf96118
CD
35
36our $AUTOLOAD;
937b8de0 37sub AUTOLOAD { ## no critic (ProhibitAutoloading,ArgUnpacking)
6e7d6c9f
CD
38 my ( $function_name ) = $AUTOLOAD =~ m/ ([^:\']+) \z /xms;
39 return if $function_name eq 'DESTROY';
40 my $self = shift;
41 return $self->{_doc}->$function_name(@_);
5bf96118
CD
42}
43
6036a254 44#-----------------------------------------------------------------------------
5bf96118 45
58a9e587 46sub new {
d5835ca8 47 my ($class, @args) = @_;
013aa3aa
ES
48
49 my $self = bless {}, $class;
50
51 $self->_init_common();
52 $self->_init_from_external_source(@args);
53
54 return $self;
55}
56
57#-----------------------------------------------------------------------------
58
59sub _new_for_parent_document {
60 my ($class, $ppi_document, $parent_document) = @_;
61
937b8de0 62 my $self = bless {}, $class;
013aa3aa
ES
63
64 $self->_init_common();
65
66 $self->{_doc} = $ppi_document;
67 $self->{_is_module} = $parent_document->is_module();
68
69 return $self;
d5835ca8
JRT
70}
71
72#-----------------------------------------------------------------------------
73
013aa3aa
ES
74sub _init_common {
75 my ($self) = @_;
013aa3aa
ES
76
77 $self->{_annotations} = [];
78 $self->{_suppressed_violations} = [];
79 $self->{_disabled_line_map} = {};
80
81 return;
82}
83
84#-----------------------------------------------------------------------------
d5835ca8 85
013aa3aa 86sub _init_from_external_source { ## no critic (Subroutines::RequireArgUnpacking)
d533eee5
ES
87 my $self = shift;
88 my %args;
013aa3aa 89
d533eee5
ES
90 if (@_ == 1) {
91 warnings::warnif(
92 'deprecated',
93 'Perl::Critic::Document->new($source) deprecated, use Perl::Critic::Document->new(-source => $source) instead.' ## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
94 );
95 %args = ('-source' => shift);
96 } else {
97 %args = @_;
98 }
013aa3aa 99
d533eee5 100 my $source_code = $args{'-source'};
d5835ca8
JRT
101
102 # $source_code can be a file name, or a reference to a
103 # PPI::Document, or a reference to a scalar containing source
104 # code. In the last case, PPI handles the translation for us.
105
013aa3aa
ES
106 my $ppi_document =
107 _is_ppi_doc($source_code)
108 ? $source_code
109 : ref $source_code
110 ? PPI::Document->new($source_code)
111 : PPI::Document::File->new($source_code);
d5835ca8
JRT
112
113 # Bail on error
013aa3aa 114 if (not defined $ppi_document) {
d5835ca8
JRT
115 my $errstr = PPI::Document::errstr();
116 my $file = ref $source_code ? undef : $source_code;
117 throw_parse
118 message => qq<Can't parse code: $errstr>,
119 file_name => $file;
120 }
121
013aa3aa 122 $self->{_doc} = $ppi_document;
d5835ca8
JRT
123 $self->index_locations();
124 $self->_disable_shebang_fix();
81c16c3b 125 $self->{_filename_override} = $args{'-filename-override'};
48b61139 126 $self->{_is_module} = $self->_determine_is_module(\%args);
d5835ca8 127
013aa3aa 128 return;
5bf96118
CD
129}
130
6036a254 131#-----------------------------------------------------------------------------
58a9e587 132
d5835ca8
JRT
133sub _is_ppi_doc {
134 my ($ref) = @_;
135 return blessed($ref) && $ref->isa('PPI::Document');
136}
137
138#-----------------------------------------------------------------------------
139
2b6293b2
CD
140sub ppi_document {
141 my ($self) = @_;
142 return $self->{_doc};
143}
144
145#-----------------------------------------------------------------------------
146
47e1ff34 147sub isa {
6e7d6c9f
CD
148 my ($self, @args) = @_;
149 return $self->SUPER::isa(@args)
150 || ( (ref $self) && $self->{_doc} && $self->{_doc}->isa(@args) );
47e1ff34
CD
151}
152
6036a254 153#-----------------------------------------------------------------------------
47e1ff34 154
5bf96118 155sub find {
6e7d6c9f 156 my ($self, $wanted, @more_args) = @_;
5bf96118 157
58a9e587
JRT
158 # This method can only find elements by their class names. For
159 # other types of searches, delegate to the PPI::Document
5bf96118 160 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
6e7d6c9f 161 return $self->{_doc}->find($wanted, @more_args);
5bf96118 162 }
58a9e587
JRT
163
164 # Build the class cache if it doesn't exist. This happens at most
165 # once per Perl::Critic::Document instance. %elements of will be
166 # populated as a side-effect of calling the $finder_sub coderef
167 # that is produced by the caching_finder() closure.
5bf96118 168 if ( !$self->{_elements_of} ) {
389109ec 169
58a9e587 170 my %cache = ( 'PPI::Document' => [ $self ] );
389109ec
JRT
171
172 # The cache refers to $self, and $self refers to the cache. This
173 # creates a circular reference that leaks memory (i.e. $self is not
174 # destroyed until execution is complete). By weakening the reference,
175 # we allow perl to collect the garbage properly.
176 weaken( $cache{'PPI::Document'}->[0] );
177
58a9e587
JRT
178 my $finder_coderef = _caching_finder( \%cache );
179 $self->{_doc}->find( $finder_coderef );
180 $self->{_elements_of} = \%cache;
181 }
182
183 # find() must return false-but-defined on fail
184 return $self->{_elements_of}->{$wanted} || q{};
185}
186
6036a254 187#-----------------------------------------------------------------------------
58a9e587 188
fb21e21e 189sub find_first {
6e7d6c9f 190 my ($self, $wanted, @more_args) = @_;
fb21e21e
CD
191
192 # This method can only find elements by their class names. For
193 # other types of searches, delegate to the PPI::Document
194 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
6e7d6c9f 195 return $self->{_doc}->find_first($wanted, @more_args);
fb21e21e
CD
196 }
197
198 my $result = $self->find($wanted);
199 return $result ? $result->[0] : $result;
200}
201
6036a254 202#-----------------------------------------------------------------------------
fb21e21e 203
f5eeac3b 204sub find_any {
6e7d6c9f 205 my ($self, $wanted, @more_args) = @_;
f5eeac3b
CD
206
207 # This method can only find elements by their class names. For
208 # other types of searches, delegate to the PPI::Document
209 if ( ( ref $wanted ) || !$wanted || $wanted !~ m/ \A PPI:: /xms ) {
6e7d6c9f 210 return $self->{_doc}->find_any($wanted, @more_args);
f5eeac3b
CD
211 }
212
213 my $result = $self->find($wanted);
214 return $result ? 1 : $result;
215}
216
6036a254 217#-----------------------------------------------------------------------------
f5eeac3b 218
013aa3aa
ES
219sub namespaces {
220 my ($self) = @_;
221
222 return keys %{ $self->_nodes_by_namespace() };
223}
224
225#-----------------------------------------------------------------------------
226
227sub subdocuments_for_namespace {
228 my ($self, $namespace) = @_;
229
230 my $subdocuments = $self->_nodes_by_namespace()->{$namespace};
231
232 return $subdocuments ? @{$subdocuments} : ();
233}
234
235#-----------------------------------------------------------------------------
236
f79ca4e8
TW
237sub ppix_regexp_from_element {
238 my ( $self, $element ) = @_;
239
240 if ( blessed( $element ) && $element->isa( 'PPI::Element' ) ) {
241 my $addr = refaddr( $element );
242 return $self->{_ppix_regexp_from_element}{$addr}
243 if exists $self->{_ppix_regexp_from_element}{$addr};
244 return ( $self->{_ppix_regexp_from_element}{$addr} =
30912869
TW
245 PPIx::Regexp->new( $element,
246 default_modifiers =>
247 $self->_find_use_re_modifiers_in_scope_from_element(
248 $element ),
249 ) );
f79ca4e8
TW
250 } else {
251 return PPIx::Regexp->new( $element );
252 }
253}
254
30912869
TW
255sub _find_use_re_modifiers_in_scope_from_element {
256 my ( $self, $elem ) = @_;
257 my @found;
258 foreach my $use_re ( @{ $self->find( 'PPI::Statement::Include' ) || [] } )
259 {
260 're' eq $use_re->module()
261 or next;
262 $self->element_is_in_lexical_scope_after_statement_containing(
263 $elem, $use_re )
264 or next;
265 my $prefix = 'no' eq $use_re->type() ? q{-} : $EMPTY;
266 push @found,
267 map { "$prefix$_" }
268 grep { m{ \A / }smx }
269 map {
270 $_->isa( 'PPI::Token::Quote' ) ? $_->string() :
271 $_->isa( 'PPI::Token::QuoteLike::Words' ) ? $_->literal() :
272 $_->content() }
273 $use_re->schildren();
274 }
275 return \@found;
276}
277
278#-----------------------------------------------------------------------------
279
280# This got hung on the Perl::Critic::Document, rather than living in
281# Perl::Critic::Utils::PPI, because of the possibility that caching of scope
282# objects would turn out to be desirable.
283
284sub element_is_in_lexical_scope_after_statement_containing {
285 my ( $self, $inner_elem, $outer_elem ) = @_;
286
287 # If the outer element defines a scope, we're true if and only if
288 # the outer element contains the inner element.
289 $outer_elem->scope()
290 and return $inner_elem->descendant_of( $outer_elem );
291
292 # In the more general case:
293
294 # The last element of the statement containing the outer element
295 # must be before the inner element. If not, we know we're false,
296 # without walking the parse tree.
297
298 my $stmt = $outer_elem->statement()
299 or return;
300 my $last_elem = $stmt->last_element()
301 or return;
302
303 my $stmt_loc = $last_elem->location()
304 or return;
305
306 my $inner_loc = $inner_elem->location()
307 or return;
308
309 $stmt_loc->[0] > $inner_loc->[0]
310 and return;
311 $stmt_loc->[0] == $inner_loc->[0]
312 and $stmt_loc->[1] > $inner_loc->[1]
313 and return;
314
315 # Since we know the inner element is after the outer element, find
316 # the element that defines the scope of the statement that contains
317 # the outer element.
318
319 my $parent = $stmt;
320 while ( ! $parent->scope() ) {
321 $parent = $stmt->parent()
322 or return;
323 }
324
325 # We're true if and only if the scope of the outer element contains
326 # the inner element.
327
328 return $inner_elem->descendant_of( $parent );
329
330}
331
f79ca4e8
TW
332#-----------------------------------------------------------------------------
333
60108aef
CD
334sub filename {
335 my ($self) = @_;
013aa3aa 336
81c16c3b
ES
337 if (defined $self->{_filename_override}) {
338 return $self->{_filename_override};
515ac1b2
JRT
339 }
340 else {
341 my $doc = $self->{_doc};
342 return $doc->can('filename') ? $doc->filename() : undef;
343 }
60108aef
CD
344}
345
6036a254 346#-----------------------------------------------------------------------------
60108aef 347
267b39b4
ES
348sub highest_explicit_perl_version {
349 my ($self) = @_;
350
351 my $highest_explicit_perl_version =
352 $self->{_highest_explicit_perl_version};
353
354 if ( not exists $self->{_highest_explicit_perl_version} ) {
355 my $includes = $self->find( \&_is_a_version_statement );
356
357 if ($includes) {
81e74a91
ES
358 # Note: this doesn't use List::Util::max() because that function
359 # doesn't use the overloaded ">=" etc of a version object. The
360 # reduce() style lets version.pm take care of all comparing.
df9f8d80
ES
361 #
362 # For reference, max() ends up looking at the string converted to
363 # an NV, or something like that. An underscore like "5.005_04"
364 # provokes a warning and is chopped off at "5.005" thus losing the
365 # minor part from the comparison.
366 #
367 # An underscore "5.005_04" is supposed to mean an alpha release
81e74a91
ES
368 # and shouldn't be used in a perl version. But it's shown in
369 # perlfunc under "use" (as a number separator), and appears in
370 # several modules supplied with perl 5.10.0 (like version.pm
371 # itself!). At any rate if version.pm can understand it then
372 # that's enough for here.
267b39b4 373 $highest_explicit_perl_version =
81e74a91 374 reduce { $a >= $b ? $a : $b }
901273dd
ES
375 map { version->new( $_->version() ) }
376 @{$includes};
267b39b4
ES
377 }
378 else {
379 $highest_explicit_perl_version = undef;
380 }
381
382 $self->{_highest_explicit_perl_version} =
383 $highest_explicit_perl_version;
384 }
385
386 return $highest_explicit_perl_version if $highest_explicit_perl_version;
387 return;
388}
389
937b8de0
JRT
390#-----------------------------------------------------------------------------
391
76b854e4
ES
392sub uses_module {
393 my ($self, $module_name) = @_;
394
395 return exists $self->_modules_used()->{$module_name};
396}
397
398#-----------------------------------------------------------------------------
399
d5835ca8
JRT
400sub process_annotations {
401 my ($self) = @_;
937b8de0 402
d5835ca8
JRT
403 my @annotations = Perl::Critic::Annotation->create_annotations($self);
404 $self->add_annotation(@annotations);
937b8de0
JRT
405 return $self;
406}
407
408#-----------------------------------------------------------------------------
409
d5835ca8
JRT
410sub line_is_disabled_for_policy {
411 my ($self, $line, $policy) = @_;
412 my $policy_name = ref $policy || $policy;
2d2fd196
JRT
413
414 # HACK: This Policy is special. If it is active, it cannot be
d1237298 415 # disabled by a "## no critic" annotation. Rather than create a general
2d2fd196 416 # hook in Policy.pm for enabling this behavior, we chose to hack
d5835ca8 417 # it here, since this isn't the kind of thing that most policies do
2f4b6b33
JRT
418
419 return 0 if $policy_name eq
2d2fd196
JRT
420 'Perl::Critic::Policy::Miscellanea::ProhibitUnrestrictedNoCritic';
421
d5835ca8
JRT
422 return 1 if $self->{_disabled_line_map}->{$line}->{$policy_name};
423 return 1 if $self->{_disabled_line_map}->{$line}->{ALL};
937b8de0
JRT
424 return 0;
425}
426
427#-----------------------------------------------------------------------------
428
d5835ca8
JRT
429sub add_annotation {
430 my ($self, @annotations) = @_;
431
432 # Add annotation to our private map for quick lookup
433 for my $annotation (@annotations) {
434
435 my ($start, $end) = $annotation->effective_range();
436 my @affected_policies = $annotation->disables_all_policies ?
437 qw(ALL) : $annotation->disabled_policies();
438
439 # TODO: Find clever way to do this with hash slices
440 for my $line ($start .. $end) {
441 for my $policy (@affected_policies) {
442 $self->{_disabled_line_map}->{$line}->{$policy} = 1;
443 }
444 }
445 }
446
447 push @{ $self->{_annotations} }, @annotations;
2d2fd196
JRT
448 return $self;
449}
4880392e 450
2d2fd196 451#-----------------------------------------------------------------------------
4880392e 452
d5835ca8 453sub annotations {
2d2fd196 454 my ($self) = @_;
d5835ca8
JRT
455 return @{ $self->{_annotations} };
456}
4880392e 457
d5835ca8 458#-----------------------------------------------------------------------------
4880392e 459
d5835ca8
JRT
460sub add_suppressed_violation {
461 my ($self, $violation) = @_;
462 push @{$self->{_suppressed_violations}}, $violation;
463 return $self;
464}
4880392e 465
d5835ca8 466#-----------------------------------------------------------------------------
2d2fd196 467
d5835ca8
JRT
468sub suppressed_violations {
469 my ($self) = @_;
470 return @{ $self->{_suppressed_violations} };
95ebf9b0
JRT
471}
472
473#-----------------------------------------------------------------------------
d533eee5 474
1b936936 475sub is_program {
d533eee5 476 my ($self) = @_;
48b61139
ES
477
478 return not $self->is_module();
d533eee5
ES
479}
480
481#-----------------------------------------------------------------------------
482
483sub is_module {
484 my ($self) = @_;
48b61139
ES
485
486 return $self->{_is_module};
d533eee5
ES
487}
488
489#-----------------------------------------------------------------------------
d5835ca8 490# PRIVATE functions & methods
95ebf9b0 491
267b39b4
ES
492sub _is_a_version_statement {
493 my (undef, $element) = @_;
494
495 return 0 if not $element->isa('PPI::Statement::Include');
496 return 1 if $element->version();
497 return 0;
498}
499
500#-----------------------------------------------------------------------------
501
58a9e587 502sub _caching_finder {
58a9e587
JRT
503 my $cache_ref = shift; # These vars will persist for the life
504 my %isa_cache = (); # of the code ref that this sub returns
505
506
507 # Gather up all the PPI elements and sort by @ISA. Note: if any
508 # instances used multiple inheritance, this implementation would
509 # lead to multiple copies of $element in the $elements_of lists.
510 # However, PPI::* doesn't do multiple inheritance, so we are safe
511
512 return sub {
6e7d6c9f 513 my (undef, $element) = @_;
58a9e587
JRT
514 my $classes = $isa_cache{ref $element};
515 if ( !$classes ) {
516 $classes = [ ref $element ];
517 # Use a C-style loop because we append to the classes array inside
518 for ( my $i = 0; $i < @{$classes}; $i++ ) { ## no critic(ProhibitCStyleForLoops)
519 no strict 'refs'; ## no critic(ProhibitNoStrict)
520 push @{$classes}, @{"$classes->[$i]::ISA"};
521 $cache_ref->{$classes->[$i]} ||= [];
5bf96118 522 }
58a9e587
JRT
523 $isa_cache{$classes->[0]} = $classes;
524 }
5bf96118 525
58a9e587
JRT
526 for my $class ( @{$classes} ) {
527 push @{$cache_ref->{$class}}, $element;
528 }
5bf96118 529
58a9e587
JRT
530 return 0; # 0 tells find() to keep traversing, but not to store this $element
531 };
5bf96118
CD
532}
533
6036a254 534#-----------------------------------------------------------------------------
58a9e587 535
d5835ca8 536sub _disable_shebang_fix {
2d2fd196
JRT
537 my ($self) = @_;
538
1b936936 539 # When you install a program using ExtUtils::MakeMaker or Module::Build, it
937b8de0 540 # inserts some magical code into the top of the file (just after the
1b936936 541 # shebang). This code allows people to call your program using a shell,
937b8de0 542 # like `sh my_script`. Unfortunately, this code causes several Policy
d1237298 543 # violations, so we disable them as if they had "## no critic" annotations.
937b8de0 544
d5835ca8 545 my $first_stmnt = $self->schild(0) || return;
937b8de0
JRT
546
547 # Different versions of MakeMaker and Build use slightly different shebang
548 # fixing strings. This matches most of the ones I've found in my own Perl
549 # distribution, but it may not be bullet-proof.
550
7a52e1ec 551 my $fixin_rx = qr<^eval 'exec .* \$0 \$[{]1[+]"\$@"}'\s*[\r\n]\s*if.+;>ms; ## no critic (ExtendedFormatting)
937b8de0 552 if ( $first_stmnt =~ $fixin_rx ) {
d5835ca8
JRT
553 my $line = $first_stmnt->location->[0];
554 $self->{_disabled_line_map}->{$line}->{ALL} = 1;
555 $self->{_disabled_line_map}->{$line + 1}->{ALL} = 1;
937b8de0
JRT
556 }
557
2d2fd196 558 return $self;
937b8de0
JRT
559}
560
561#-----------------------------------------------------------------------------
562
48b61139 563sub _determine_is_module {
d533eee5
ES
564 my ($self, $args) = @_;
565
566 my $file_name = $self->filename();
1b936936
ES
567 if (
568 defined $file_name
569 and ref $args->{'-program-extensions'} eq 'ARRAY'
570 ) {
571 foreach my $ext ( @{ $args->{'-program-extensions'} } ) {
572 my $regex =
573 ref $ext eq 'Regexp'
574 ? $ext
575 : qr< @{ [ quotemeta $ext ] } \z >xms;
576
48b61139 577 return $FALSE if $file_name =~ m/$regex/smx;
d533eee5
ES
578 }
579 }
580
48b61139
ES
581 return $FALSE if shebang_line($self);
582 return $FALSE if defined $file_name && $file_name =~ m/ [.] PL \z /smx;
d533eee5 583
48b61139 584 return $TRUE;
d533eee5
ES
585}
586
587#-----------------------------------------------------------------------------
588
013aa3aa
ES
589sub _nodes_by_namespace {
590 my ($self) = @_;
591
592 my $nodes = $self->{_nodes_by_namespace};
593
594 return $nodes if $nodes;
595
596 my $ppi_document = $self->ppi_document();
597 if (not $ppi_document) {
598 return $self->{_nodes_by_namespace} = {};
599 }
600
601 my $raw_nodes_map = split_ppi_node_by_namespace($ppi_document);
602
603 my %wrapped_nodes;
604 while ( my ($namespace, $raw_nodes) = each %{$raw_nodes_map} ) {
ef89e7fc 605 $wrapped_nodes{$namespace} = [
013aa3aa 606 map { __PACKAGE__->_new_for_parent_document($_, $self) }
ef89e7fc
ES
607 @{$raw_nodes}
608 ];
013aa3aa
ES
609 }
610
611 return $self->{_nodes_by_namespace} = \%wrapped_nodes;
612}
613
614#-----------------------------------------------------------------------------
615
76b854e4
ES
616# Note: must use exists on return value to determine membership because all
617# the values are false, unlike the result of hashify().
618sub _modules_used {
619 my ($self) = @_;
620
621 my $mapping = $self->{_modules_used};
622
623 return $mapping if $mapping;
624
625 my $includes = $self->find('PPI::Statement::Include');
2187a8d2
ES
626 if (not $includes) {
627 return $self->{_modules_used} = {};
628 }
76b854e4
ES
629
630 my %mapping;
631 for my $module (
632 grep { $_ } map { $_->module() || $_->pragma() } @{$includes}
633 ) {
634 # Significanly ess memory than $h{$k} => 1. Thanks Mr. Lembark.
635 $mapping{$module} = ();
636 }
637
638 return $self->{_modules_used} = \%mapping;
639}
640
641#-----------------------------------------------------------------------------
642
5bf96118 6431;
58a9e587 644
5bf96118
CD
645__END__
646
a73f4a71
JRT
647=pod
648
649=for stopwords pre-caches
650
5bf96118
CD
651=head1 NAME
652
c728943a 653Perl::Critic::Document - Caching wrapper around a PPI::Document.
5bf96118 654
267b39b4 655
5bf96118
CD
656=head1 SYNOPSIS
657
658 use PPI::Document;
659 use Perl::Critic::Document;
660 my $doc = PPI::Document->new('Foo.pm');
d533eee5 661 $doc = Perl::Critic::Document->new(-source => $doc);
5bf96118
CD
662 ## Then use the instance just like a PPI::Document
663
267b39b4 664
5bf96118
CD
665=head1 DESCRIPTION
666
667Perl::Critic does a lot of iterations over the PPI document tree via
668the C<PPI::Document::find()> method. To save some time, this class
669pre-caches a lot of the common C<find()> calls in a single traversal.
670Then, on subsequent requests we return the cached data.
671
672This is implemented as a facade, where method calls are handed to the
673stored C<PPI::Document> instance.
674
267b39b4 675
5bf96118
CD
676=head1 CAVEATS
677
678This facade does not implement the overloaded operators from
11f53956
ES
679L<PPI::Document|PPI::Document> (that is, the C<use overload ...>
680work). Therefore, users of this facade must not rely on that syntactic
681sugar. So, for example, instead of C<my $source = "$doc";> you should
682write C<my $source = $doc->content();>
5bf96118
CD
683
684Perhaps there is a CPAN module out there which implements a facade
685better than we do here?
686
267b39b4 687
4444d94d
ES
688=head1 INTERFACE SUPPORT
689
690This is considered to be a public class. Any changes to its interface
691will go through a deprecation cycle.
692
693
267b39b4
ES
694=head1 CONSTRUCTOR
695
696=over
697
81c16c3b 698=item C<< new(-source => $source_code, '-filename-override' => $filename, '-program-extensions' => [program_extensions]) >>
267b39b4 699
d5835ca8
JRT
700Create a new instance referencing a PPI::Document instance. The
701C<$source_code> can be the name of a file, a reference to a scalar
0e4a0ae1
TW
702containing actual source code, or a L<PPI::Document|PPI::Document> or
703L<PPI::Document::File|PPI::Document::File>.
267b39b4 704
81c16c3b
ES
705In the event that C<$source_code> is a reference to a scalar containing actual
706source code or a L<PPI::Document|PPI::Document>, the resulting
515ac1b2
JRT
707L<Perl::Critic::Document|Perl::Critic::Document> will not have a filename.
708This may cause L<Perl::Critic::Document|Perl::Critic::Document> to incorrectly
709classify the source code as a module or script. To avoid this problem, you
81c16c3b
ES
710can optionally set the C<-filename-override> to force the
711L<Perl::Critic::Document|Perl::Critic::Document> to have a particular
712C<$filename>. Do not use this option if C<$source_code> is already the name
713of a file, or is a reference to a L<PPI::Document::File|PPI::Document::File>.
515ac1b2 714
48b61139
ES
715The '-program-extensions' argument is optional, and is a reference to a list
716of strings and/or regular expressions. The strings will be made into regular
717expressions matching the end of a file name, and any document whose file name
718matches one of the regular expressions will be considered a program.
d533eee5 719
1b936936 720If -program-extensions is not specified, or if it does not determine the
48b61139
ES
721document type, the document will be considered to be a program if the source
722has a shebang line or its file name (if any) matches C<< m/ [.] PL \z /smx >>.
d533eee5 723
267b39b4
ES
724=back
725
5bf96118
CD
726=head1 METHODS
727
728=over
729
267b39b4 730=item C<< ppi_document() >>
2b6293b2 731
11f53956
ES
732Accessor for the wrapped PPI::Document instance. Note that altering
733this instance in any way can cause unpredictable failures in
734Perl::Critic's subsequent analysis because some caches may fall out of
735date.
2b6293b2 736
5bf96118 737
267b39b4
ES
738=item C<< find($wanted) >>
739
740=item C<< find_first($wanted) >>
fb21e21e 741
267b39b4 742=item C<< find_any($wanted) >>
f5eeac3b 743
76b854e4
ES
744Caching wrappers around the PPI methods. If C<$wanted> is a simple PPI class
745name, then the cache is employed. Otherwise we forward the call to the
746corresponding method of the C<PPI::Document> instance.
5bf96118 747
267b39b4 748
013aa3aa
ES
749=item C<< namespaces() >>
750
751Returns a list of the namespaces (package names) in the document.
752
753
754=item C<< subdocuments_for_namespace($namespace) >>
755
756Returns a list of sub-documents containing the elements in the given
757namespace. For example, given that the current document is for the source
758
759 foo();
760 package Foo;
761 package Bar;
762 package Foo;
763
764this method will return two L<Perl::Critic::Document|Perl::Critic::Document>s
765for a parameter of C<"Foo">. For more, see
766L<PPIx::Utilities::Node/split_ppi_node_by_namespace>.
767
768
f79ca4e8
TW
769=item C<< ppix_regexp_from_element($element) >>
770
771Caching wrapper around C<< PPIx::Regexp->new($element) >>. If
772C<$element> is a C<PPI::Element> the cache is employed, otherwise it
773just returns the results of C<< PPIx::Regexp->new() >>. In either case,
774it returns C<undef> unless the argument is something that
775L<PPIx::Regexp|PPIx::Regexp> actually understands.
776
30912869
TW
777=item C<< element_is_in_lexical_scope_after_statement_containing( $inner, $outer ) >>
778
779Is the C<$inner> element in lexical scope after the statement containing
780the C<$outer> element?
781
782In the case where C<$outer> is itself a scope-defining element, returns true
783if C<$outer> contains C<$inner>. In any other case, C<$inner> must be
784after the last element of the statement containing C<$outer>, and the
785innermost scope for C<$outer> also contains C<$inner>.
786
787This is not the same as asking whether C<$inner> is visible from
788C<$outer>.
789
f79ca4e8 790
267b39b4 791=item C<< filename() >>
e7f2d995
CD
792
793Returns the filename for the source code if applicable
794(PPI::Document::File) or C<undef> otherwise (PPI::Document).
795
267b39b4
ES
796
797=item C<< isa( $classname ) >>
242f7b08 798
11f53956
ES
799To be compatible with other modules that expect to get a
800PPI::Document, the Perl::Critic::Document class masquerades as the
801PPI::Document class.
242f7b08 802
267b39b4
ES
803
804=item C<< highest_explicit_perl_version() >>
805
11f53956
ES
806Returns a L<version|version> object for the highest Perl version
807requirement declared in the document via a C<use> or C<require>
808statement. Returns nothing if there is no version statement.
267b39b4 809
013aa3aa 810
76b854e4
ES
811=item C<< uses_module($module_or_pragma_name) >>
812
813Answers whether there is a C<use>, C<require>, or C<no> of the given name in
814this document. Note that there is no differentiation of modules vs. pragmata
815here.
816
817
d5835ca8 818=item C<< process_annotations() >>
267b39b4 819
d5835ca8
JRT
820Causes this Document to scan itself and mark which lines &
821policies are disabled by the C<"## no critic"> annotations.
937b8de0 822
013aa3aa 823
d5835ca8 824=item C<< line_is_disabled_for_policy($line, $policy_object) >>
937b8de0 825
fcb2381b 826Returns true if the given C<$policy_object> or C<$policy_name> has
d5835ca8 827been disabled for at C<$line> in this Document. Otherwise, returns false.
937b8de0 828
013aa3aa 829
d5835ca8 830=item C<< add_annotation( $annotation ) >>
937b8de0 831
d5835ca8 832Adds an C<$annotation> object to this Document.
2d2fd196 833
013aa3aa 834
d5835ca8 835=item C<< annotations() >>
2d2fd196 836
0e4a0ae1
TW
837Returns a list containing all the
838L<Perl::Critic::Annotation|Perl::Critic::Annotation>s that
d5835ca8 839were found in this Document.
2d2fd196 840
013aa3aa 841
d5835ca8 842=item C<< add_suppressed_violation($violation) >>
2d2fd196 843
fcb2381b 844Informs this Document that a C<$violation> was found but not reported
d5835ca8
JRT
845because it fell on a line that had been suppressed by a C<"## no critic">
846annotation. Returns C<$self>.
95ebf9b0 847
013aa3aa 848
d5835ca8 849=item C<< suppressed_violations() >>
95ebf9b0 850
0e4a0ae1
TW
851Returns a list of references to all the
852L<Perl::Critic::Violation|Perl::Critic::Violation>s
d5835ca8 853that were found in this Document but were suppressed.
937b8de0 854
d533eee5 855
1b936936
ES
856=item C<< is_program() >>
857
858Returns whether this document is considered to be a program.
d533eee5 859
d533eee5
ES
860
861=item C<< is_module() >>
862
1b936936 863Returns whether this document is considered to be a Perl module.
d533eee5 864
5bf96118
CD
865=back
866
867=head1 AUTHOR
868
2f4b6b33 869Chris Dolan <cdolan@cpan.org>
5bf96118
CD
870
871=head1 COPYRIGHT
872
53b8903f 873Copyright (c) 2006-2011 Chris Dolan.
5bf96118
CD
874
875This program is free software; you can redistribute it and/or modify
876it under the same terms as Perl itself. The full text of this license
877can be found in the LICENSE file included with this module.
878
879=cut
737d3b65 880
d5835ca8 881##############################################################################
737d3b65
CD
882# Local Variables:
883# mode: cperl
884# cperl-indent-level: 4
885# fill-column: 78
886# indent-tabs-mode: nil
887# c-indentation-style: bsd
888# End:
96fed375 889# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :