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 : |