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