line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::ToPerl6::Annotation; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
112459
|
use 5.006001; |
|
13
|
|
|
|
|
41
|
|
4
|
13
|
|
|
13
|
|
57
|
use strict; |
|
13
|
|
|
|
|
21
|
|
|
13
|
|
|
|
|
263
|
|
5
|
13
|
|
|
13
|
|
51
|
use warnings; |
|
13
|
|
|
|
|
21
|
|
|
13
|
|
|
|
|
373
|
|
6
|
|
|
|
|
|
|
|
7
|
13
|
|
|
13
|
|
54
|
use Carp qw(confess); |
|
13
|
|
|
|
|
16
|
|
|
13
|
|
|
|
|
791
|
|
8
|
13
|
|
|
13
|
|
739
|
use English qw(-no_match_vars); |
|
13
|
|
|
|
|
3919
|
|
|
13
|
|
|
|
|
105
|
|
9
|
|
|
|
|
|
|
|
10
|
13
|
|
|
13
|
|
6029
|
use Perl::ToPerl6::TransformerFactory; |
|
13
|
|
|
|
|
27
|
|
|
13
|
|
|
|
|
118
|
|
11
|
13
|
|
|
13
|
|
68
|
use Perl::ToPerl6::Utils qw(:characters hashify); |
|
13
|
|
|
|
|
22
|
|
|
13
|
|
|
|
|
807
|
|
12
|
13
|
|
|
13
|
|
2933
|
use Readonly; |
|
13
|
|
|
|
|
25
|
|
|
13
|
|
|
|
|
16214
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Readonly::Scalar my $LAST_ELEMENT => -1; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#============================================================================= |
21
|
|
|
|
|
|
|
# CLASS methods |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub create_annotations { |
24
|
11
|
|
|
11
|
1
|
60
|
my ($class, $doc) = @_; |
25
|
|
|
|
|
|
|
|
26
|
11
|
|
|
|
|
22
|
my @annotations = (); |
27
|
11
|
|
100
|
|
|
44
|
my $comment_elements_ref = $doc->find('PPI::Token::Comment') || return; |
28
|
7
|
|
|
|
|
29
|
my $annotation_rx = qr{\A (?: [#]! .*? )? \s* [#][#] \s* no \s+ mogrify}xms; |
29
|
7
|
|
|
|
|
11
|
for my $annotation_element ( grep { $_ =~ $annotation_rx } @{$comment_elements_ref} ) { |
|
22
|
|
|
|
|
155
|
|
|
7
|
|
|
|
|
16
|
|
30
|
13
|
|
|
|
|
122
|
push @annotations, Perl::ToPerl6::Annotation->new( -element => $annotation_element); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
7
|
|
|
|
|
44
|
return @annotations; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub new { |
39
|
13
|
|
|
13
|
1
|
33
|
my ($class, @args) = @_; |
40
|
13
|
|
|
|
|
29
|
my $self = bless {}, $class; |
41
|
13
|
|
|
|
|
38
|
$self->_init(@args); |
42
|
13
|
|
|
|
|
45
|
return $self; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#============================================================================= |
46
|
|
|
|
|
|
|
# OBJECT methods |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _init { |
49
|
13
|
|
|
13
|
|
35
|
my ($self, %args) = @_; |
50
|
13
|
|
33
|
|
|
56
|
my $annotation_element = $args{-element} || confess '-element argument is required'; |
51
|
13
|
|
|
|
|
33
|
$self->{_element} = $annotation_element; |
52
|
|
|
|
|
|
|
|
53
|
13
|
|
|
|
|
38
|
my %disabled_transformers = _parse_annotation( $annotation_element ); |
54
|
13
|
100
|
|
|
|
44
|
$self->{_disables_all_transformers} = %disabled_transformers ? 0 : 1; |
55
|
13
|
|
|
|
|
29
|
$self->{_disabled_transformers} = \%disabled_transformers; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Grab surrounding nodes to determine the context. |
58
|
|
|
|
|
|
|
# This determines whether the annotation applies to |
59
|
|
|
|
|
|
|
# the current line or the block that follows. |
60
|
13
|
|
|
|
|
50
|
my $annotation_line = $annotation_element->logical_line_number(); |
61
|
13
|
|
|
|
|
207
|
my $parent = $annotation_element->parent(); |
62
|
13
|
50
|
|
|
|
125
|
my $grandparent = $parent ? $parent->parent() : undef; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Handle case when it appears on the shebang line. In this |
65
|
|
|
|
|
|
|
# situation, it only affects the first line, not the whole doc |
66
|
13
|
50
|
|
|
|
58
|
if ( $annotation_element =~ m{\A [#]!}xms) { |
67
|
0
|
|
|
|
|
0
|
$self->{_effective_range} = [$annotation_line, $annotation_line]; |
68
|
0
|
|
|
|
|
0
|
return $self; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Handle single-line usage on simple statements. In this |
72
|
|
|
|
|
|
|
# situation, it only affects the line that it appears on. |
73
|
13
|
100
|
|
|
|
83
|
if ( _is_single_line_annotation_on_simple_statement( $annotation_element ) |
74
|
|
|
|
|
|
|
) { |
75
|
1
|
|
|
|
|
3
|
$self->{_effective_range} = [$annotation_line, $annotation_line]; |
76
|
1
|
|
|
|
|
2
|
return $self; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Handle single-line usage on compound statements. In this |
80
|
|
|
|
|
|
|
# situation -- um -- I'm not sure how this works, but it does. |
81
|
12
|
100
|
|
|
|
469
|
if ( ref $parent eq 'PPI::Structure::Block' ) { |
82
|
1
|
50
|
33
|
|
|
7
|
if ( ref $grandparent eq 'PPI::Statement::Compound' |
83
|
|
|
|
|
|
|
|| ref $grandparent eq 'PPI::Statement::Sub' ) { |
84
|
1
|
50
|
|
|
|
20
|
if ( $parent->logical_line_number() == $annotation_line ) { |
85
|
0
|
|
|
|
|
0
|
my $grandparent_line = $grandparent->logical_line_number(); |
86
|
0
|
|
|
|
|
0
|
$self->{_effective_range} = [$grandparent_line, $grandparent_line]; |
87
|
0
|
|
|
|
|
0
|
return $self; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Handle multi-line usage. This is either a "no mogrify" .. |
94
|
|
|
|
|
|
|
# "use mogrify" region or a block where "no mogrify" is in effect |
95
|
|
|
|
|
|
|
# until the end of the scope. The start is the always the "no |
96
|
|
|
|
|
|
|
# mogrify" which we already found. So now we have to search for the end. |
97
|
12
|
|
|
|
|
64
|
my $end = $annotation_element; |
98
|
12
|
|
|
|
|
44
|
my $use_mogrify = qr{\A \s* [#][#] \s* use \s+ mogrify}xms; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
SIB: |
101
|
12
|
|
|
|
|
43
|
while ( my $esib = $end->next_sibling() ) { |
102
|
24
|
|
|
|
|
473
|
$end = $esib; # keep track of last sibling encountered in this scope |
103
|
24
|
100
|
66
|
|
|
209
|
last SIB if $esib->isa('PPI::Token::Comment') && $esib =~ $use_mogrify; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# PPI parses __END__ as a PPI::Statement::End, and everything following is |
107
|
|
|
|
|
|
|
# a child of that statement. That means if we encounter an __END__, we |
108
|
|
|
|
|
|
|
# need to descend into it and continue the analysis. |
109
|
12
|
100
|
66
|
|
|
216
|
if ( $end->isa( 'PPI::Statement::End' ) and my $kid = $end->child( 0 ) ) { |
110
|
1
|
|
|
|
|
7
|
$end = $kid; |
111
|
|
|
|
|
|
|
SIB: |
112
|
1
|
|
|
|
|
5
|
while ( my $esib = $end->next_sibling() ) { |
113
|
3
|
|
|
|
|
32
|
$end = $esib; |
114
|
3
|
50
|
33
|
|
|
16
|
last SIB if $esib->isa( 'PPI::Token::Comment' ) && |
115
|
|
|
|
|
|
|
$esib->content() =~ $use_mogrify; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# We either found an end or hit the end of the scope. |
120
|
12
|
|
|
|
|
43
|
my $ending_line = $end->logical_line_number(); |
121
|
12
|
|
|
|
|
172
|
$self->{_effective_range} = [$annotation_line, $ending_line]; |
122
|
12
|
|
|
|
|
46
|
return $self; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub element { |
128
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
129
|
0
|
|
|
|
|
0
|
return $self->{_element}; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub effective_range { |
135
|
12
|
|
|
12
|
1
|
19
|
my $self = shift; |
136
|
12
|
|
|
|
|
17
|
return @{ $self->{_effective_range} }; |
|
12
|
|
|
|
|
41
|
|
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub disabled_transformers { |
142
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
143
|
0
|
|
|
|
|
0
|
return keys %{ $self->{_disabled_transformers} }; |
|
0
|
|
|
|
|
0
|
|
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub disables_transformer { |
149
|
8
|
|
|
8
|
1
|
16
|
my ($self, $transformer_name) = @_; |
150
|
8
|
50
|
|
|
|
74
|
return 1 if $self->{_disabled_transformers}->{$transformer_name}; |
151
|
0
|
0
|
|
|
|
0
|
return 1 if $self->disables_all_transformers(); |
152
|
0
|
|
|
|
|
0
|
return 0; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub disables_all_transformers { |
158
|
12
|
|
|
12
|
1
|
16293
|
my ($self) = @_; |
159
|
12
|
|
|
|
|
82
|
return $self->{_disables_all_transformers}; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub disables_line { |
165
|
13
|
|
|
13
|
1
|
890
|
my ($self, $line_number) = @_; |
166
|
13
|
|
|
|
|
35
|
my $effective_range = $self->{_effective_range}; |
167
|
13
|
50
|
33
|
|
|
147
|
return 1 if $line_number >= $effective_range->[0] |
168
|
|
|
|
|
|
|
and $line_number <= $effective_range->[$LAST_ELEMENT]; |
169
|
0
|
|
|
|
|
0
|
return 0; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# Recognize a single-line annotation on a simple statement. |
175
|
|
|
|
|
|
|
sub _is_single_line_annotation_on_simple_statement { |
176
|
13
|
|
|
13
|
|
21
|
my ( $annotation_element ) = @_; |
177
|
13
|
|
|
|
|
34
|
my $annotation_line = $annotation_element->logical_line_number(); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# If there is no sibling, we are clearly not a single-line annotation of |
180
|
|
|
|
|
|
|
# any sort. |
181
|
13
|
100
|
|
|
|
153
|
my $sib = $annotation_element->sprevious_sibling() |
182
|
|
|
|
|
|
|
or return 0; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# The easy case: the sibling (whatever it is) is on the same line as the |
185
|
|
|
|
|
|
|
# annotation. |
186
|
1
|
50
|
|
|
|
30
|
$sib->logical_line_number() == $annotation_line |
187
|
|
|
|
|
|
|
and return 1; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# If the sibling is a node, we may have an annotation on one line of a |
190
|
|
|
|
|
|
|
# statement that was split over multiple lines. So we descend through the |
191
|
|
|
|
|
|
|
# children, keeping the last significant child of each, until we bottom |
192
|
|
|
|
|
|
|
# out. If the ultimate significant descendant is on the same line as the |
193
|
|
|
|
|
|
|
# annotation, we accept the annotation as a single-line annotation. |
194
|
1
|
50
|
33
|
|
|
25
|
if ( $sib->isa( 'PPI::Node' ) && |
195
|
|
|
|
|
|
|
$sib->logical_line_number() < $annotation_line |
196
|
|
|
|
|
|
|
) { |
197
|
1
|
|
|
|
|
11
|
my $neighbor = $sib; |
198
|
1
|
|
66
|
|
|
7
|
while ( $neighbor->isa( 'PPI::Node' ) |
199
|
|
|
|
|
|
|
and my $kid = $neighbor->schild( $LAST_ELEMENT ) ) { |
200
|
1
|
|
|
|
|
16
|
$neighbor = $kid; |
201
|
|
|
|
|
|
|
} |
202
|
1
|
50
|
33
|
|
|
8
|
if ( $neighbor && |
203
|
|
|
|
|
|
|
$neighbor->logical_line_number() == $annotation_line |
204
|
|
|
|
|
|
|
) { |
205
|
1
|
|
|
|
|
11
|
return 1; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# We do not understand any other sort of single-line annotation. Accepting |
210
|
|
|
|
|
|
|
# the annotation as such (if it is) is Someone Else's Problem. |
211
|
0
|
|
|
|
|
0
|
return 0; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _parse_annotation { |
217
|
|
|
|
|
|
|
|
218
|
13
|
|
|
13
|
|
15
|
my ($annotation_element) = @_; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
############################################################################# |
221
|
|
|
|
|
|
|
# This regex captures the list of Transformer name patterns that are to be |
222
|
|
|
|
|
|
|
# disabled. It is generally assumed that the element has already been |
223
|
|
|
|
|
|
|
# verified as a no-mogrify annotation. So if this regex does not match, |
224
|
|
|
|
|
|
|
# then it implies that all Transformers are to be disabled. |
225
|
|
|
|
|
|
|
# |
226
|
13
|
|
|
|
|
40
|
my $no_mogrify = qr{\#\# \s* no \s+ mogrify \s* (?:qw)? [("'] ([\s\w:,]+) }xms; |
227
|
|
|
|
|
|
|
# -------------------------- ------- ----- ----------- |
228
|
|
|
|
|
|
|
# | | | | |
229
|
|
|
|
|
|
|
# "## no mogrify" with optional spaces | | | |
230
|
|
|
|
|
|
|
# | | | |
231
|
|
|
|
|
|
|
# Transformer list may be prefixed with "qw" | | |
232
|
|
|
|
|
|
|
# | | |
233
|
|
|
|
|
|
|
# Optional Transformer list must begin with one of these | |
234
|
|
|
|
|
|
|
# | |
235
|
|
|
|
|
|
|
# Capture entire Transformer list (with delimiters) here |
236
|
|
|
|
|
|
|
# |
237
|
|
|
|
|
|
|
############################################################################# |
238
|
|
|
|
|
|
|
|
239
|
13
|
|
|
|
|
23
|
my @disabled_transformer_names = (); |
240
|
13
|
100
|
|
|
|
58
|
if ( my ($patterns_string) = $annotation_element =~ $no_mogrify ) { |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# Compose the specified modules into a regex alternation. Wrap each |
243
|
|
|
|
|
|
|
# in a no-capturing group to permit "|" in the modules specification. |
244
|
|
|
|
|
|
|
|
245
|
11
|
|
|
|
|
150
|
my @transformer_name_patterns = grep { $_ ne $EMPTY } |
|
14
|
|
|
|
|
45
|
|
246
|
|
|
|
|
|
|
split m{\s *[,\s] \s*}xms, $patterns_string; |
247
|
11
|
|
|
|
|
25
|
my $re = join $PIPE, map {"(?:$_)"} @transformer_name_patterns; |
|
11
|
|
|
|
|
43
|
|
248
|
11
|
|
|
|
|
42
|
my @site_transformer_names = Perl::ToPerl6::TransformerFactory::site_transformer_names(); |
249
|
11
|
|
|
|
|
36
|
@disabled_transformer_names = grep {m/$re/ixms} @site_transformer_names; |
|
418
|
|
|
|
|
894
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# It is possible that the Transformer patterns listed in the annotation do not |
252
|
|
|
|
|
|
|
# match any of the site transformer names. This could happen when running |
253
|
|
|
|
|
|
|
# on a machine that does not have the same set of Transformers as the |
254
|
|
|
|
|
|
|
# author. |
255
|
|
|
|
|
|
|
# So we must return something here, otherwise all Transformers will be |
256
|
|
|
|
|
|
|
# disabled. We probably need to add a mechanism to (optionally) warn |
257
|
|
|
|
|
|
|
# about this, just to help the author avoid writing invalid Transformer names. |
258
|
|
|
|
|
|
|
|
259
|
11
|
100
|
|
|
|
57
|
if (not @disabled_transformer_names) { |
260
|
2
|
|
|
|
|
8
|
@disabled_transformer_names = @transformer_name_patterns; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
13
|
|
|
|
|
66
|
return hashify(@disabled_transformer_names); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
1; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
__END__ |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=pod |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head1 NAME |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Perl::ToPerl6::Annotation - A "## no mogrify" annotation in a document. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head1 SYNOPSIS |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
use Perl::ToPerl6::Annotation; |
283
|
|
|
|
|
|
|
$annotation = Perl::ToPerl6::Annotation->new( -element => $no_mogrify_ppi_element ); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
$bool = $annotation->disables_line( $number ); |
286
|
|
|
|
|
|
|
$bool = $annotation->disables_transformer( $transformer_object ); |
287
|
|
|
|
|
|
|
$bool = $annotation->disables_all_transformers(); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
($start, $end) = $annotation->effective_range(); |
290
|
|
|
|
|
|
|
@disabled_transformer_names = $annotation->disabled_transformers(); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head1 DESCRIPTION |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
C<Perl::ToPerl6::Annotation> represents a single C<"## no mogrify"> |
296
|
|
|
|
|
|
|
annotation in a L<PPI:Document>. The Annotation takes care of parsing |
297
|
|
|
|
|
|
|
the annotation and keeps track of which lines and Transformers it affects. |
298
|
|
|
|
|
|
|
It is intended to encapsulate the details of the no-mogrify |
299
|
|
|
|
|
|
|
annotations, and to provide a way for Transformer objects to interact with |
300
|
|
|
|
|
|
|
the annotations (via a L<Perl::ToPerl6::Document|Perl::ToPerl6::Document>). |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head1 INTERFACE SUPPORT |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
This is considered to be a non-public class. Its interface is subject |
306
|
|
|
|
|
|
|
to change without notice. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head1 CLASS METHODS |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=over |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=item create_annotations( -doc => $doc ) |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Given a L<Perl::ToPerl6::Document|Perl::ToPerl6::Document>, finds all the C<"## no mogrify"> |
316
|
|
|
|
|
|
|
annotations and constructs a new C<Perl::ToPerl6::Annotation> for each |
317
|
|
|
|
|
|
|
one and returns them. The order of the returned objects is not |
318
|
|
|
|
|
|
|
defined. It is generally expected that clients will use this |
319
|
|
|
|
|
|
|
interface rather than calling the C<Perl::ToPerl6::Annotation> |
320
|
|
|
|
|
|
|
constructor directly. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=back |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=over |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item C<< new( -element => $ppi_annotation_element ) >> |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Returns a reference to a new Annotation object. The B<-element> |
333
|
|
|
|
|
|
|
argument is required and should be a C<PPI::Token::Comment> that |
334
|
|
|
|
|
|
|
conforms to the C<"## no mogrify"> syntax. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=back |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head1 METHODS |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=over |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=item C<< disables_line( $line ) >> |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Returns true if this Annotation disables C<$line> for any (or all) |
347
|
|
|
|
|
|
|
Transformers. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=item C<< disables_transformer( $transformer_object ) >> |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=item C<< disables_transformer( $transformer_name ) >> |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Returns true if this Annotation disables C<$polciy_object> or |
355
|
|
|
|
|
|
|
C<$transformer_name> at any (or all) lines. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=item C<< disables_all_transformers() >> |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
Returns true if this Annotation disables all Transformers at any (or all) |
361
|
|
|
|
|
|
|
lines. If this method returns true, C<disabled_transformers> will return |
362
|
|
|
|
|
|
|
an empty list. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=item C<< effective_range() >> |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
Returns a two-element list, representing the first and last line |
368
|
|
|
|
|
|
|
numbers where this Annotation has effect. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=item C<< disabled_transformers() >> |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Returns a list of the names of the Transformers that are affected by this |
374
|
|
|
|
|
|
|
Annotation. If this list is empty, then it means that all Transformers |
375
|
|
|
|
|
|
|
are affected by this Annotation, and C<disables_all_transformers()> should |
376
|
|
|
|
|
|
|
return true. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=item C<< element() >> |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
Returns the L<PPI::Element|PPI::Element> where this annotation started. This is |
382
|
|
|
|
|
|
|
typically an instance of L<PPI::Token::Comment|PPI::Token::Comment>. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=back |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head1 AUTHOR |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Jeffrey Ryan Thalhammer <jeff@imaginative-software.com> |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=head1 COPYRIGHT |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
398
|
|
|
|
|
|
|
it under the same terms as Perl itself. The full text of this license |
399
|
|
|
|
|
|
|
can be found in the LICENSE file included with this module. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
############################################################################## |
404
|
|
|
|
|
|
|
# Local Variables: |
405
|
|
|
|
|
|
|
# mode: cperl |
406
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
407
|
|
|
|
|
|
|
# fill-column: 78 |
408
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
409
|
|
|
|
|
|
|
# c-indentation-style: bsd |
410
|
|
|
|
|
|
|
# End: |
411
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |