File Coverage

blib/lib/Perl/ToPerl6/Document.pm
Criterion Covered Total %
statement 44 269 16.3
branch 0 108 0.0
condition 0 45 0.0
subroutine 15 50 30.0
pod 21 21 100.0
total 80 493 16.2


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