line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use 5.006001; |
3
|
2
|
|
|
2
|
|
427713
|
use strict; |
|
2
|
|
|
|
|
13
|
|
4
|
2
|
|
|
2
|
|
14
|
use warnings; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
39
|
|
5
|
2
|
|
|
2
|
|
9
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
56
|
|
6
|
|
|
|
|
|
|
use English qw{ -no_match_vars }; |
7
|
2
|
|
|
2
|
|
12
|
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
11
|
|
8
|
|
|
|
|
|
|
use PPI::Document; |
9
|
2
|
|
|
2
|
|
1020
|
use PPIx::QuoteLike 0.011; |
|
2
|
|
|
|
|
32765
|
|
|
2
|
|
|
|
|
62
|
|
10
|
2
|
|
|
2
|
|
979
|
use PPIx::QuoteLike::Constant 0.011 qw{ |
|
2
|
|
|
|
|
247759
|
|
|
2
|
|
|
|
|
102
|
|
11
|
2
|
|
|
|
|
149
|
LOCATION_LINE |
12
|
|
|
|
|
|
|
LOCATION_LOGICAL_FILE |
13
|
|
|
|
|
|
|
LOCATION_LOGICAL_LINE |
14
|
|
|
|
|
|
|
LOCATION_CHARACTER |
15
|
|
|
|
|
|
|
LOCATION_COLUMN |
16
|
|
|
|
|
|
|
}; |
17
|
2
|
|
|
2
|
|
19
|
use PPIx::Regexp 0.071; |
|
2
|
|
|
|
|
30
|
|
18
|
2
|
|
|
2
|
|
13
|
use Readonly; |
|
2
|
|
|
|
|
36
|
|
|
2
|
|
|
|
|
45
|
|
19
|
2
|
|
|
2
|
|
10
|
use Scalar::Util qw{ refaddr }; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
104
|
|
20
|
2
|
|
|
2
|
|
15
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
79
|
|
21
|
|
|
|
|
|
|
use Perl::Critic::Exception::Fatal::PolicyDefinition; |
22
|
2
|
|
|
2
|
|
13
|
use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal }; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
65
|
|
23
|
2
|
|
|
2
|
|
11
|
use Perl::Critic::Utils qw< :booleans :characters hashify :severities >; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
78
|
|
24
|
2
|
|
|
2
|
|
10
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
104
|
|
25
|
|
|
|
|
|
|
use base 'Perl::Critic::Policy'; |
26
|
2
|
|
|
2
|
|
553
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
975
|
|
27
|
|
|
|
|
|
|
our $VERSION = '0.114'; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Readonly::Scalar my $EXPL => |
32
|
|
|
|
|
|
|
q<Unused variables clutter code and make it harder to read>; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Determine whether a PPI::Statement::Variable refers to a global or a |
35
|
|
|
|
|
|
|
# lexical variable. We need to track globals to avoid false negatives |
36
|
|
|
|
|
|
|
# from things like |
37
|
|
|
|
|
|
|
# |
38
|
|
|
|
|
|
|
# my $foo; |
39
|
|
|
|
|
|
|
# { |
40
|
|
|
|
|
|
|
# our $foo; |
41
|
|
|
|
|
|
|
# $foo = 'bar'; |
42
|
|
|
|
|
|
|
# } |
43
|
|
|
|
|
|
|
# |
44
|
|
|
|
|
|
|
# but we do not need to track 'local', because if you |
45
|
|
|
|
|
|
|
# s/ \b our \b /local/smxg |
46
|
|
|
|
|
|
|
# in the above, Perl complains that you can not localize a lexical |
47
|
|
|
|
|
|
|
# variable, rather than localizing the corresponding global variable. |
48
|
|
|
|
|
|
|
Readonly::Hash my %GLOBAL_DECLARATION => ( |
49
|
|
|
|
|
|
|
my => $FALSE, |
50
|
|
|
|
|
|
|
state => $FALSE, |
51
|
|
|
|
|
|
|
our => $TRUE, |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Readonly::Scalar my $CATCH => 'catch'; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Readonly::Scalar my $PACKAGE => '_' . __PACKAGE__; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Readonly::Scalar my $LEFT_BRACE => q<{>; # } Seems P::C::U should have |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Readonly::Hash my %IS_COMMA => hashify( $COMMA, $FATCOMMA ); |
61
|
|
|
|
|
|
|
Readonly::Hash my %IS_INC_DEC => hashify( qw{ ++ -- } ); |
62
|
|
|
|
|
|
|
Readonly::Hash my %LOW_PRECEDENCE_BOOLEAN => hashify( qw{ and or xor } ); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Readonly::Array my @DOUBLE_QUOTISH => qw{ |
65
|
|
|
|
|
|
|
PPI::Token::Quote::Double |
66
|
|
|
|
|
|
|
PPI::Token::Quote::Interpolate |
67
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Backtick |
68
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Command |
69
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Readline |
70
|
|
|
|
|
|
|
PPI::Token::HereDoc |
71
|
|
|
|
|
|
|
}; |
72
|
|
|
|
|
|
|
Readonly::Array my @REGEXP_ISH => qw{ |
73
|
|
|
|
|
|
|
PPI::Token::Regexp::Match |
74
|
|
|
|
|
|
|
PPI::Token::Regexp::Substitute |
75
|
|
|
|
|
|
|
PPI::Token::QuoteLike::Regexp |
76
|
|
|
|
|
|
|
}; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
{ |
81
|
|
|
|
|
|
|
name => 'allow_if_computed_by', |
82
|
|
|
|
|
|
|
description => 'Allow if computed by one of these', |
83
|
61
|
|
|
61
|
0
|
243596
|
behavior => 'string list', |
84
|
|
|
|
|
|
|
}, |
85
|
|
|
|
|
|
|
{ name => 'prohibit_reference_only_variables', |
86
|
|
|
|
|
|
|
description => 'Prohibit reference-only variables', |
87
|
|
|
|
|
|
|
behavior => 'boolean', |
88
|
|
|
|
|
|
|
default_string => '0', |
89
|
|
|
|
|
|
|
}, |
90
|
|
|
|
|
|
|
{ name => 'prohibit_returned_lexicals', |
91
|
|
|
|
|
|
|
description => 'Prohibit returned lexicals', |
92
|
|
|
|
|
|
|
behavior => 'boolean', |
93
|
|
|
|
|
|
|
default_string => '0', |
94
|
|
|
|
|
|
|
}, |
95
|
|
|
|
|
|
|
{ name => 'allow_unused_subroutine_arguments', |
96
|
|
|
|
|
|
|
description => 'Allow unused subroutine arguments', |
97
|
|
|
|
|
|
|
behavior => 'boolean', |
98
|
|
|
|
|
|
|
default_string => '0', |
99
|
|
|
|
|
|
|
}, |
100
|
|
|
|
|
|
|
{ |
101
|
|
|
|
|
|
|
name => 'allow_state_in_expression', |
102
|
|
|
|
|
|
|
description => 'Allow state variable with low-precedence Boolean', |
103
|
|
|
|
|
|
|
behavior => 'boolean', |
104
|
|
|
|
|
|
|
default_string => '0', |
105
|
|
|
|
|
|
|
}, |
106
|
|
|
|
|
|
|
{ |
107
|
|
|
|
|
|
|
name => 'check_catch', |
108
|
|
|
|
|
|
|
description => 'Check the catch() clause of try/catch', |
109
|
|
|
|
|
|
|
behavior => 'boolean', |
110
|
|
|
|
|
|
|
default_string => '0', |
111
|
|
|
|
|
|
|
}, |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
name => 'dump', |
114
|
|
|
|
|
|
|
description => 'UNSUPPORTED: Dump symbol definitions', |
115
|
|
|
|
|
|
|
behavior => 'boolean', |
116
|
|
|
|
|
|
|
default_string => '0', |
117
|
|
|
|
|
|
|
}, |
118
|
|
|
|
|
|
|
{ |
119
|
|
|
|
|
|
|
name => 'trace', |
120
|
|
|
|
|
|
|
description => 'UNSUPPORTED: Trace variable processing', |
121
|
|
|
|
|
|
|
behavior => 'string list', |
122
|
|
|
|
|
|
|
}, |
123
|
|
|
|
|
|
|
) } |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
127
|
44
|
|
|
44
|
1
|
2286
|
|
128
|
0
|
|
|
0
|
1
|
0
|
# my ( $self, $elem, $document ) = @_; |
129
|
60
|
|
|
60
|
1
|
608680
|
my ( $self, undef, $document ) = @_; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
$self->{$PACKAGE} = { |
132
|
|
|
|
|
|
|
declared => {}, # Keyed by PPI::Token::Symbol->symbol(). |
133
|
|
|
|
|
|
|
# Values are a list of hashes |
134
|
|
|
|
|
|
|
# representing declarations of the given |
135
|
60
|
|
|
60
|
1
|
592
|
# symbol, in reverse order. In each |
136
|
|
|
|
|
|
|
# hash: |
137
|
60
|
|
|
|
|
355
|
# {declaration} is the PPI statement |
138
|
|
|
|
|
|
|
# object in which the variable is |
139
|
|
|
|
|
|
|
# declared; |
140
|
|
|
|
|
|
|
# {element} is the PPI::Token::Symbol |
141
|
|
|
|
|
|
|
# {is_allowed_computation} is true |
142
|
|
|
|
|
|
|
# if the value of the symbol is |
143
|
|
|
|
|
|
|
# initialized using one of the |
144
|
|
|
|
|
|
|
# allowed subroutines or classes |
145
|
|
|
|
|
|
|
# (e.g. Scope::Guard). |
146
|
|
|
|
|
|
|
# {is_global} is true if the declaration |
147
|
|
|
|
|
|
|
# is a global (i.e. is 'our', not 'my'); |
148
|
|
|
|
|
|
|
# {is_state_in_expression} is true if |
149
|
|
|
|
|
|
|
# the variable is a 'state' variable |
150
|
|
|
|
|
|
|
# and the assignment is part of an |
151
|
|
|
|
|
|
|
# expression. |
152
|
|
|
|
|
|
|
# {is_unpacking} is true if the |
153
|
|
|
|
|
|
|
# declaration occurs in an argument |
154
|
|
|
|
|
|
|
# unpacking; |
155
|
|
|
|
|
|
|
# {taking_reference} is true if the code |
156
|
|
|
|
|
|
|
# takes a reference to the declared |
157
|
|
|
|
|
|
|
# variable; |
158
|
|
|
|
|
|
|
# {used} is a count of the number of |
159
|
|
|
|
|
|
|
# times that declaration was used, |
160
|
|
|
|
|
|
|
# initialized to 0. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
is_declaration => {}, # Keyed by refaddr of PPI::Token::Symbol. |
163
|
|
|
|
|
|
|
# True if the object represents a |
164
|
|
|
|
|
|
|
# declaration. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
need_sort => $FALSE, # Boolean that says whether the symbol |
167
|
|
|
|
|
|
|
# declarations need to be sorted in |
168
|
|
|
|
|
|
|
# lexical order. Recording a declaration |
169
|
|
|
|
|
|
|
# must set this. Recording a use must |
170
|
|
|
|
|
|
|
# clear this, doing the sort if it was |
171
|
|
|
|
|
|
|
# previously set. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
ppix_objects => {}, # Cache of PPIx::QuoteLike and |
174
|
|
|
|
|
|
|
# PPIx::Regexp objects indexed by |
175
|
|
|
|
|
|
|
# refaddr of parent element. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
parent_element => {}, # PPI::Element objects from which |
178
|
|
|
|
|
|
|
# PPI::Document objects have been |
179
|
|
|
|
|
|
|
# derived, indexed by refaddr of derived |
180
|
|
|
|
|
|
|
# document. |
181
|
|
|
|
|
|
|
}; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Ensure entire document is indexed. We don't call index_locations() |
184
|
|
|
|
|
|
|
# because that is unconditional. We wrap the whole thing in an eval |
185
|
|
|
|
|
|
|
# because last_token() can fail under undiagnosed circumstances. |
186
|
|
|
|
|
|
|
{ |
187
|
|
|
|
|
|
|
local $EVAL_ERROR = undef; |
188
|
|
|
|
|
|
|
eval { ## no critic (RequireCheckingReturnValueOfEval) |
189
|
|
|
|
|
|
|
if ( my $token = $document->last_token() ) { |
190
|
|
|
|
|
|
|
$token->location(); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
60
|
|
|
|
|
118
|
} |
|
60
|
|
|
|
|
114
|
|
194
|
60
|
|
|
|
|
123
|
|
195
|
60
|
50
|
|
|
|
389
|
$self->_get_symbol_declarations( $document ); |
196
|
60
|
|
|
|
|
1608
|
|
197
|
|
|
|
|
|
|
$self->_get_symbol_uses( $document ); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
$self->{_dump} |
200
|
|
|
|
|
|
|
and $self->_dump(); |
201
|
60
|
|
|
|
|
810
|
|
202
|
|
|
|
|
|
|
return $self->_get_violations(); |
203
|
60
|
|
|
|
|
188
|
|
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
60
|
50
|
|
|
|
144
|
#----------------------------------------------------------------------------- |
207
|
|
|
|
|
|
|
|
208
|
60
|
|
|
|
|
138
|
my ( $self ) = @_; |
209
|
|
|
|
|
|
|
foreach my $name ( sort keys %{ $self->{$PACKAGE}{declared} } ) { |
210
|
|
|
|
|
|
|
# NOTE that 'print { STDERR } ... ' does not compile under |
211
|
|
|
|
|
|
|
# strict refs. '{ *STDERR }' is a terser way to satisfy |
212
|
|
|
|
|
|
|
# InputOutput::RequireBracedFileHandleWithPrint. |
213
|
|
|
|
|
|
|
print { *STDERR } "$name\n"; |
214
|
|
|
|
|
|
|
foreach my $decl ( @{ $self->{$PACKAGE}{declared}{$name} } ) { |
215
|
0
|
|
|
0
|
|
0
|
my $sym = $decl->{element}; |
216
|
0
|
|
|
|
|
0
|
my $fn = $sym->logical_filename(); |
|
0
|
|
|
|
|
0
|
|
217
|
|
|
|
|
|
|
if ( defined $fn ) { |
218
|
|
|
|
|
|
|
$fn =~ s/ (?= [\\'] ) /\\/smxg; |
219
|
|
|
|
|
|
|
$fn = "'$fn'"; |
220
|
0
|
|
|
|
|
0
|
} else { |
|
0
|
|
|
|
|
0
|
|
221
|
0
|
|
|
|
|
0
|
$fn = 'undef'; |
|
0
|
|
|
|
|
0
|
|
222
|
0
|
|
|
|
|
0
|
} |
223
|
0
|
|
|
|
|
0
|
printf { *STDERR } |
224
|
0
|
0
|
|
|
|
0
|
" %s line %d column %d: used %d; returned %d\n", |
225
|
0
|
|
|
|
|
0
|
$fn, |
226
|
0
|
|
|
|
|
0
|
$sym->logical_line_number(), |
227
|
|
|
|
|
|
|
$sym->column_number(), |
228
|
0
|
|
|
|
|
0
|
$decl->{used}, |
229
|
|
|
|
|
|
|
$decl->{returned_lexical} || 0, |
230
|
0
|
|
|
|
|
0
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
return; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
236
|
0
|
|
0
|
|
|
0
|
|
237
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
0
|
$self->_get_variable_declarations( $document ); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$self->_get_stray_variable_declarations( $document ); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
$self->{_check_catch} |
244
|
|
|
|
|
|
|
and $self->_get_catch_declarations( $document ); |
245
|
60
|
|
|
60
|
|
117
|
|
246
|
|
|
|
|
|
|
return; |
247
|
60
|
|
|
|
|
197
|
|
248
|
|
|
|
|
|
|
} |
249
|
60
|
|
|
|
|
195
|
|
250
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
251
|
|
|
|
|
|
|
|
252
|
60
|
100
|
|
|
|
163
|
# We assume the argument is actually eligible for this operation. |
253
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
254
|
60
|
|
|
|
|
107
|
return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||= |
255
|
|
|
|
|
|
|
PPIx::QuoteLike->new( $elem ); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# We assume the argument is actually eligible for this operation. The |
261
|
|
|
|
|
|
|
# complication here is that if we are dealing with an element of a |
262
|
60
|
|
|
60
|
|
147
|
# Perl::Critic::Document we want to call ppix_regexp_from_element(), |
263
|
60
|
|
66
|
|
|
421
|
# since that caches the returned object, making it available to all |
264
|
|
|
|
|
|
|
# policies. But the ppi() method returns a PPI::Document, so the best we |
265
|
|
|
|
|
|
|
# can do is to cache locally. |
266
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
267
|
|
|
|
|
|
|
return $self->{$PACKAGE}{ppix_objects}{ refaddr $elem } ||= do { |
268
|
|
|
|
|
|
|
my $doc = $elem->top(); |
269
|
|
|
|
|
|
|
my $code; |
270
|
|
|
|
|
|
|
( $code = $doc->can( 'ppix_regexp_from_element' ) ) ? |
271
|
|
|
|
|
|
|
$code->( $doc, $elem ) : |
272
|
|
|
|
|
|
|
PPIx::Regexp->new( $elem ); |
273
|
|
|
|
|
|
|
}; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
18
|
|
|
18
|
|
54
|
#----------------------------------------------------------------------------- |
277
|
18
|
|
66
|
|
|
158
|
|
278
|
9
|
|
|
|
|
47
|
# Get the PPI::Document that represents a PPIx::* class that supports |
279
|
9
|
|
|
|
|
118
|
# one. The arguments are: |
280
|
9
|
50
|
|
|
|
105
|
# $ppix_elem - the PPIx::* element providing the document. This MUST |
281
|
|
|
|
|
|
|
# support the ->ppi() method. |
282
|
|
|
|
|
|
|
# $elem - the original PPI::Element from which this element was |
283
|
|
|
|
|
|
|
# derived. |
284
|
|
|
|
|
|
|
# NOTE that all calls to ->ppi() MUST come through here. |
285
|
|
|
|
|
|
|
my ( $self, $ppix_elem, $elem ) = @_; |
286
|
|
|
|
|
|
|
my $ppi = $ppix_elem->ppi() |
287
|
|
|
|
|
|
|
or return; |
288
|
|
|
|
|
|
|
$self->{$PACKAGE}{parent_element}{ refaddr( $ppi ) } ||= $elem; |
289
|
|
|
|
|
|
|
return $ppi; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# Get the PPI::Element that is the parent of the given PPI::Element, |
295
|
|
|
|
|
|
|
# taking into account that the given element may be a derived |
296
|
72
|
|
|
72
|
|
181
|
# PPI::Document. |
297
|
72
|
50
|
|
|
|
267
|
# NOTE that all calls to PPI::Element->parent() MUST come through here. |
298
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; |
299
|
72
|
|
66
|
|
|
36259
|
if ( my $parent = $elem->parent() ) { |
300
|
72
|
|
|
|
|
244
|
return $parent; |
301
|
|
|
|
|
|
|
} else { |
302
|
|
|
|
|
|
|
return $self->{$PACKAGE}{parent_element}{ refaddr( $elem ) }; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Get the lowest parent of the inner element that is in the same |
309
|
|
|
|
|
|
|
# document as the outer element. |
310
|
252
|
|
|
252
|
|
768
|
my ( $self, $inner_elem, $outer_elem ) = @_; |
311
|
252
|
100
|
|
|
|
570
|
my $outer_top = $outer_elem->top() |
312
|
209
|
|
|
|
|
1281
|
or return; |
313
|
|
|
|
|
|
|
while ( 1 ) { |
314
|
43
|
|
|
|
|
307
|
my $inner_top = $inner_elem->top() |
315
|
|
|
|
|
|
|
or last; |
316
|
|
|
|
|
|
|
$inner_top == $outer_top |
317
|
|
|
|
|
|
|
and return $inner_elem; |
318
|
|
|
|
|
|
|
$inner_elem = $self->_get_parent_element( $inner_top ) |
319
|
|
|
|
|
|
|
or last; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
return; |
322
|
|
|
|
|
|
|
} |
323
|
85
|
|
|
85
|
|
151
|
|
324
|
85
|
50
|
|
|
|
224
|
#----------------------------------------------------------------------------- |
325
|
|
|
|
|
|
|
|
326
|
85
|
|
|
|
|
832
|
my ( $self, $document ) = @_; |
327
|
120
|
50
|
|
|
|
294
|
|
328
|
|
|
|
|
|
|
my @rslt = @{ $document->find( 'PPI::Statement::Variable' ) || [] }; |
329
|
120
|
100
|
|
|
|
1344
|
|
330
|
|
|
|
|
|
|
foreach my $class ( @DOUBLE_QUOTISH ) { |
331
|
39
|
100
|
|
|
|
236
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
332
|
|
|
|
|
|
|
my $str = $self->_get_ppix_quotelike( $elem ) |
333
|
|
|
|
|
|
|
or next; |
334
|
4
|
|
|
|
|
15
|
foreach my $code ( @{ $str->find( |
335
|
|
|
|
|
|
|
'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) { |
336
|
|
|
|
|
|
|
my $ppi = $self->_get_derived_ppi_document( $code, $elem ) |
337
|
|
|
|
|
|
|
or next; |
338
|
|
|
|
|
|
|
push @rslt, $self->_get_ppi_statement_variable( $ppi ); |
339
|
|
|
|
|
|
|
} |
340
|
96
|
|
|
96
|
|
255
|
} |
341
|
|
|
|
|
|
|
} |
342
|
96
|
100
|
|
|
|
207
|
|
|
96
|
|
|
|
|
269
|
|
343
|
|
|
|
|
|
|
foreach my $class ( @REGEXP_ISH ) { |
344
|
96
|
|
|
|
|
10946
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
345
|
576
|
100
|
|
|
|
46728
|
my $pre = $self->_get_ppix_regexp( $elem ) |
|
576
|
|
|
|
|
1198
|
|
346
|
30
|
50
|
|
|
|
861
|
or next; |
347
|
|
|
|
|
|
|
foreach my $code ( @{ $pre->find( |
348
|
30
|
100
|
|
|
|
34697
|
'PPIx::Regexp::Token::Code' ) || [] } ) { |
|
30
|
|
|
|
|
109
|
|
349
|
|
|
|
|
|
|
my $ppi = $self->_get_derived_ppi_document( $code, $elem ) |
350
|
27
|
50
|
|
|
|
1799
|
or next; |
351
|
|
|
|
|
|
|
push @rslt, $self->_get_ppi_statement_variable( $ppi ); |
352
|
27
|
|
|
|
|
91
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
return @rslt; |
357
|
96
|
|
|
|
|
9213
|
} |
358
|
288
|
100
|
|
|
|
17820
|
|
|
288
|
|
|
|
|
695
|
|
359
|
9
|
50
|
|
|
|
753
|
#----------------------------------------------------------------------------- |
360
|
|
|
|
|
|
|
|
361
|
9
|
50
|
|
|
|
77014
|
# The catch() clause of try/catch is a special case because the 'my' is |
|
9
|
|
|
|
|
47
|
|
362
|
|
|
|
|
|
|
# implied. Also the syntax requires you to specify a variable even if |
363
|
9
|
50
|
|
|
|
2465
|
# you have no intention of using it. |
364
|
|
|
|
|
|
|
# NOTE that we assume that if we get called, the check is to be done. |
365
|
9
|
|
|
|
|
28
|
my ( $self, $document ) = @_; |
366
|
|
|
|
|
|
|
foreach my $word ( @{ $document->find( 'PPI::Token::Word' ) || [] } ) { |
367
|
|
|
|
|
|
|
$CATCH eq $word->content() |
368
|
|
|
|
|
|
|
or next; |
369
|
|
|
|
|
|
|
my $list = $word->snext_sibling() |
370
|
96
|
|
|
|
|
9167
|
or next; |
371
|
|
|
|
|
|
|
$list->isa( 'PPI::Structure::List' ) |
372
|
|
|
|
|
|
|
or next; |
373
|
|
|
|
|
|
|
my $block = $list->snext_sibling() |
374
|
|
|
|
|
|
|
or next; |
375
|
|
|
|
|
|
|
$block->isa( 'PPI::Structure::Block' ) |
376
|
|
|
|
|
|
|
or next; |
377
|
|
|
|
|
|
|
foreach my $sym ( @{ $list->find( 'PPI::Token::Symbol' ) || [] } ) { |
378
|
|
|
|
|
|
|
# Should be only one, but ... |
379
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
380
|
2
|
|
|
2
|
|
4
|
$sym, $sym->statement() ); |
381
|
2
|
50
|
|
|
|
4
|
} |
|
2
|
|
|
|
|
6
|
|
382
|
7
|
100
|
|
|
|
42
|
} |
383
|
|
|
|
|
|
|
return; |
384
|
2
|
50
|
|
|
|
19
|
} |
385
|
|
|
|
|
|
|
|
386
|
2
|
50
|
|
|
|
53
|
#----------------------------------------------------------------------------- |
387
|
|
|
|
|
|
|
|
388
|
2
|
50
|
|
|
|
15
|
# Sorry, but this is just basicly hard. |
389
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
390
|
2
|
50
|
|
|
|
48
|
|
391
|
|
|
|
|
|
|
foreach my $declaration ( $self->_get_ppi_statement_variable( $document ) ) { |
392
|
2
|
50
|
|
|
|
12
|
|
|
2
|
|
|
|
|
7
|
|
393
|
|
|
|
|
|
|
# This _should_ be the initial 'my', 'our' 'state' |
394
|
2
|
|
|
|
|
435
|
my $elem = $declaration->schild( 0 ) |
395
|
|
|
|
|
|
|
or next; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
my $is_unpacking = $declaration->content() =~ m< |
398
|
2
|
|
|
|
|
7
|
= \s* (?: \@_ | |
399
|
|
|
|
|
|
|
shift (?: \s* \@_ )? ) | |
400
|
|
|
|
|
|
|
\$_ [[] .*? []] |
401
|
|
|
|
|
|
|
\s* ;? \z >smx; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
my $taking_reference = $self->_taking_reference_of_variable( |
404
|
|
|
|
|
|
|
$declaration ); |
405
|
60
|
|
|
60
|
|
119
|
|
406
|
|
|
|
|
|
|
my $returned_lexical = $self->_returned_lexical( $declaration ); |
407
|
60
|
|
|
|
|
160
|
|
408
|
|
|
|
|
|
|
while ( 1 ) { |
409
|
|
|
|
|
|
|
|
410
|
100
|
50
|
|
|
|
1346
|
# Looking for 'my', 'our', or 'state' |
411
|
|
|
|
|
|
|
$elem->isa( 'PPI::Token::Word' ) |
412
|
|
|
|
|
|
|
or next; |
413
|
100
|
|
|
|
|
1311
|
defined( my $is_global = $GLOBAL_DECLARATION{ |
414
|
|
|
|
|
|
|
$elem->content()} ) |
415
|
|
|
|
|
|
|
or next; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
$elem = $elem->snext_sibling() |
418
|
|
|
|
|
|
|
or last; |
419
|
100
|
|
|
|
|
3944
|
|
420
|
|
|
|
|
|
|
# We can't just look for symbols, since PPI parses the |
421
|
|
|
|
|
|
|
# parens in |
422
|
100
|
|
|
|
|
461
|
# open( my $fh, '>&', \*STDOUT ) |
423
|
|
|
|
|
|
|
# as a PPI::Statement::Variable, and we get a false positive |
424
|
100
|
|
|
|
|
858
|
# on STDOUT. |
425
|
|
|
|
|
|
|
my @symbol_list; |
426
|
|
|
|
|
|
|
if ( $elem->isa( 'PPI::Token::Symbol' ) ) { |
427
|
386
|
100
|
|
|
|
6557
|
push @symbol_list, $elem; |
428
|
|
|
|
|
|
|
} elsif ( $elem->isa( 'PPI::Structure::List' ) ) { |
429
|
|
|
|
|
|
|
push @symbol_list, @{ |
430
|
120
|
100
|
|
|
|
265
|
$elem->find( 'PPI::Token::Symbol' ) || [] }; |
431
|
|
|
|
|
|
|
} else { |
432
|
|
|
|
|
|
|
next; |
433
|
102
|
100
|
|
|
|
1174
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
my ( $assign, $is_allowed_computation, |
436
|
|
|
|
|
|
|
$is_state_in_expression ) = |
437
|
|
|
|
|
|
|
$self->_get_allowed_and_state( $elem, $declaration ); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
foreach my $symbol ( @symbol_list ) { |
440
|
|
|
|
|
|
|
|
441
|
100
|
|
|
|
|
2048
|
if ( $assign ) { |
442
|
100
|
100
|
|
|
|
270
|
$symbol->logical_line_number() < |
|
|
50
|
|
|
|
|
|
443
|
91
|
|
|
|
|
168
|
$assign->logical_line_number() |
444
|
|
|
|
|
|
|
or $symbol->logical_line_number() == |
445
|
|
|
|
|
|
|
$assign->logical_line_number() |
446
|
9
|
50
|
|
|
|
111
|
and $symbol->column_number() < $assign->column_number() |
|
9
|
|
|
|
|
28
|
|
447
|
|
|
|
|
|
|
or next; |
448
|
0
|
|
|
|
|
0
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
451
|
100
|
|
|
|
|
2561
|
$symbol, $declaration, |
452
|
|
|
|
|
|
|
is_allowed_computation => $is_allowed_computation, |
453
|
|
|
|
|
|
|
is_global => $is_global, |
454
|
|
|
|
|
|
|
is_state_in_expression => $is_state_in_expression, |
455
|
100
|
|
|
|
|
218
|
is_unpacking => $is_unpacking, |
456
|
|
|
|
|
|
|
taking_reference => $taking_reference, |
457
|
107
|
100
|
|
|
|
255
|
returned_lexical => $returned_lexical, |
458
|
86
|
50
|
33
|
|
|
200
|
); |
|
|
|
33
|
|
|
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
} continue { |
463
|
|
|
|
|
|
|
$elem |
464
|
|
|
|
|
|
|
and $elem = $elem->snext_sibling() |
465
|
|
|
|
|
|
|
or last; |
466
|
|
|
|
|
|
|
} |
467
|
107
|
|
|
|
|
5487
|
|
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# FIXME this is a God-awful mish-mash forced on me by the fact that PPI |
474
|
|
|
|
|
|
|
# does not in fact parse all variable declarations as |
475
|
|
|
|
|
|
|
# PPI::Statement::Variable objects, so this code needs to be shared |
476
|
|
|
|
|
|
|
# among multiple code paths. The arguments are: |
477
|
|
|
|
|
|
|
# $self |
478
|
|
|
|
|
|
|
# $elem - the relevant element of the statement |
479
|
384
|
100
|
66
|
|
|
1471
|
# $declaration - the statement that declares the variable |
480
|
|
|
|
|
|
|
# $type - 'my', 'our', 'state'. Forbidden (but not enforcded) if |
481
|
|
|
|
|
|
|
# $declaration isa PPI::Statement::Variable, otherwise required. |
482
|
|
|
|
|
|
|
my ( $self, $elem, $declaration, $type ) = @_; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my ( $assign, $is_allowed_computation, |
485
|
|
|
|
|
|
|
$is_state_in_expression ); |
486
|
60
|
|
|
|
|
1148
|
|
487
|
|
|
|
|
|
|
while ( $elem = $elem->snext_sibling() ) { |
488
|
|
|
|
|
|
|
$elem->isa( 'PPI::Token::Operator' ) |
489
|
|
|
|
|
|
|
or next; |
490
|
|
|
|
|
|
|
my $content = $elem->content(); |
491
|
|
|
|
|
|
|
$IS_COMMA{$content} |
492
|
|
|
|
|
|
|
and last; |
493
|
|
|
|
|
|
|
if ( $EQUAL eq $content ) { |
494
|
|
|
|
|
|
|
$assign = $elem; |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
$is_allowed_computation = $self->_is_allowed_computation( |
497
|
|
|
|
|
|
|
$assign ); |
498
|
|
|
|
|
|
|
|
499
|
109
|
|
|
109
|
|
246
|
$is_state_in_expression = $self->_is_state_in_expression( |
500
|
|
|
|
|
|
|
$declaration, $assign, $type ); |
501
|
109
|
|
|
|
|
169
|
|
502
|
|
|
|
|
|
|
last; |
503
|
|
|
|
|
|
|
} elsif ( $IS_INC_DEC{$content} ) { |
504
|
109
|
|
|
|
|
237
|
$is_state_in_expression = 1; |
505
|
114
|
100
|
|
|
|
2425
|
last; |
506
|
|
|
|
|
|
|
} |
507
|
96
|
|
|
|
|
256
|
} |
508
|
96
|
100
|
|
|
|
499
|
|
509
|
|
|
|
|
|
|
return ( $assign, $is_allowed_computation, $is_state_in_expression ); |
510
|
90
|
100
|
|
|
|
670
|
} |
|
|
100
|
|
|
|
|
|
511
|
84
|
|
|
|
|
132
|
|
512
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
513
|
84
|
|
|
|
|
177
|
|
514
|
|
|
|
|
|
|
{ |
515
|
|
|
|
|
|
|
|
516
|
84
|
|
|
|
|
191
|
Readonly::Hash my %IS_FOR => hashify( qw{ for foreach } ); |
517
|
|
|
|
|
|
|
Readonly::Hash my %IS_RETURN => hashify( qw{ return } ); |
518
|
|
|
|
|
|
|
|
519
|
84
|
|
|
|
|
186
|
# Get stray declarations that do not show up in |
520
|
|
|
|
|
|
|
# PPI::Statement::Variable statements. These show up in |
521
|
4
|
|
|
|
|
25
|
# PPI::Statement::Compound (specifically 'for' and 'foreach'), and |
522
|
4
|
|
|
|
|
8
|
# in PPI::Statement::Break (specifically 'return'). In the case of |
523
|
|
|
|
|
|
|
# 'return', we do not need to descend into paren, because if there |
524
|
|
|
|
|
|
|
# are parens, PPI produces a PPI::Statement::Variable. |
525
|
|
|
|
|
|
|
|
526
|
109
|
|
|
|
|
664
|
my ( $self, $document ) = @_; |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
foreach ( |
529
|
|
|
|
|
|
|
[ 'PPI::Statement::Compound' => { |
530
|
|
|
|
|
|
|
want => \%IS_FOR, |
531
|
|
|
|
|
|
|
returned_lexical => $FALSE, |
532
|
|
|
|
|
|
|
} ], |
533
|
|
|
|
|
|
|
[ 'PPI::Statement::Break' => { |
534
|
|
|
|
|
|
|
want => \%IS_RETURN, |
535
|
|
|
|
|
|
|
returned_lexical => $TRUE, |
536
|
|
|
|
|
|
|
} ], |
537
|
|
|
|
|
|
|
) { |
538
|
|
|
|
|
|
|
my ( $class, $info ) = @{ $_ }; |
539
|
|
|
|
|
|
|
foreach my $declaration ( |
540
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
541
|
|
|
|
|
|
|
) { |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
my $type = $declaration->schild( 0 ) |
544
|
60
|
|
|
60
|
|
122
|
or next; |
545
|
|
|
|
|
|
|
|
546
|
60
|
|
|
|
|
333
|
my $type_str = $type->content(); |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
if ( $info->{want}{$type_str} ) { |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
my $sib = $type->snext_sibling() |
551
|
|
|
|
|
|
|
or next; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
# We're looking for 'my', 'state', or 'our'. |
554
|
|
|
|
|
|
|
$sib->isa( 'PPI::Token::Word' ) |
555
|
|
|
|
|
|
|
or next; |
556
|
120
|
|
|
|
|
805
|
my $sib_content = $sib->content(); |
|
120
|
|
|
|
|
237
|
|
557
|
120
|
|
|
|
|
209
|
defined( my $is_global = $GLOBAL_DECLARATION{$sib_content} ) |
558
|
120
|
100
|
|
|
|
310
|
or next; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
my $symbol = $sib->snext_sibling() |
561
|
25
|
50
|
|
|
|
240
|
or next; |
562
|
|
|
|
|
|
|
$symbol->isa( 'PPI::Token::Symbol' ) |
563
|
|
|
|
|
|
|
or next; |
564
|
25
|
|
|
|
|
314
|
|
565
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
566
|
25
|
100
|
|
|
|
903
|
$symbol, $declaration, |
567
|
|
|
|
|
|
|
is_global => $is_global, |
568
|
13
|
50
|
|
|
|
82
|
returned_lexical => $info->{returned_lexical}, |
569
|
|
|
|
|
|
|
); |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
} |
572
|
13
|
100
|
|
|
|
243
|
|
573
|
|
|
|
|
|
|
} |
574
|
8
|
|
|
|
|
31
|
|
575
|
8
|
50
|
|
|
|
41
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
return; |
578
|
8
|
50
|
|
|
|
57
|
} |
579
|
|
|
|
|
|
|
|
580
|
8
|
50
|
|
|
|
163
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; # $elem presumed to be '='. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
my $next_sib = $elem->snext_sibling() or return; |
587
|
8
|
|
|
|
|
22
|
|
588
|
|
|
|
|
|
|
if ( $next_sib->isa( 'PPI::Token::Word' ) ) { |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# We are presumed to be a subroutine call. |
591
|
|
|
|
|
|
|
my $content = $next_sib->content(); |
592
|
|
|
|
|
|
|
$self->{_allow_if_computed_by}{$content} |
593
|
|
|
|
|
|
|
and return $content; |
594
|
|
|
|
|
|
|
|
595
|
60
|
|
|
|
|
667
|
} elsif ( $next_sib->isa( 'PPI::Token::Symbol' ) ) { |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# We might be a method call. |
598
|
|
|
|
|
|
|
$next_sib = $next_sib->snext_sibling() |
599
|
|
|
|
|
|
|
or return; |
600
|
|
|
|
|
|
|
$next_sib->isa( 'PPI::Token::Operator' ) |
601
|
|
|
|
|
|
|
and q{->} eq $next_sib->content() |
602
|
|
|
|
|
|
|
or return; |
603
|
84
|
|
|
84
|
|
177
|
$next_sib = $next_sib->snext_sibling() |
604
|
|
|
|
|
|
|
or return; |
605
|
84
|
50
|
|
|
|
177
|
my $content = $next_sib->content(); |
606
|
|
|
|
|
|
|
$self->{_allow_if_computed_by}{$content} |
607
|
84
|
100
|
|
|
|
1942
|
and return $content; |
|
|
100
|
|
|
|
|
|
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
12
|
|
|
|
|
32
|
return; |
611
|
12
|
100
|
|
|
|
58
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# Find cases where the value of a state variable is used by the |
616
|
|
|
|
|
|
|
# statement that declares it, or an expression in which that statement |
617
|
8
|
50
|
|
|
|
19
|
# appears. The user may wish to accept such variables even if the |
618
|
|
|
|
|
|
|
# variable itself appears only in the statement that declares it. |
619
|
8
|
50
|
33
|
|
|
174
|
# |
620
|
|
|
|
|
|
|
# $declaration is assumed to be a PPI::Statement::Variable. We return |
621
|
|
|
|
|
|
|
# $FALSE unless it declares state variables. |
622
|
0
|
0
|
|
|
|
0
|
# |
623
|
|
|
|
|
|
|
# $operator is the first assignment operator in $declaration. |
624
|
0
|
|
|
|
|
0
|
# |
625
|
0
|
0
|
|
|
|
0
|
# NOTE that this will never be called for stuff like |
626
|
|
|
|
|
|
|
# $foo and state $bar = 42 |
627
|
|
|
|
|
|
|
# because PPI does not parse this as a PPI::Statement::Variable. |
628
|
|
|
|
|
|
|
my ( $self, $declaration, $operator, $type ) = @_; |
629
|
75
|
|
|
|
|
190
|
|
630
|
|
|
|
|
|
|
unless ( defined $type ) { ## no critic (ProhibitUnlessBlocks) |
631
|
|
|
|
|
|
|
$declaration->can( 'type' ) |
632
|
|
|
|
|
|
|
or throw_internal |
633
|
|
|
|
|
|
|
'BUG - $type required if $declaration->type() does not exist'; ## no critic (RequireInterpolationOfMetachars) |
634
|
|
|
|
|
|
|
$type = $declaration->type(); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# We're only interested in state declarations. |
638
|
|
|
|
|
|
|
q<state> eq $type |
639
|
|
|
|
|
|
|
or return $FALSE; |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# We accept things like |
642
|
|
|
|
|
|
|
# state $foo = bar() and ... |
643
|
|
|
|
|
|
|
my $next_sib = $operator; |
644
|
|
|
|
|
|
|
while ( $next_sib = $next_sib->snext_sibling() ) { |
645
|
|
|
|
|
|
|
$next_sib->isa( 'PPI::Token::Operator' ) |
646
|
|
|
|
|
|
|
and $LOW_PRECEDENCE_BOOLEAN{ $next_sib->content() } |
647
|
|
|
|
|
|
|
and return $TRUE; |
648
|
84
|
|
|
84
|
|
165
|
} |
649
|
|
|
|
|
|
|
|
650
|
84
|
100
|
|
|
|
175
|
# We accept things like |
651
|
82
|
50
|
|
|
|
268
|
# ... ( state $foo = bar() ) ... |
652
|
|
|
|
|
|
|
# IF at least one of the ellipses has an operator adjacent to our |
653
|
|
|
|
|
|
|
# declaration. |
654
|
82
|
|
|
|
|
219
|
my $elem = $declaration; |
655
|
|
|
|
|
|
|
while ( $elem ) { |
656
|
|
|
|
|
|
|
foreach my $method ( qw{ snext_sibling sprevious_sibling } ) { |
657
|
|
|
|
|
|
|
my $sib = $elem->$method() |
658
|
84
|
100
|
|
|
|
2770
|
or next; |
659
|
|
|
|
|
|
|
$sib->isa( 'PPI::Token::Operator' ) |
660
|
|
|
|
|
|
|
and return $TRUE; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
$elem = $self->_get_parent_element( $elem ); |
663
|
7
|
|
|
|
|
12
|
} |
664
|
7
|
|
|
|
|
17
|
|
665
|
|
|
|
|
|
|
# There are no other known cases where a state variable's value can |
666
|
14
|
100
|
66
|
|
|
325
|
# be used without the variable name appearing anywhere other than |
667
|
|
|
|
|
|
|
# its initialization. |
668
|
|
|
|
|
|
|
return $FALSE; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable |
674
|
5
|
|
|
|
|
106
|
my $parent = $self->_get_parent_element( $elem ) |
675
|
5
|
|
|
|
|
16
|
or return; |
676
|
14
|
|
|
|
|
23
|
my $cast; |
677
|
27
|
100
|
|
|
|
188
|
|
678
|
|
|
|
|
|
|
if ( $parent->isa( 'PPI::Structure::List' ) ) { |
679
|
9
|
100
|
|
|
|
182
|
|
680
|
|
|
|
|
|
|
$cast = $parent->sprevious_sibling() |
681
|
|
|
|
|
|
|
or return; |
682
|
13
|
|
|
|
|
116
|
|
683
|
|
|
|
|
|
|
} elsif ( $parent->isa( 'PPI::Structure::Block' ) ) { |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my $prev = $parent->sprevious_sibling() |
686
|
|
|
|
|
|
|
or return; |
687
|
|
|
|
|
|
|
|
688
|
4
|
|
|
|
|
10
|
$prev->isa( 'PPI::Token::Word' ) |
689
|
|
|
|
|
|
|
or return; |
690
|
|
|
|
|
|
|
'do' eq $prev->content() |
691
|
|
|
|
|
|
|
or return; |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
$cast = $prev->sprevious_sibling() |
694
|
100
|
|
|
100
|
|
207
|
|
695
|
100
|
50
|
|
|
|
236
|
} |
696
|
|
|
|
|
|
|
|
697
|
100
|
|
|
|
|
159
|
$cast |
698
|
|
|
|
|
|
|
or return; |
699
|
100
|
100
|
|
|
|
476
|
$cast->isa( 'PPI::Token::Cast' ) |
|
|
100
|
|
|
|
|
|
700
|
|
|
|
|
|
|
or return; |
701
|
12
|
100
|
|
|
|
81
|
return q<\\> eq $cast->content() |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
705
|
|
|
|
|
|
|
|
706
|
23
|
100
|
|
|
|
67
|
my ( $self, $elem ) = @_; # Expect a PPI::Statement::Variable |
707
|
|
|
|
|
|
|
my $parent = $self->_get_parent_element( $elem ) |
708
|
|
|
|
|
|
|
or return; |
709
|
14
|
100
|
|
|
|
340
|
my $stmt = $parent->statement() |
710
|
|
|
|
|
|
|
or return; |
711
|
13
|
100
|
|
|
|
32
|
$stmt->isa( 'PPI::Statement::Break' ) |
712
|
|
|
|
|
|
|
or return; |
713
|
|
|
|
|
|
|
my $kind = $stmt->schild( 0 ) |
714
|
4
|
|
|
|
|
24
|
or return; # Should never happen. |
715
|
|
|
|
|
|
|
return 'return' eq $kind->content(); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
719
|
80
|
100
|
|
|
|
476
|
|
720
|
13
|
100
|
|
|
|
51
|
{ |
721
|
|
|
|
|
|
|
|
722
|
6
|
|
|
|
|
15
|
Readonly::Hash my %CAST_FOR_BARE_BRACKETED_VARIABLE => qw{ |
723
|
|
|
|
|
|
|
@ @ |
724
|
|
|
|
|
|
|
$ $ |
725
|
|
|
|
|
|
|
$$ $ |
726
|
|
|
|
|
|
|
% % |
727
|
|
|
|
|
|
|
}; |
728
|
100
|
|
|
100
|
|
180
|
|
729
|
100
|
50
|
|
|
|
208
|
my ( $self, $document ) = @_; |
730
|
|
|
|
|
|
|
|
731
|
100
|
100
|
|
|
|
262
|
foreach my $symbol ( |
732
|
|
|
|
|
|
|
@{ $document->find( 'PPI::Token::Symbol' ) || [] } |
733
|
36
|
100
|
|
|
|
609
|
) { |
734
|
|
|
|
|
|
|
$self->{$PACKAGE}{is_declaration}->{ refaddr( $symbol ) } and next; |
735
|
4
|
50
|
|
|
|
9
|
|
736
|
|
|
|
|
|
|
$self->_record_symbol_use( $document, $symbol ); |
737
|
4
|
|
|
|
|
51
|
|
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
# For some reason, PPI parses '$#foo' as a |
741
|
|
|
|
|
|
|
# PPI::Token::ArrayIndex. $#$foo is parsed as a Cast followed |
742
|
|
|
|
|
|
|
# by a Symbol, so as long as nobody decides the '$#' cast causes |
743
|
|
|
|
|
|
|
# $elem->symbol() to return something other than '$foo', we're |
744
|
|
|
|
|
|
|
# cool. |
745
|
|
|
|
|
|
|
foreach my $elem ( |
746
|
|
|
|
|
|
|
@{ $document->find( 'PPI::Token::ArrayIndex' ) || [] } |
747
|
|
|
|
|
|
|
) { |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
my $name = $elem->content(); |
750
|
|
|
|
|
|
|
$name =~ s/ \A \$ [#] /@/smx or next; |
751
|
|
|
|
|
|
|
|
752
|
99
|
|
|
99
|
|
197
|
$self->_record_symbol_use( $document, $elem, $name ); |
753
|
|
|
|
|
|
|
} |
754
|
99
|
|
|
|
|
160
|
|
755
|
99
|
100
|
|
|
|
234
|
# Occasionally you see something like ${foo} outside quotes. |
756
|
|
|
|
|
|
|
# This is legitimate, though PPI parses it as a cast followed by |
757
|
215
|
100
|
|
|
|
10272
|
# a block. On the assumption that there are fewer blocks than |
758
|
|
|
|
|
|
|
# words in most Perl, we start at the top and work down. Perl |
759
|
98
|
|
|
|
|
247
|
# also handles punctuation variables specified this way, but |
760
|
|
|
|
|
|
|
# since PPI goes berserk when it sees this, we won't bother. |
761
|
|
|
|
|
|
|
# |
762
|
|
|
|
|
|
|
# And EXTREMELY occasionally something like $${foo} gets parsed |
763
|
|
|
|
|
|
|
# as magic followed by subscript. |
764
|
|
|
|
|
|
|
foreach my $class ( qw{ |
765
|
|
|
|
|
|
|
PPI::Structure::Block |
766
|
|
|
|
|
|
|
PPI::Structure::Subscript |
767
|
|
|
|
|
|
|
} |
768
|
99
|
|
|
|
|
631
|
) { |
769
|
99
|
100
|
|
|
|
254
|
foreach my $elem ( |
770
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
771
|
|
|
|
|
|
|
) { |
772
|
1
|
|
|
|
|
12
|
$LEFT_BRACE eq $elem->start() # Only needed for subscript. |
773
|
1
|
50
|
|
|
|
9
|
or next; |
774
|
|
|
|
|
|
|
my $previous = $elem->sprevious_sibling() |
775
|
1
|
|
|
|
|
4
|
or next; |
776
|
|
|
|
|
|
|
$previous->isa( 'PPI::Token::Cast' ) |
777
|
|
|
|
|
|
|
or $previous->isa( 'PPI::Token::Magic' ) # $${foo} |
778
|
|
|
|
|
|
|
or next; |
779
|
|
|
|
|
|
|
my $sigil = $CAST_FOR_BARE_BRACKETED_VARIABLE{ |
780
|
|
|
|
|
|
|
$previous->content() } |
781
|
|
|
|
|
|
|
or next; |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
my @kids = $elem->schildren(); |
784
|
|
|
|
|
|
|
1 == @kids |
785
|
|
|
|
|
|
|
or next; |
786
|
|
|
|
|
|
|
$kids[0]->isa( 'PPI::Statement' ) |
787
|
99
|
|
|
|
|
9757
|
or next; |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
my @grand_kids = $kids[0]->schildren(); |
790
|
|
|
|
|
|
|
1 == @grand_kids |
791
|
|
|
|
|
|
|
or next; |
792
|
198
|
|
|
|
|
8727
|
|
793
|
198
|
100
|
|
|
|
434
|
# Yes, "${v6}_..." occurred, and was parsed as a |
794
|
|
|
|
|
|
|
# PPI::Token::Number::Version by PPI 1.270. |
795
|
62
|
100
|
|
|
|
3555
|
$grand_kids[0]->isa( 'PPI::Token::Word' ) |
796
|
|
|
|
|
|
|
or $grand_kids[0]->isa( 'PPI::Token::Number::Version' ) |
797
|
54
|
100
|
|
|
|
891
|
or next; |
798
|
|
|
|
|
|
|
|
799
|
44
|
100
|
66
|
|
|
1184
|
$self->_record_symbol_use( $document, $elem, |
800
|
|
|
|
|
|
|
$sigil . $grand_kids[0]->content(), |
801
|
|
|
|
|
|
|
); |
802
|
|
|
|
|
|
|
} |
803
|
4
|
50
|
|
|
|
10
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
$self->_get_regexp_symbol_uses( $document ); |
806
|
4
|
|
|
|
|
53
|
|
807
|
4
|
50
|
|
|
|
41
|
$self->_get_double_quotish_string_uses( $document ); |
808
|
|
|
|
|
|
|
|
809
|
4
|
50
|
|
|
|
14
|
$self->_get_subroutine_signature_uses( $document ); |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
return; |
812
|
4
|
|
|
|
|
13
|
} |
813
|
4
|
50
|
|
|
|
30
|
|
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
817
|
|
|
|
|
|
|
|
818
|
4
|
100
|
66
|
|
|
29
|
# Record the definition of a symbol. |
819
|
|
|
|
|
|
|
# $symbol is the PPI::Token::Symbol |
820
|
|
|
|
|
|
|
# $declaration is the statement that declares it |
821
|
|
|
|
|
|
|
# %arg is optional arguments, collected and recorded to support the |
822
|
1
|
|
|
|
|
5
|
# various configuration items. |
823
|
|
|
|
|
|
|
my ( $self, $symbol, $declaration, %arg ) = @_; |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
my $ref_addr = refaddr( $symbol ); |
826
|
|
|
|
|
|
|
my $sym_name = $symbol->symbol(); |
827
|
|
|
|
|
|
|
|
828
|
99
|
|
|
|
|
6545
|
$self->{$PACKAGE}{is_declaration}{$ref_addr} = 1; |
829
|
|
|
|
|
|
|
|
830
|
99
|
|
|
|
|
317
|
$arg{declaration} = $declaration; |
831
|
|
|
|
|
|
|
$arg{element} = $symbol; |
832
|
99
|
|
|
|
|
291
|
$arg{used} = 0; |
833
|
|
|
|
|
|
|
|
834
|
99
|
|
|
|
|
249
|
foreach my $key ( qw{ |
835
|
|
|
|
|
|
|
is_allowed_computation |
836
|
|
|
|
|
|
|
is_global |
837
|
|
|
|
|
|
|
is_state_in_expression |
838
|
|
|
|
|
|
|
is_unpacking |
839
|
|
|
|
|
|
|
taking_reference |
840
|
|
|
|
|
|
|
returned_lexical |
841
|
|
|
|
|
|
|
} ) { |
842
|
|
|
|
|
|
|
exists $arg{$key} |
843
|
|
|
|
|
|
|
or $arg{$key} = $FALSE; |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
if ( $self->{_trace}{$sym_name} ) { |
847
|
126
|
|
|
126
|
|
659
|
printf { *STDERR } |
848
|
|
|
|
|
|
|
"%s 0x%x declared at line %d col %d\n", |
849
|
126
|
|
|
|
|
353
|
$sym_name, $ref_addr, |
850
|
126
|
|
|
|
|
357
|
$symbol->logical_line_number(), $symbol->column_number(); |
851
|
|
|
|
|
|
|
} |
852
|
126
|
|
|
|
|
5135
|
|
853
|
|
|
|
|
|
|
push @{ $self->{$PACKAGE}{declared}{ $sym_name } ||= [] }, \%arg; |
854
|
126
|
|
|
|
|
250
|
|
855
|
126
|
|
|
|
|
301
|
$self->{$PACKAGE}{need_sort} = $TRUE; |
856
|
126
|
|
|
|
|
294
|
|
857
|
|
|
|
|
|
|
return; |
858
|
126
|
|
|
|
|
272
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
my ( $self, undef, $symbol, $symbol_name ) = @_; # $document not used |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
my $declaration; |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
defined $symbol_name |
867
|
756
|
100
|
|
|
|
1518
|
or $symbol_name = $symbol->symbol(); |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
if ( ! ( $declaration = $self->{$PACKAGE}{declared}{$symbol_name} ) ) { |
870
|
126
|
50
|
|
|
|
294
|
# If we did not find a declaration for the symbol, it may |
871
|
0
|
|
|
|
|
0
|
# have been declared en passant, as part of doing something |
|
0
|
|
|
|
|
0
|
|
872
|
|
|
|
|
|
|
# else. |
873
|
|
|
|
|
|
|
my $prev = $symbol->sprevious_sibling() |
874
|
|
|
|
|
|
|
or return; |
875
|
|
|
|
|
|
|
$prev->isa( 'PPI::Token::Word' ) |
876
|
|
|
|
|
|
|
or return; |
877
|
126
|
|
100
|
|
|
214
|
my $type = $prev->content(); |
|
126
|
|
|
|
|
552
|
|
878
|
|
|
|
|
|
|
exists $GLOBAL_DECLARATION{$type} |
879
|
126
|
|
|
|
|
281
|
or return; |
880
|
|
|
|
|
|
|
|
881
|
126
|
|
|
|
|
346
|
# Yup. It's a declaration. Record it. |
882
|
|
|
|
|
|
|
$declaration = $symbol->statement(); |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
my $cast = $prev->sprevious_sibling(); |
885
|
|
|
|
|
|
|
if ( ! $cast ) { |
886
|
|
|
|
|
|
|
my $parent; |
887
|
100
|
|
|
100
|
|
220
|
$parent = $self->_get_parent_element( $prev ) |
888
|
|
|
|
|
|
|
and $cast = $parent->sprevious_sibling(); |
889
|
100
|
|
|
|
|
149
|
} |
890
|
|
|
|
|
|
|
|
891
|
100
|
100
|
|
|
|
312
|
my ( undef, $is_allowed_computation, |
892
|
|
|
|
|
|
|
$is_state_in_expression ) = |
893
|
|
|
|
|
|
|
$self->_get_allowed_and_state( $symbol, $declaration, |
894
|
100
|
100
|
|
|
|
4541
|
$type ); |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
$self->_record_symbol_definition( |
897
|
|
|
|
|
|
|
$symbol, $declaration, |
898
|
30
|
100
|
|
|
|
75
|
is_allowed_computation => $is_allowed_computation, |
899
|
|
|
|
|
|
|
is_global => $GLOBAL_DECLARATION{$type}, |
900
|
20
|
100
|
|
|
|
499
|
is_state_in_expression => $is_state_in_expression, |
901
|
|
|
|
|
|
|
taking_reference => _element_takes_reference( $cast ), |
902
|
12
|
|
|
|
|
29
|
); |
903
|
12
|
100
|
|
|
|
72
|
|
904
|
|
|
|
|
|
|
return; |
905
|
|
|
|
|
|
|
} |
906
|
|
|
|
|
|
|
|
907
|
9
|
|
|
|
|
70
|
if ( delete $self->{$PACKAGE}{need_sort} ) { |
908
|
|
|
|
|
|
|
# Because we need multiple passes to find all the declarations, |
909
|
9
|
|
|
|
|
116
|
# we have to put them in reverse order when we're done. We need |
910
|
9
|
50
|
|
|
|
166
|
# to repeat the check because of the possibility of picking up |
911
|
0
|
|
|
|
|
0
|
# declarations made in passing while trying to find uses. |
912
|
0
|
0
|
|
|
|
0
|
# Re the 'no critic' annotation: I understand that 'reverse ...' |
913
|
|
|
|
|
|
|
# is faster and clearer than 'sort { $b cmp $a } ...', but I |
914
|
|
|
|
|
|
|
# think the dereferenes negate this. |
915
|
|
|
|
|
|
|
foreach my $decls ( values %{ $self->{$PACKAGE}{declared} } ) { |
916
|
9
|
|
|
|
|
22
|
@{ $decls } = map { $_->[0] } |
917
|
|
|
|
|
|
|
sort { ## no critic (ProhibitReverseSortBlock) |
918
|
|
|
|
|
|
|
$b->[1][LOCATION_LOGICAL_LINE] <=> |
919
|
|
|
|
|
|
|
$a->[1][LOCATION_LOGICAL_LINE] || |
920
|
|
|
|
|
|
|
$b->[1][LOCATION_CHARACTER] <=> |
921
|
|
|
|
|
|
|
$a->[1][LOCATION_CHARACTER] |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
map { [ $_, $_->{element}->location() ] } |
924
|
9
|
|
|
|
|
45
|
@{ $decls }; |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
foreach my $decl_scope ( @{ $declaration } ) { |
929
|
9
|
|
|
|
|
26
|
$self->_derived_element_is_in_lexical_scope_after_statement_containing( |
930
|
|
|
|
|
|
|
$symbol, $decl_scope->{declaration} ) |
931
|
|
|
|
|
|
|
or next; |
932
|
70
|
100
|
|
|
|
206
|
$decl_scope->{used}++; |
933
|
|
|
|
|
|
|
if ( $self->{_trace}{$symbol_name} ) { |
934
|
|
|
|
|
|
|
my $elem = $decl_scope->{element}; |
935
|
|
|
|
|
|
|
printf { *STDERR } |
936
|
|
|
|
|
|
|
"%s at line %d col %d refers to 0x%x at line %d col %d\n", |
937
|
|
|
|
|
|
|
$symbol_name, |
938
|
|
|
|
|
|
|
$symbol->logical_line_number(), |
939
|
|
|
|
|
|
|
$symbol->column_number(), |
940
|
33
|
|
|
|
|
72
|
refaddr( $elem ), |
|
33
|
|
|
|
|
131
|
|
941
|
56
|
|
|
|
|
156
|
$elem->logical_line_number(), |
|
70
|
|
|
|
|
592
|
|
942
|
|
|
|
|
|
|
$elem->column_number(), |
943
|
14
|
50
|
|
|
|
193
|
; |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
return; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
70
|
|
|
|
|
290
|
if ( $self->{_trace}{$symbol_name} ) { |
949
|
56
|
|
|
|
|
95
|
printf { *STDERR } |
|
56
|
|
|
|
|
108
|
|
950
|
|
|
|
|
|
|
"Failed to resolve %s at line %d col %d\n", |
951
|
|
|
|
|
|
|
$symbol_name, |
952
|
|
|
|
|
|
|
$symbol->logical_line_number(), |
953
|
70
|
|
|
|
|
133
|
$symbol->column_number(), |
|
70
|
|
|
|
|
171
|
|
954
|
|
|
|
|
|
|
; |
955
|
|
|
|
|
|
|
} |
956
|
85
|
100
|
|
|
|
310
|
|
957
|
70
|
|
|
|
|
981
|
return; |
958
|
70
|
50
|
|
|
|
161
|
|
959
|
0
|
|
|
|
|
0
|
} |
960
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
961
|
|
|
|
|
|
|
my ( $self, $inner_elem, $outer_elem ) = @_; |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
my $effective_inner = $self->_get_lowest_in_same_doc( $inner_elem, |
964
|
|
|
|
|
|
|
$outer_elem ) |
965
|
|
|
|
|
|
|
or return $FALSE; |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
return _element_is_in_lexical_scope_after_statement_containing( |
968
|
|
|
|
|
|
|
$effective_inner, $outer_elem ); |
969
|
|
|
|
|
|
|
|
970
|
70
|
|
|
|
|
183
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
973
|
0
|
0
|
|
|
|
0
|
|
974
|
0
|
|
|
|
|
0
|
my ( $elem ) = @_; |
|
0
|
|
|
|
|
0
|
|
975
|
|
|
|
|
|
|
return $elem && $elem->isa( 'PPI::Token::Cast' ) && |
976
|
|
|
|
|
|
|
$BSLASH eq $elem->content(); |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
982
|
0
|
|
|
|
|
0
|
|
983
|
|
|
|
|
|
|
foreach my $class ( @DOUBLE_QUOTISH ) { |
984
|
|
|
|
|
|
|
foreach my $double_quotish ( |
985
|
|
|
|
|
|
|
@{ $document->find( $class ) || [] } |
986
|
|
|
|
|
|
|
) { |
987
|
85
|
|
|
85
|
|
171
|
|
988
|
|
|
|
|
|
|
my $str = $self->_get_ppix_quotelike( $double_quotish ) |
989
|
85
|
100
|
|
|
|
214
|
or next; |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
foreach my $interp ( @{ |
992
|
|
|
|
|
|
|
$str->find( 'PPIx::QuoteLike::Token::Interpolation' ) || [] } ) { |
993
|
81
|
|
|
|
|
565
|
|
994
|
|
|
|
|
|
|
my $subdoc = $self->_get_derived_ppi_document( |
995
|
|
|
|
|
|
|
$interp, $double_quotish ) |
996
|
|
|
|
|
|
|
or next; |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $double_quotish ); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
} |
1001
|
9
|
|
|
9
|
|
16
|
|
1002
|
9
|
|
33
|
|
|
72
|
} |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
return; |
1006
|
|
|
|
|
|
|
} |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
1009
|
99
|
|
|
99
|
|
193
|
|
1010
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
1011
|
99
|
|
|
|
|
228
|
|
1012
|
594
|
|
|
|
|
48389
|
foreach my $class ( @REGEXP_ISH ) { |
1013
|
594
|
100
|
|
|
|
1274
|
|
1014
|
|
|
|
|
|
|
foreach my $regex ( @{ $document->find( $class ) || [] } ) { |
1015
|
|
|
|
|
|
|
|
1016
|
30
|
50
|
|
|
|
717
|
my $pre = $self->_get_ppix_regexp( $regex ) |
1017
|
|
|
|
|
|
|
or next; |
1018
|
|
|
|
|
|
|
|
1019
|
30
|
|
|
|
|
56
|
foreach my $code ( @{ |
1020
|
30
|
100
|
|
|
|
83
|
$pre->find( 'PPIx::Regexp::Token::Code' ) || [] } ) { |
1021
|
|
|
|
|
|
|
|
1022
|
27
|
50
|
|
|
|
931
|
my $subdoc = $self->_get_derived_ppi_document( $code, |
1023
|
|
|
|
|
|
|
$regex ); |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $regex ); |
1026
|
27
|
|
|
|
|
89
|
} |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
} |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
return; |
1033
|
99
|
|
|
|
|
9677
|
} |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# Stolen shamelessly from OALDERS' App::perlimports::Include |
1038
|
|
|
|
|
|
|
my ( $self, $document ) = @_; |
1039
|
99
|
|
|
99
|
|
202
|
|
1040
|
|
|
|
|
|
|
# FIXME as of PPI 1.272, signatures are parsed as prototypes. |
1041
|
99
|
|
|
|
|
369
|
foreach my $class ( qw{ PPI::Token::Prototype } ) { |
1042
|
|
|
|
|
|
|
foreach my $elem ( @{ $document->find( $class ) || [] } ) { |
1043
|
297
|
100
|
|
|
|
19577
|
my $sig = $elem->content(); |
|
297
|
|
|
|
|
628
|
|
1044
|
|
|
|
|
|
|
|
1045
|
9
|
50
|
|
|
|
763
|
# Skip over things that might actually be prototypes. Some |
1046
|
|
|
|
|
|
|
# of them may actually be signatures, but if so they specify |
1047
|
|
|
|
|
|
|
# only ignored variables, or maybe magic variables like $_ |
1048
|
9
|
|
|
|
|
22
|
# or @_. |
1049
|
9
|
50
|
|
|
|
53
|
$sig =~ m/ [[:alpha:]\d] /smx |
1050
|
|
|
|
|
|
|
or next; |
1051
|
9
|
|
|
|
|
2807
|
|
1052
|
|
|
|
|
|
|
# Strip leading and trailing parens. OALDERS' comments say |
1053
|
|
|
|
|
|
|
# that sometimes the trailing one is missing. |
1054
|
9
|
|
|
|
|
26
|
$sig =~ s/ \A \s* [(] \s* //smx; |
1055
|
|
|
|
|
|
|
$sig =~ s/ \s* [)] \s* \z //smx; |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
# Rewrite the signature as statements. |
1058
|
|
|
|
|
|
|
my @args; |
1059
|
|
|
|
|
|
|
foreach ( split / , /smx, $sig ) { |
1060
|
|
|
|
|
|
|
s/ \s+ \z //smx; |
1061
|
99
|
|
|
|
|
9646
|
s/ \A \s+ //smx; |
1062
|
|
|
|
|
|
|
# Skip unused arguments, since we're not interested in |
1063
|
|
|
|
|
|
|
# their position in the argument list. |
1064
|
|
|
|
|
|
|
m/ \A [\$\@%] (?: \s* = | \z ) /smx |
1065
|
|
|
|
|
|
|
and next; |
1066
|
|
|
|
|
|
|
# Ignore empty defaults. |
1067
|
|
|
|
|
|
|
s/ = \z //smx; |
1068
|
99
|
|
|
99
|
|
192
|
# FIXME there ought to be a 'my' in front, but because |
1069
|
|
|
|
|
|
|
# this policy has no way to find the uses of this |
1070
|
|
|
|
|
|
|
# variable it results in false positives. MAYBE I could |
1071
|
99
|
|
|
|
|
180
|
# fix this by calling _get_symbol_declarations() on |
1072
|
99
|
100
|
|
|
|
183
|
# $subdoc (in _element_to_ppi() so it only gets called |
|
99
|
|
|
|
|
241
|
|
1073
|
3
|
|
|
|
|
29
|
# once), but I don't think I want that in the same |
1074
|
|
|
|
|
|
|
# commit, or even the same release, as the bug fix. |
1075
|
|
|
|
|
|
|
push @args, "$_;"; |
1076
|
|
|
|
|
|
|
} |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
my $subdoc = $self->_element_to_ppi( $elem, "@args" ) |
1079
|
3
|
50
|
|
|
|
17
|
or next; |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
$self->_get_symbol_uses( $subdoc, $elem ); |
1082
|
|
|
|
|
|
|
} |
1083
|
|
|
|
|
|
|
} |
1084
|
3
|
|
|
|
|
14
|
|
1085
|
3
|
|
|
|
|
13
|
return; |
1086
|
|
|
|
|
|
|
} |
1087
|
|
|
|
|
|
|
|
1088
|
3
|
|
|
|
|
5
|
#----------------------------------------------------------------------------- |
1089
|
3
|
|
|
|
|
10
|
|
1090
|
5
|
|
|
|
|
13
|
my ( $self ) = @_; |
1091
|
5
|
|
|
|
|
11
|
|
1092
|
|
|
|
|
|
|
my @in_violation; |
1093
|
|
|
|
|
|
|
|
1094
|
5
|
100
|
|
|
|
17
|
foreach my $name ( values %{ $self->{$PACKAGE}{declared} } ) { |
1095
|
|
|
|
|
|
|
foreach my $declaration ( @{ $name } ) { |
1096
|
|
|
|
|
|
|
$declaration->{is_global} |
1097
|
3
|
|
|
|
|
6
|
and next; |
1098
|
|
|
|
|
|
|
$declaration->{used} |
1099
|
|
|
|
|
|
|
and next; |
1100
|
|
|
|
|
|
|
$declaration->{is_allowed_computation} |
1101
|
|
|
|
|
|
|
and next; |
1102
|
|
|
|
|
|
|
$declaration->{is_state_in_expression} |
1103
|
|
|
|
|
|
|
and $self->{_allow_state_in_expression} |
1104
|
|
|
|
|
|
|
and next; |
1105
|
3
|
|
|
|
|
8
|
$declaration->{taking_reference} |
1106
|
|
|
|
|
|
|
and not $self->{_prohibit_reference_only_variables} |
1107
|
|
|
|
|
|
|
and next; |
1108
|
3
|
50
|
|
|
|
14
|
$declaration->{returned_lexical} |
1109
|
|
|
|
|
|
|
and not $self->{_prohibit_returned_lexicals} |
1110
|
|
|
|
|
|
|
and next; |
1111
|
3
|
|
|
|
|
9
|
$declaration->{is_unpacking} |
1112
|
|
|
|
|
|
|
and $self->{_allow_unused_subroutine_arguments} |
1113
|
|
|
|
|
|
|
and next; |
1114
|
|
|
|
|
|
|
push @in_violation, $declaration->{element}; |
1115
|
99
|
|
|
|
|
8991
|
} |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
return ( map { $self->violation( |
1119
|
|
|
|
|
|
|
sprintf( '%s is declared but not used', $_->symbol() ), |
1120
|
|
|
|
|
|
|
$EXPL, |
1121
|
60
|
|
|
60
|
|
128
|
$_ |
1122
|
|
|
|
|
|
|
) } sort { $a->logical_line_number() <=> $b->logical_line_number() || |
1123
|
60
|
|
|
|
|
114
|
$a->column_number() <=> $b->column_number() } |
1124
|
|
|
|
|
|
|
@in_violation ); |
1125
|
60
|
|
|
|
|
102
|
} |
|
60
|
|
|
|
|
233
|
|
1126
|
103
|
|
|
|
|
190
|
|
|
103
|
|
|
|
|
192
|
|
1127
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
1128
|
126
|
100
|
|
|
|
271
|
|
1129
|
|
|
|
|
|
|
# THIS CODE HAS ABSOLUTELY NO BUSINESS BEING HERE. It should probably be |
1130
|
125
|
100
|
|
|
|
263
|
# its own module; PPIx::Scope or something like that. The problem is |
1131
|
|
|
|
|
|
|
# that I no longer "own" it, and am having trouble getting modifications |
1132
|
63
|
100
|
|
|
|
135
|
# through. So I have stuck it here for the moment, but I hope it will |
1133
|
|
|
|
|
|
|
# not stay here. Other than here, it appears in Perl::Critic::Document |
1134
|
|
|
|
|
|
|
# (the copy I am trying to get modified) and Perl::ToPerl6::Document (a |
1135
|
62
|
100
|
100
|
|
|
140
|
# cut-and-paste of an early version.) |
1136
|
|
|
|
|
|
|
# |
1137
|
|
|
|
|
|
|
# THIS CODE IS PRIVATE TO THIS MODULE. The author reserves the right to |
1138
|
58
|
100
|
100
|
|
|
135
|
# change it or remove it without any notice whatsoever. YOU HAVE BEEN |
1139
|
|
|
|
|
|
|
# WARNED. |
1140
|
|
|
|
|
|
|
# |
1141
|
54
|
100
|
100
|
|
|
125
|
# This got hung on the Perl::Critic::Document, rather than living in |
1142
|
|
|
|
|
|
|
# Perl::Critic::Utils::PPI, because of the possibility that caching of scope |
1143
|
|
|
|
|
|
|
# objects would turn out to be desirable. |
1144
|
50
|
100
|
100
|
|
|
112
|
|
1145
|
44
|
|
|
|
|
88
|
# sub element_is_in_lexical_scope_after_statement_containing {...} |
1146
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
$inner_elem->top() == $outer_elem->top() |
1149
|
44
|
|
|
|
|
3592
|
or Perl::Critic::Exception::Fatal::PolicyDefinition->throw( |
1150
|
|
|
|
|
|
|
message => 'Elements must be in same document' ); |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
# If the outer element defines a scope, we're true if and only if |
1153
|
60
|
50
|
|
|
|
233
|
# the outer element contains the inner element, and the inner |
|
27
|
|
|
|
|
424
|
|
1154
|
|
|
|
|
|
|
# element is not somewhere that is hidden from the scope. |
1155
|
|
|
|
|
|
|
if ( $outer_elem->scope() ) { |
1156
|
|
|
|
|
|
|
return _inner_element_is_in_outer_scope_really( |
1157
|
|
|
|
|
|
|
$inner_elem, $outer_elem ); |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# In the more general case: |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
# The last element of the statement containing the outer element |
1163
|
|
|
|
|
|
|
# must be before the inner element. If not, we know we're false, |
1164
|
|
|
|
|
|
|
# without walking the parse tree. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
my $stmt = $outer_elem->statement() |
1167
|
|
|
|
|
|
|
or return; |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
my $last_elem = $stmt; |
1170
|
|
|
|
|
|
|
while ( $last_elem->isa( 'PPI::Node' ) ) { |
1171
|
|
|
|
|
|
|
$last_elem = $last_elem->last_element() |
1172
|
|
|
|
|
|
|
or return; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
my $stmt_loc = $last_elem->location() |
1176
|
|
|
|
|
|
|
or return; |
1177
|
|
|
|
|
|
|
|
1178
|
81
|
|
|
81
|
|
170
|
my $inner_loc = $inner_elem->location() |
1179
|
|
|
|
|
|
|
or return; |
1180
|
81
|
50
|
|
|
|
167
|
|
1181
|
|
|
|
|
|
|
$stmt_loc->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE] |
1182
|
|
|
|
|
|
|
and return; |
1183
|
|
|
|
|
|
|
$stmt_loc->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE] |
1184
|
|
|
|
|
|
|
and $stmt_loc->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER] |
1185
|
|
|
|
|
|
|
and return; |
1186
|
|
|
|
|
|
|
|
1187
|
81
|
100
|
|
|
|
1565
|
# Since we know the inner element is after the outer element, find |
1188
|
6
|
|
|
|
|
15
|
# the element that defines the scope of the statement that contains |
1189
|
|
|
|
|
|
|
# the outer element. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
my $parent = $stmt; |
1192
|
|
|
|
|
|
|
while ( ! $parent->scope() ) { |
1193
|
|
|
|
|
|
|
# Things appearing in the right-hand side of a |
1194
|
|
|
|
|
|
|
# PPI::Statement::Variable are not in-scope to its left-hand |
1195
|
|
|
|
|
|
|
# side. RESTRICTION -- this code does not handle truly |
1196
|
|
|
|
|
|
|
# pathological stuff like |
1197
|
|
|
|
|
|
|
# my ( $c, $d ) = qw{ e f }; |
1198
|
75
|
50
|
|
|
|
191
|
# my ( $a, $b ) = my ( $c, $d ) = ( $c, $d ); |
1199
|
|
|
|
|
|
|
_inner_is_defined_by_outer( $inner_elem, $parent ) |
1200
|
|
|
|
|
|
|
and _location_is_in_right_hand_side_of_assignment( |
1201
|
75
|
|
|
|
|
721
|
$parent, $inner_elem ) |
1202
|
75
|
|
|
|
|
209
|
and return; |
1203
|
77
|
50
|
|
|
|
228
|
$parent = $parent->parent() |
1204
|
|
|
|
|
|
|
or return; |
1205
|
|
|
|
|
|
|
} |
1206
|
|
|
|
|
|
|
|
1207
|
75
|
50
|
|
|
|
511
|
# We're true if and only if the scope of the outer element contains |
1208
|
|
|
|
|
|
|
# the inner element. |
1209
|
|
|
|
|
|
|
|
1210
|
75
|
50
|
|
|
|
828
|
return $inner_elem->descendant_of( $parent ); |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
} |
1213
|
75
|
50
|
|
|
|
863
|
|
1214
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
1215
|
75
|
100
|
100
|
|
|
222
|
# Return true if and only if $outer_elem is a statement that defines |
1216
|
|
|
|
|
|
|
# variables and $inner_elem is actually a variable defined in that |
1217
|
|
|
|
|
|
|
# statement. |
1218
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
1219
|
|
|
|
|
|
|
$outer_elem->isa( 'PPI::Statement::Variable' ) |
1220
|
|
|
|
|
|
|
and $inner_elem->isa( 'PPI::Token::Symbol' ) |
1221
|
|
|
|
|
|
|
or return; |
1222
|
|
|
|
|
|
|
my %defines = hashify( $outer_elem->variables() ); |
1223
|
70
|
|
|
|
|
126
|
return $defines{$inner_elem->symbol()}; |
1224
|
70
|
|
|
|
|
164
|
} |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
1227
|
|
|
|
|
|
|
# Given that the outer element defines a scope, there are still things |
1228
|
|
|
|
|
|
|
# that are lexically inside it but outside the scope. We return true if |
1229
|
|
|
|
|
|
|
# and only if the inner element is inside the outer element, but not |
1230
|
|
|
|
|
|
|
# inside one of the excluded elements. The cases handled so far: |
1231
|
75
|
50
|
66
|
|
|
223
|
# for ----- the list is not part of the scope |
1232
|
|
|
|
|
|
|
# foreach - the list is not part of the scope |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
my ( $inner_elem, $outer_elem ) = @_; |
1235
|
75
|
50
|
|
|
|
586
|
$outer_elem->scope() |
1236
|
|
|
|
|
|
|
or return; |
1237
|
|
|
|
|
|
|
$inner_elem->descendant_of( $outer_elem ) |
1238
|
|
|
|
|
|
|
or return; |
1239
|
|
|
|
|
|
|
if ( $outer_elem->isa( 'PPI::Statement::Compound' ) ) { |
1240
|
|
|
|
|
|
|
my $first = $outer_elem->schild( 0 ) |
1241
|
|
|
|
|
|
|
or return; |
1242
|
70
|
|
|
|
|
535
|
if ( { for => 1, foreach => 1 }->{ $first->content() } ) { |
1243
|
|
|
|
|
|
|
my $next = $first; |
1244
|
|
|
|
|
|
|
while ( $next = $next->snext_sibling() ) { |
1245
|
|
|
|
|
|
|
$next->isa( 'PPI::Structure::List' ) |
1246
|
|
|
|
|
|
|
or next; |
1247
|
|
|
|
|
|
|
return ! $inner_elem->descendant_of( $next ); |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
} |
1251
|
75
|
|
|
75
|
|
154
|
return $TRUE; |
1252
|
75
|
100
|
100
|
|
|
424
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
# Helper for element_is_in_lexical_scope_after_statement_containing(). |
1255
|
36
|
|
|
|
|
115
|
# Given and element that represents an assignment or assignment-ish |
1256
|
36
|
|
|
|
|
2172
|
# statement, and a location, return true if the location is to the right |
1257
|
|
|
|
|
|
|
# of the equals sign, and false otherwise (including the case where |
1258
|
|
|
|
|
|
|
# there is no equals sign). Only the leftmost equals is considered. This |
1259
|
|
|
|
|
|
|
# is a restriction. |
1260
|
|
|
|
|
|
|
my ( $elem, $inner_elem ) = @_; |
1261
|
|
|
|
|
|
|
my $inner_loc = $inner_elem->location(); |
1262
|
|
|
|
|
|
|
my $kid = $elem->schild( 0 ); |
1263
|
|
|
|
|
|
|
while ( $kid ) { |
1264
|
|
|
|
|
|
|
$kid->isa( 'PPI::Token::Operator' ) |
1265
|
|
|
|
|
|
|
and q{=} eq $kid->content() |
1266
|
|
|
|
|
|
|
or next; |
1267
|
|
|
|
|
|
|
my $l = $kid->location(); |
1268
|
6
|
|
|
6
|
|
14
|
$l->[LOCATION_LINE] > $inner_loc->[LOCATION_LINE] |
1269
|
6
|
50
|
|
|
|
16
|
and return; |
1270
|
|
|
|
|
|
|
$l->[LOCATION_LINE] == $inner_loc->[LOCATION_LINE] |
1271
|
6
|
50
|
|
|
|
20
|
and $l->[LOCATION_CHARACTER] >= $inner_loc->[LOCATION_CHARACTER] |
1272
|
|
|
|
|
|
|
and return; |
1273
|
6
|
50
|
|
|
|
94
|
return $inner_elem->descendant_of( $elem ); |
1274
|
6
|
50
|
|
|
|
14
|
} continue { |
1275
|
|
|
|
|
|
|
$kid = $kid->snext_sibling(); |
1276
|
6
|
50
|
|
|
|
81
|
} |
1277
|
6
|
|
|
|
|
24
|
return; |
1278
|
6
|
|
|
|
|
54
|
} |
1279
|
18
|
100
|
|
|
|
367
|
|
1280
|
|
|
|
|
|
|
# END OF CODE THAT ABSOLUTELY SHOULD NOT BE HERE |
1281
|
6
|
|
|
|
|
41
|
|
1282
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
# Cribbed shamelessly from PPIx::Regexp::Token::Code->ppi(). |
1285
|
0
|
|
|
|
|
0
|
# FIXME duplicate code should be consolidated somewhere, but I don't |
1286
|
|
|
|
|
|
|
# know where. Maybe in the above scope code, since that's what I'm |
1287
|
|
|
|
|
|
|
# trying to solve. |
1288
|
|
|
|
|
|
|
my ( $self, $elem, $content ) = @_; |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
exists $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) } |
1291
|
|
|
|
|
|
|
and return $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) }; |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
defined $content |
1294
|
|
|
|
|
|
|
or $content = $self->content(); |
1295
|
36
|
|
|
36
|
|
1392
|
|
1296
|
36
|
|
|
|
|
86
|
my $doc_content; |
1297
|
36
|
|
|
|
|
379
|
|
1298
|
36
|
|
|
|
|
411
|
my $location = $elem->location(); |
1299
|
111
|
100
|
100
|
|
|
1562
|
if ( $location ) { |
1300
|
|
|
|
|
|
|
my $fn; |
1301
|
|
|
|
|
|
|
if( defined( $fn = $location->[LOCATION_LOGICAL_FILE] ) ) { |
1302
|
27
|
|
|
|
|
145
|
$fn =~ s/ (?= [\\"] ) /\\/smxg; |
1303
|
27
|
50
|
|
|
|
274
|
$doc_content = qq{#line $location->[LOCATION_LOGICAL_LINE] "$fn"\n}; |
1304
|
|
|
|
|
|
|
} else { |
1305
|
27
|
50
|
66
|
|
|
77
|
$doc_content = qq{#line $location->[LOCATION_LOGICAL_LINE]\n}; |
1306
|
|
|
|
|
|
|
} |
1307
|
|
|
|
|
|
|
$doc_content .= q< > x ( $location->[LOCATION_COLUMN] - 1 ); |
1308
|
27
|
|
|
|
|
78
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
84
|
|
|
|
|
216
|
$doc_content .= $content; |
1311
|
|
|
|
|
|
|
|
1312
|
9
|
|
|
|
|
177
|
my $doc = PPI::Document->new( \$doc_content ); |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
if ( $location ) { |
1315
|
|
|
|
|
|
|
# Generate locations now. |
1316
|
|
|
|
|
|
|
$doc->location(); |
1317
|
|
|
|
|
|
|
# Remove the stuff we originally injected. NOTE that we can |
1318
|
|
|
|
|
|
|
# only get away with doing this if the removal does not |
1319
|
|
|
|
|
|
|
# invalidate the locations of the other tokens that we just |
1320
|
|
|
|
|
|
|
# generated. |
1321
|
|
|
|
|
|
|
my $annotation; |
1322
|
|
|
|
|
|
|
# Remove the '#line' directive if we find it |
1323
|
|
|
|
|
|
|
$annotation = $doc->child( 0 ) |
1324
|
3
|
|
|
3
|
|
8
|
and $annotation->isa( 'PPI::Token::Comment' ) |
1325
|
|
|
|
|
|
|
and $annotation->content() =~ m/ \A \#line\b /smx |
1326
|
|
|
|
|
|
|
and $annotation->remove(); |
1327
|
3
|
50
|
|
|
|
15
|
# Remove the white space if we find it, and if it in fact |
1328
|
|
|
|
|
|
|
# represents only the white space we injected to get the |
1329
|
3
|
50
|
|
|
|
8
|
# column numbers right. |
1330
|
|
|
|
|
|
|
my $wid = $location->[LOCATION_COLUMN] - 1; |
1331
|
|
|
|
|
|
|
$wid |
1332
|
3
|
|
|
|
|
6
|
and $annotation = $doc->child( 0 ) |
1333
|
|
|
|
|
|
|
and $annotation->isa( 'PPI::Token::Whitespace' ) |
1334
|
3
|
|
|
|
|
13
|
and $wid == length $annotation->content() |
1335
|
3
|
50
|
|
|
|
37
|
and $annotation->remove(); |
1336
|
3
|
|
|
|
|
5
|
} |
1337
|
3
|
50
|
|
|
|
10
|
|
1338
|
0
|
|
|
|
|
0
|
$self->{$PACKAGE}{parent_element}{ refaddr( $doc ) } = $elem; |
1339
|
0
|
|
|
|
|
0
|
return ( $self->{$PACKAGE}{sub_document}{ refaddr( $elem ) } = $doc ); |
1340
|
|
|
|
|
|
|
} |
1341
|
3
|
|
|
|
|
9
|
|
1342
|
|
|
|
|
|
|
1; |
1343
|
3
|
|
|
|
|
7
|
|
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
1346
|
3
|
|
|
|
|
7
|
|
1347
|
|
|
|
|
|
|
=pod |
1348
|
3
|
|
|
|
|
11
|
|
1349
|
|
|
|
|
|
|
=for stopwords pre |
1350
|
3
|
50
|
|
|
|
3453
|
|
1351
|
|
|
|
|
|
|
=head1 NAME |
1352
|
3
|
|
|
|
|
11
|
|
1353
|
|
|
|
|
|
|
Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter - Don't ask for storage you don't need. |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
=head1 AFFILIATION |
1356
|
|
|
|
|
|
|
|
1357
|
3
|
|
|
|
|
778
|
This Policy is stand-alone, and is not part of the core |
1358
|
|
|
|
|
|
|
L<Perl::Critic|Perl::Critic>. |
1359
|
3
|
50
|
33
|
|
|
10
|
|
|
|
|
33
|
|
|
|
|
1360
|
|
|
|
|
|
|
=head1 NOTE |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
As of version 0.099_001, the logic that recognizes variables |
1363
|
|
|
|
|
|
|
interpolated into double-quotish strings has been refactored into module |
1364
|
|
|
|
|
|
|
L<PPIx::QuoteLike|PPIx::QuoteLike>. |
1365
|
|
|
|
|
|
|
|
1366
|
3
|
|
|
|
|
141
|
=head1 DESCRIPTION |
1367
|
3
|
50
|
33
|
|
|
10
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1368
|
|
|
|
|
|
|
Unused variables clutter code and require the reader to do mental |
1369
|
|
|
|
|
|
|
bookkeeping to figure out if the variable is actually used or not. |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Right now, this only looks for lexical variables which are unused other |
1372
|
|
|
|
|
|
|
than in the statement that declares them. |
1373
|
|
|
|
|
|
|
|
1374
|
3
|
|
|
|
|
122
|
my $x; # not ok, assuming no other appearances. |
1375
|
3
|
|
|
|
|
32
|
my @y = (); # not ok, assuming no other appearances. |
1376
|
|
|
|
|
|
|
our $z; # ok, global. |
1377
|
|
|
|
|
|
|
local $w; # ok, global. |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
This policy is a variant on the core policy |
1380
|
|
|
|
|
|
|
L<Perl::Critic::Policy::Variables::ProhibitUnusedVariables|Perl::Critic::Policy::Variables::ProhibitUnusedVariables> |
1381
|
|
|
|
|
|
|
which attempts to be more strict in its checking of whether a variable |
1382
|
|
|
|
|
|
|
is used. The specific differences are: |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
* An attempt is made to take into account the scope of the declaration. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
* An attempt is made to find variables which are interpolated into |
1387
|
|
|
|
|
|
|
double-quotish strings (including regexes) and here documents. |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
* An attempt is made to find variables which are used in regular |
1390
|
|
|
|
|
|
|
expression C<(?{...})> and C<(??{...})> constructions, and in the |
1391
|
|
|
|
|
|
|
replacement portion of C<s/.../.../e>. |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
* An attempt is made to find variables which are used in subroutine |
1394
|
|
|
|
|
|
|
signatures. |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
This policy intentionally does not report variables as unused if the |
1397
|
|
|
|
|
|
|
code takes a reference to the variable, even if it is otherwise unused. |
1398
|
|
|
|
|
|
|
For example things like |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
\( my $foo = 'bar' ) |
1401
|
|
|
|
|
|
|
\do{ my $foo => 'bar' } |
1402
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
will not be reported as a violation even if C<$foo> is otherwise unused. |
1404
|
|
|
|
|
|
|
The reason is that this is an idiom for making a reference to a mutable |
1405
|
|
|
|
|
|
|
string when all you have is an immutable string. This policy does not |
1406
|
|
|
|
|
|
|
check to see if anything is done with the reference. |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
This policy also does not detect unused variables declared inside |
1409
|
|
|
|
|
|
|
various odd corners such as |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
s///e |
1412
|
|
|
|
|
|
|
qr{(?{...})} |
1413
|
|
|
|
|
|
|
qr{(??{...})} |
1414
|
|
|
|
|
|
|
"@{[ ... ]}" |
1415
|
|
|
|
|
|
|
( $foo, my $bar ) = ( 1, 2 ) |
1416
|
|
|
|
|
|
|
sub ( $foo = $bar ) { ... } # Signature, not prototype |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
Most of these are because the PPI parse of the original document does |
1419
|
|
|
|
|
|
|
not include the declarations. The list assignment is missed because PPI |
1420
|
|
|
|
|
|
|
does not parse it as containing a |
1421
|
|
|
|
|
|
|
L<PPI::Statement::Variable|PPI::Statement::Variable>. However, variables |
1422
|
|
|
|
|
|
|
B<used> inside such constructions B<will> be detected. |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
=head1 CONFIGURATION |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
This policy supports the following configuration items: |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=head2 allow_unused_subroutine_arguments |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
By default, this policy prohibits unused subroutine arguments -- that |
1431
|
|
|
|
|
|
|
is, unused variables on the right-hand side of such simple assignments |
1432
|
|
|
|
|
|
|
as |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
my ( $foo ) = @_; |
1435
|
|
|
|
|
|
|
my $bar = shift; |
1436
|
|
|
|
|
|
|
my $baz = shift @_; |
1437
|
|
|
|
|
|
|
my $burfle = $_[0]; |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
If you wish to allow unused variables in this case, you can add a block |
1440
|
|
|
|
|
|
|
like this to your F<.perlcriticrc> file: |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1443
|
|
|
|
|
|
|
allow_unused_subroutine_arguments = 1 |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
=head2 prohibit_reference_only_variables |
1446
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
By default, this policy allows otherwise-unused variables if the code |
1448
|
|
|
|
|
|
|
takes a reference to the variable when it is created. If you wish to |
1449
|
|
|
|
|
|
|
declare a violation in this case, you can add a block like this to your |
1450
|
|
|
|
|
|
|
F<.perlcriticrc> file: |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1453
|
|
|
|
|
|
|
prohibit_reference_only_variables = 1 |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=head2 prohibit_returned_lexicals |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
By default, this policy allows otherwise-unused lexical variables |
1458
|
|
|
|
|
|
|
(either C<'my'> or C<'state'>) if they are being returned from a |
1459
|
|
|
|
|
|
|
subroutine, under the presumption that they are going to be used as |
1460
|
|
|
|
|
|
|
lvalues by the caller. If you wish to declare a violation in this case, |
1461
|
|
|
|
|
|
|
you can add a block like this to your F<.perlcriticrc> file: |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1464
|
|
|
|
|
|
|
prohibit_returned_lexicals = 1 |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
B<Note> that only explicit C<'return'> statements are covered by this |
1467
|
|
|
|
|
|
|
setting. No attempt is made to detect and allow implicit returns. |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=head2 allow_if_computed_by |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
You may wish to allow variables to be unused when computed in certain |
1472
|
|
|
|
|
|
|
ways. For example, you might want to allow place-holder variables in a |
1473
|
|
|
|
|
|
|
list computed by C<stat()> or C<unpack()>. Or you may be doing |
1474
|
|
|
|
|
|
|
end-of-scope detection with something like |
1475
|
|
|
|
|
|
|
C<< my $foo = Scope::Guard->new( \&end_of_scope ) >>. To ignore all |
1476
|
|
|
|
|
|
|
these, you can add a block like this to your F<.perlcriticrc> file: |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1479
|
|
|
|
|
|
|
allow_if_computed_by = stat unpack Scope::Guard |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
This property takes as its value a whitespace-delimited list of class or |
1482
|
|
|
|
|
|
|
subroutine names. Nothing complex is done to implement this -- the |
1483
|
|
|
|
|
|
|
policy simply looks at the first word after the equals sign, if any. |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
=head2 allow_state_in_expression |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
By default, this policy handles C<state> variables as any other lexical, |
1488
|
|
|
|
|
|
|
and a violation is declared if they appear only in the statement that |
1489
|
|
|
|
|
|
|
declares them. |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
One might, however, do something like |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
state $foo = compute_foo() or do_something_else(); |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
In this case, C<compute_foo()> is called only once, but if it returns a |
1496
|
|
|
|
|
|
|
false value C<do_something_else()> will be executed every time this |
1497
|
|
|
|
|
|
|
statement is encountered. |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
If you wish to allow such code, you can add a block like this to your |
1500
|
|
|
|
|
|
|
F<.perlcriticrc> file: |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1503
|
|
|
|
|
|
|
allow_state_in_expression = 1 |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
This allows an otherwise-unused state variable if its value appears to |
1506
|
|
|
|
|
|
|
be used in an expression -- that is, if its declaration is followed by a |
1507
|
|
|
|
|
|
|
low-precedence boolean, or one of its ancestors is preceded or followed |
1508
|
|
|
|
|
|
|
by any operator. The latter means that something like |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
my $bar = ( state $foo = compute_foo() ) + 42; |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
will be accepted. |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
This will also cause post-increment and post-decrement to be accepted, |
1515
|
|
|
|
|
|
|
allowing code like |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
do_something() unless state $foo++; |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
Pre-increment and pre-decrement are ignored, since as of Perl 5.34.0 |
1520
|
|
|
|
|
|
|
they are syntax errors. |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head2 check_catch |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
Under ordinary circumstances the C<$err> variable in |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
try { |
1527
|
|
|
|
|
|
|
... |
1528
|
|
|
|
|
|
|
} catch ( $err ) { |
1529
|
|
|
|
|
|
|
... |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
will be invisible to this policy because, although it is in fact the |
1533
|
|
|
|
|
|
|
declaration of a lexical variable, the absence of a C<my> means it does |
1534
|
|
|
|
|
|
|
not look like one to L<PPI|PPI>. If you want to test these, you can add |
1535
|
|
|
|
|
|
|
a block like this to your F<.perlcriticrc> file: |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
[Variables::ProhibitUnusedVarsStricter] |
1538
|
|
|
|
|
|
|
check_catch = 1 |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
This option is not on by default because there appears to be no way to |
1541
|
|
|
|
|
|
|
define a C<catch()> block without a variable, whether or not you intend |
1542
|
|
|
|
|
|
|
to use it. |
1543
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
B<Caveat:> if L<PPI|PPI> ever starts recognizing C<catch( $foo )> as |
1545
|
|
|
|
|
|
|
containing a L<PPI::Statement::Variable|PPI::Statement::Variable>, this |
1546
|
|
|
|
|
|
|
configuration variable will become moot, as the extra logic will no |
1547
|
|
|
|
|
|
|
longer be needed. As soon as I recognize this has happened (and there |
1548
|
|
|
|
|
|
|
B<is> an author test for it) I will document this configuration item as |
1549
|
|
|
|
|
|
|
a no-op, deprecate it, and probably eventually retract it. |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
=head1 AVOIDING UNUSED VARIABLES |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
There are situations in Perl where eliminating unused variables is |
1554
|
|
|
|
|
|
|
less straightforward than simply deleting them: |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
=head2 List Assignments |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
This situation typically (I believe) comes up when your code gets handed |
1559
|
|
|
|
|
|
|
a list, and is not interested in all values in the list. You could, of |
1560
|
|
|
|
|
|
|
course, assign the whole thing to an array and then cherry-pick the |
1561
|
|
|
|
|
|
|
array, but there are less-obvious solutions that avoid the extra |
1562
|
|
|
|
|
|
|
assignment. |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
For the purpose of this discussion, I will assume code which calls the |
1565
|
|
|
|
|
|
|
C<localtime()> built-in, but is only interested in day, month, and year. |
1566
|
|
|
|
|
|
|
The cut-and-paste implementation (direct from C<perldoc -f localtime>, |
1567
|
|
|
|
|
|
|
or L<https://perldoc.pl/functions/localtime> if you prefer) is: |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
# 0 1 2 3 4 5 6 7 8 |
1570
|
|
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
1571
|
|
|
|
|
|
|
localtime(); |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
Now, you can trivially eliminate the variables after C<$year>, but that |
1574
|
|
|
|
|
|
|
still leaves |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
# 0 1 2 3 4 5 |
1577
|
|
|
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
with C<$sec>, C<$min>, and C<$hour> assigned-to but unused. There are |
1580
|
|
|
|
|
|
|
two ways I know of to eliminate these: |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
=head3 Assign to C<undef> |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
On the left-hand side of a list assignment, C<undef> causes the |
1585
|
|
|
|
|
|
|
corresponding right-hand value to be ignored. This makes our example |
1586
|
|
|
|
|
|
|
look like |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
# 0 1 2 3 4 5 |
1589
|
|
|
|
|
|
|
my (undef,undef,undef,$mday,$mon,$year) = localtime(); |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
=head2 Slice the Right-Hand Side |
1592
|
|
|
|
|
|
|
|
1593
|
|
|
|
|
|
|
The unwanted values can also be eliminated by slicing the right-hand |
1594
|
|
|
|
|
|
|
side of the assignment. This looks like |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
# 3 4 5 |
1597
|
|
|
|
|
|
|
my ($mday,$mon,$year) = ( localtime() )[ 3 .. 5 ]; |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
or, if you prefer, |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
# 3 4 5 |
1602
|
|
|
|
|
|
|
my ($mday,$mon,$year) = ( localtime() )[ 3, 4, 5 ]; |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=head1 SUPPORT |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
Support is by the author. Please file bug reports at |
1607
|
|
|
|
|
|
|
L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter>, |
1608
|
|
|
|
|
|
|
L<https://github.com/trwyant/perl-Perl-Critic-Policy-Variables-ProhibitUnusedVarsStricter/issues>, or in |
1609
|
|
|
|
|
|
|
electronic mail to the author. |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
=head1 AUTHOR |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
Thomas R. Wyant, III F<wyant at cpan dot org> |
1614
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
Copyright (C) 2012-2022 Thomas R. Wyant, III |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
=head1 LICENSE |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1622
|
|
|
|
|
|
|
under the same terms as Perl 5.10.0. For more details, see the full text |
1623
|
|
|
|
|
|
|
of the licenses in the directory LICENSES. |
1624
|
|
|
|
|
|
|
|
1625
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but |
1626
|
|
|
|
|
|
|
without any warranty; without even the implied warranty of |
1627
|
|
|
|
|
|
|
merchantability or fitness for a particular purpose. |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
=cut |
1630
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
# Local Variables: |
1632
|
|
|
|
|
|
|
# mode: cperl |
1633
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
1634
|
|
|
|
|
|
|
# fill-column: 72 |
1635
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
1636
|
|
|
|
|
|
|
# c-indentation-style: bsd |
1637
|
|
|
|
|
|
|
# End: |
1638
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=72 ft=perl expandtab shiftround : |