← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:11 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ValuesAndExpressions/RequireConstantVersion.pm
StatementsExecuted 30 statements in 1.19ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11116µs33µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@25Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@25
11116µs16µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@10Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@10
11116µs18µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::supported_parametersPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::supported_parameters
1118µs37µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@20Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@20
1118µs44µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@14Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@14
1118µs384µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@15Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@15
1118µs678µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@16Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@16
1117µs76µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@27Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@27
1117µs10µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@12Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@12
1117µs18µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::BEGIN@11Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@11
1116µs7µsPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::default_severityPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::default_severity
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_check_for_assignment_operatorPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_check_for_assignment_operator
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_validate_operator_bind_regexPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_validate_operator_bind_regex
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_validate_word_qvPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_validate_word_qv
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_validate_word_tokenPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_validate_word_token
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_validate_word_versionPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_validate_word_version
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::_validate_word_vstringPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::_validate_word_vstring
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::applies_toPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::applies_to
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::default_themesPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::default_themes
0000s0sPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::::violatesPerl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::violates
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion;
9
10238µs116µs
# spent 16µs within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@10 which was called: # once (16µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
# spent 16µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@10
11219µs228µs
# spent 18µs (7+11) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@11 which was called: # once (7µs+11µs) by Module::Pluggable::Object::_require at line 11
use strict;
# spent 18µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@11 # spent 11µs making 1 call to strict::import
12222µs214µs
# spent 10µs (7+3) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@12 which was called: # once (7µs+3µs) by Module::Pluggable::Object::_require at line 12
use warnings;
# spent 10µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@12 # spent 4µs making 1 call to warnings::import
13
14222µs281µs
# spent 44µs (8+36) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@14 which was called: # once (8µs+36µs) by Module::Pluggable::Object::_require at line 14
use Carp;
# spent 44µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@14 # spent 36µs making 1 call to Exporter::import
15227µs2760µs
# spent 384µs (8+376) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@15 which was called: # once (8µs+376µs) by Module::Pluggable::Object::_require at line 15
use English qw(-no_match_vars);
# spent 384µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@15 # spent 376µs making 1 call to English::import
161300ns
# spent 678µs (8+670) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@16 which was called: # once (8µs+670µs) by Module::Pluggable::Object::_require at line 19
use Perl::Critic::Utils qw<
17 :booleans :characters :classification :data_conversion :language
18 :severities
19127µs21.35ms>;
# spent 678µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@16 # spent 670µs making 1 call to Exporter::import
201400ns
# spent 37µs (8+29) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@20 which was called: # once (8µs+29µs) by Module::Pluggable::Object::_require at line 24
use Perl::Critic::Utils::PPI qw{
21 is_ppi_constant_element
22 get_next_element_in_same_simple_statement
23 get_previous_module_used_on_same_line
24120µs267µs};
# spent 37µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@20 # spent 29µs making 1 call to Exporter::import
25222µs250µs
# spent 33µs (16+17) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@25 which was called: # once (16µs+17µs) by Module::Pluggable::Object::_require at line 25
use Readonly;
# spent 33µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@25 # spent 17µs making 1 call to Exporter::import
26
272952µs2145µs
# spent 76µs (7+69) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@27 which was called: # once (7µs+69µs) by Module::Pluggable::Object::_require at line 27
use base 'Perl::Critic::Policy';
# spent 76µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::BEGIN@27 # spent 69µs making 1 call to base::import
28
291600nsour $VERSION = '1.121';
30
31#-----------------------------------------------------------------------------
32
3312µs130µsReadonly::Scalar my $BIND_REGEX => q<=~>;
# spent 30µs making 1 call to Readonly::Scalar
341900ns122µsReadonly::Scalar my $DOLLAR => q<$>;
# spent 22µs making 1 call to Readonly::Scalar
35# All uses of the $DOLLAR variable below are to prevent false failures in
36# xt/author/93_version.t.
371800ns120µsReadonly::Scalar my $QV => q<qv>;
# spent 20µs making 1 call to Readonly::Scalar
381800ns120µsReadonly::Scalar my $VERSION_MODULE => q<version>;
# spent 20µs making 1 call to Readonly::Scalar
3914µs222µsReadonly::Scalar my $VERSION_VARIABLE => $DOLLAR . q<VERSION>;
# spent 20µs making 1 call to Readonly::Scalar # spent 1µs making 1 call to Readonly::Scalar::FETCH
40
41# Operators which would make a new value our of our $VERSION, and therefore
42# not modify it. I'm sure this list is not exhaustive. The logical operators
43# generally do not qualify for this list. At least, I think not.
4415µs252µsReadonly::Hash my %OPERATOR_WHICH_MAKES_NEW_VALUE => hashify( qw{
# spent 44µs making 1 call to Readonly::Hash # spent 7µs making 1 call to Perl::Critic::Utils::hashify
45 = . + - * ** / % ^ ~ & | > < == != >= <= eq ne gt lt ge le
46 } );
47
4814µs222µsReadonly::Scalar my $DESC => $DOLLAR . q<VERSION value must be a constant>;
# spent 21µs making 1 call to Readonly::Scalar # spent 1µs making 1 call to Readonly::Scalar::FETCH
4913µs221µsReadonly::Scalar my $EXPL => qq<Computed ${DOLLAR}VERSION may tie the code to a single repository, or cause spooky action from a distance>;
# spent 20µs making 1 call to Readonly::Scalar # spent 1µs making 1 call to Readonly::Scalar::FETCH
50
51#-----------------------------------------------------------------------------
52
53
# spent 18µs (16+3) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::supported_parameters which was called: # once (16µs+3µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters { return (
54 {
55112µs23µs name => 'allow_version_without_use_on_same_line',
# spent 3µs making 2 calls to Readonly::Scalar::FETCH, avg 1µs/call
56 description =>
57 q{Allow qv() and version->new() without a 'use version' on the same line.},
58 default_string => $FALSE,
59 behavior => 'boolean',
60 }
61 );
62}
6311µs
# spent 7µs (6+1) within Perl::Critic::Policy::ValuesAndExpressions::RequireConstantVersion::default_severity which was called: # once (6µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_LOW }
64sub default_themes { return qw( core maintenance ) }
65sub applies_to { return 'PPI::Token::Symbol' }
66
67#-----------------------------------------------------------------------------
68
69sub violates {
70 my ( $self, $elem, $doc ) = @_;
71
72 # Any variable other than $VERSION is ignored.
73 return if $VERSION_VARIABLE ne $elem->content();
74
75 # Get the next thing (presumably an operator) after $VERSION. The $VERSION
76 # might be in a list, so if we get nothing we move upwards until we hit a
77 # simple statement. If we have nothing at this point, we do not understand
78 # the code, and so we return.
79 my $operator;
80 return if
81 not $operator = get_next_element_in_same_simple_statement( $elem );
82
83 # If the next operator is a regex binding, and its other operand is a
84 # substitution operator, it is an attempt to modify $VERSION, so we
85 # return an error to that effect.
86 return $self->violation( $DESC, $EXPL, $elem )
87 if $self->_validate_operator_bind_regex( $operator, $elem );
88
89 # If the presumptive operator is not an assignment operator of some sort,
90 # we are not modifying $VERSION at all, and so we just return.
91 return if not $operator = _check_for_assignment_operator( $operator );
92
93 # If there is no operand to the right of the assignment, we do not
94 # understand the code; simply return.
95 my $value;
96 return if not $value = $operator->snext_sibling();
97
98 # If the value is symbol '$VERSION', just return as we will see it again
99 # later.
100 return if
101 $value->isa( 'PPI::Token::Symbol' )
102 and $value->content() eq $VERSION_VARIABLE;
103
104 # If the value is a word, there are a number of acceptable things it could
105 # be. Check for these. If there was a problem, return it.
106 $value = $self->_validate_word_token( $elem, $value );
107 return $value if $value->isa( 'Perl::Critic::Exception' );
108
109 # If the value is anything but a constant, we cry foul.
110 return $self->violation( $DESC, $EXPL, $elem )
111 if not is_ppi_constant_element( $value );
112
113 # If we have nothing after the value, it is OK.
114 my $structure;
115 return if
116 not $structure = get_next_element_in_same_simple_statement( $value );
117
118 # If we have a semicolon after the value, it is OK.
119 return if $SCOLON eq $structure->content();
120
121 # If there is anything else after the value, we cry foul.
122 return $self->violation( $DESC, $EXPL, $elem );
123}
124
125#-----------------------------------------------------------------------------
126
127# Check for an assignment operator. This is made more complicated by the fact
128# that PPI parses things like '||=' as two PPI::Token::Operators: '||' and
129# '='. So we take the first presumptive operator as an argument. If it is not
130# a PPI::Token::Operator, we return. If it's '=', we return it. If it is any
131# other operator, we see if the next significant token is '=', and if so
132# return that.
133
134sub _check_for_assignment_operator {
135 my ( $operator ) = @_;
136
137 return if not $operator->isa( 'PPI::Token::Operator' );
138 return $operator if $EQUAL eq $operator->content();
139
140 my $next;
141 return if not $next = $operator->snext_sibling();
142 return if not $next->isa( 'PPI::Token::Operator' );
143 return $next if $EQUAL eq $next->content();
144
145 return;
146}
147
148#-----------------------------------------------------------------------------
149
150# Validate a bind_regex ('=~') operator appearing after $VERSION. We return
151# true if the operator is in fact '=~', and its next sibling isa
152# PPI::Token::Regexp::Substitute. Otherwise we return false.
153
154sub _validate_operator_bind_regex {
155 my ( $self, $operator, $elem ) = @_;
156
157 # We are not interested in anything but '=~ s/../../'.
158 return if $BIND_REGEX ne $operator->content();
159 my $operand;
160 return if not $operand = $operator->snext_sibling();
161 return if not $operand->isa( 'PPI::Token::Regexp::Substitute' );
162
163 # The substitution is OK if it is of the form
164 # '($var = $VERSION) =~ s/../../'.
165
166 # We can't look like the desired form if we have a next sig. sib.
167 return $TRUE if $elem->snext_sibling();
168
169 # We can't look like the desired form if we are not in a list.
170 my $containing_list;
171 $containing_list = $elem->parent()
172 and $containing_list->isa( 'PPI::Statement' )
173 and $containing_list = $containing_list->parent()
174 and $containing_list->isa( 'PPI::Structure::List' )
175 or return $TRUE;
176
177 # If we have no prior element, we're ( $VERSION ) =~ s/../../,
178 # which flunks.
179 my $prior = $elem->sprevious_sibling() or return $TRUE;
180
181 # If the prior element is an operator which makes a new value, we pass.
182 return if $prior->isa( 'PPI::Token::Operator' )
183 && $OPERATOR_WHICH_MAKES_NEW_VALUE{ $prior->content() };
184
185 # Now things get complicated, as RT #55600 shows. We need to grub through
186 # the entire list, looking for something that looks like a subroutine
187 # call, but without parens around the argument list. This catches the
188 # ticket's case, which was
189 # ( $foo = sprintf '%s/%s', __PACKAGE__, $VERSION ) =~ s/../../.
190 my $current = $prior;
191 while( $prior = $current->sprevious_sibling() ) {
192 $prior->isa( 'PPI::Token::Word' ) or next;
193 is_function_call( $prior) or next;
194 # If this function has its own argument list, we need to keep looking;
195 # otherwise we have found a function with no parens, and we can
196 # return.
197 $current->isa( 'PPI::Structure::List' )
198 or return;
199 } continue {
200 $current = $prior;
201 }
202
203 # Maybe the whole list was arguments for a subroutine or method call.
204 $prior = $containing_list->sprevious_sibling()
205 or return $TRUE;
206 if ( $prior->isa( 'PPI::Token::Word' ) ) {
207 return if is_method_call( $prior );
208 return if is_function_call( $prior );
209 }
210
211 # Anything left is presumed a violation.
212 return $TRUE;
213}
214
215#-----------------------------------------------------------------------------
216
217# Validating a PPI::Token::Word is a complicated business, so we split it out
218# into its own subroutine. The $elem is to be used in forming the error
219# message, and the $value is the PPI::Token::Word we just encountered. The
220# return is either a PPI::Element for further analysis, or a
221# Perl::Critic::Exception to be returned.
222
223sub _validate_word_token {
224 my ( $self, $elem, $value ) = @_;
225
226 if ( $value->isa( 'PPI::Token::Word' ) ) {
227 my $content = $value->content();
228
229 # If the word is of the form 'v\d+' it may be the first portion of a
230 # misparsed (by PPI) v-string. It is really a v-string if the next
231 # element is a number. Unless v-strings are allowed, we return an
232 # error.
233 if ( $content =~ m/ \A v \d+ \z /smx ) {
234 $value = $self->_validate_word_vstring( $elem, $value );
235 }
236 elsif ( $QV eq $content ) {
237 # If the word is 'qv' we suspect use of the version module. If
238 # 'use version' appears on the same line, _and_ the remainder of
239 # the expression is of the form '(value)', we extract the value
240 # for further analysis.
241
242 $value = $self->_validate_word_qv( $elem, $value );
243 }
244 elsif ( $VERSION_MODULE eq $content ) {
245 # If the word is 'version' we suspect use of the version module.
246 # Check to see if it is properly used.
247 $value = $self->_validate_word_version( $elem, $value );
248 }
249 }
250
251 return $value;
252}
253
254#-----------------------------------------------------------------------------
255
256# Validate $VERSION = v1.2.3;
257# Note that this is needed because PPI mis-parses the 'v1.2.3' construct into
258# a word ('v1') and a number of some sort ('.2.3'). This method should only be
259# called if it is already known that the $value is a PPI::Token::Word matching
260# m/ \A v \d+ \z /smx;
261
262sub _validate_word_vstring {
263 my ( $self, $elem, $value ) = @_;
264
265 # Check for the second part of the mis-parsed v-string, flunking if it is
266 # not found.
267 my $next;
268 return $self->violation( $DESC, $EXPL, $elem )
269 if
270 not $next = $value->snext_sibling()
271 or not $next->isa( 'PPI::Token::Number' );
272
273 # Return the second part of the v-string for further analysis.
274 return $next;
275}
276
277#-----------------------------------------------------------------------------
278
279# Validate $VERSION = qv();
280
281sub _validate_word_qv {
282 my ( $self, $elem, $value ) = @_;
283
284 # Unless we are specifically allowing this construction without the
285 # 'use version;' on the same line, check for it and flunk if we do not
286 # find it.
287 $self->{_allow_version_without_use_on_same_line}
288 or do {
289 my $module;
290 return $self->violation( $DESC, $EXPL, $elem )
291 if not
292 $module = get_previous_module_used_on_same_line($value);
293 return $self->violation( $DESC, $EXPL, $elem )
294 if $VERSION_MODULE ne $module->content();
295 };
296
297 # Dig out the first argument of 'qv()', flunking if we can not find it.
298 my $next;
299 return $self->violation( $DESC, $EXPL, $elem )
300 if not (
301 $next = $value->snext_sibling()
302 and $next->isa( 'PPI::Structure::List' )
303 and $next = $next->schild( 0 )
304 and $next->isa( 'PPI::Statement::Expression' )
305 and $next = $next->schild( 0 )
306 );
307
308 # Return the qv() argument for further analysis.
309 return $next;
310}
311
312#-----------------------------------------------------------------------------
313
314# Validate $VERSION = version->new();
315
316# TODO: Fix this EVIL dual-purpose return value. This is ugggggleeeee.
317sub _validate_word_version {
318 my ( $self, $elem, $value ) = @_;
319
320 # Unless we are specifically allowing this construction without the
321 # 'use version;' on the same line, check for it and flunk if we do not
322 # find it.
323 $self->{_allow_version_without_use_on_same_line}
324 or do {
325 my $module;
326 return $self->violation( $DESC, $EXPL, $elem )
327 if not
328 $module = get_previous_module_used_on_same_line($value);
329 return $self->violation( $DESC, $EXPL, $elem )
330 if $VERSION_MODULE ne $module->content();
331 };
332
333 # Dig out the first argument of '->new()', flunking if we can not find it.
334 my $next;
335 return $next if
336 $next = $value->snext_sibling()
337 and $next->isa( 'PPI::Token::Operator' )
338 and q{->} eq $next->content()
339 and $next = $next->snext_sibling()
340 and $next->isa( 'PPI::Token::Word' )
341 and q{new} eq $next->content()
342 and $next = $next->snext_sibling()
343 and $next->isa( 'PPI::Structure::List' )
344 and $next = $next->schild( 0 )
345 and $next->isa( 'PPI::Statement::Expression' )
346 and $next = $next->schild( 0 );
347
348 return $self->violation( $DESC, $EXPL, $elem );
349}
350
35119µs1;
352
353__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.