← 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/Variables/ProhibitPunctuationVars.pm
StatementsExecuted 490 statements in 1.87ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111438µs842µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_create_magic_detectorPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector
111133µs133µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::CORE:regcompPerl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:regcomp (opcode)
6611123µs123µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_bracketed_form_of_variable_namePerl::Critic::Policy::Variables::ProhibitPunctuationVars::_bracketed_form_of_variable_name
11157µs57µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::CORE:sortPerl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:sort (opcode)
11120µs22µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::supported_parametersPerl::Critic::Policy::Variables::ProhibitPunctuationVars::supported_parameters
11119µs19µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@16Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@16
11118µs18µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@10Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@10
1117µs27µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@13Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@13
1117µs431µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@18Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@18
1117µs10µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@12Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@12
1117µs18µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@11Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@11
1117µs367µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@14Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@14
1117µs61µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::BEGIN@22Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@22
1115µs6µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::default_severityPerl::Critic::Policy::Variables::ProhibitPunctuationVars::default_severity
1111µs1µsPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::CORE:qrPerl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:qr (opcode)
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_make_violationPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_make_violation
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_strings_helperPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_strings_helper
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_strings_thoroughPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_strings_thorough
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_unbracket_variable_namePerl::Critic::Policy::Variables::ProhibitPunctuationVars::_unbracket_variable_name
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_violates_heredocPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_violates_heredoc
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_violates_magicPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_violates_magic
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::_violates_stringPerl::Critic::Policy::Variables::ProhibitPunctuationVars::_violates_string
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::applies_toPerl::Critic::Policy::Variables::ProhibitPunctuationVars::applies_to
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::default_themesPerl::Critic::Policy::Variables::ProhibitPunctuationVars::default_themes
0000s0sPerl::Critic::Policy::Variables::ProhibitPunctuationVars::::violatesPerl::Critic::Policy::Variables::ProhibitPunctuationVars::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::Variables::ProhibitPunctuationVars;
9
10239µs118µs
# spent 18µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@10 which was called: # once (18µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
# spent 18µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@10
11219µs229µs
# spent 18µs (7+11) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::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::Variables::ProhibitPunctuationVars::BEGIN@11 # spent 11µs making 1 call to strict::import
12218µs214µs
# spent 10µs (7+4) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@12 which was called: # once (7µs+4µs) by Module::Pluggable::Object::_require at line 12
use warnings;
# spent 10µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@12 # spent 4µs making 1 call to warnings::import
13221µs248µs
# spent 27µs (7+20) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@13 which was called: # once (7µs+20µs) by Module::Pluggable::Object::_require at line 13
use Readonly;
# spent 27µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@13 # spent 20µs making 1 call to Exporter::import
14222µs2727µs
# spent 367µs (7+360) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@14 which was called: # once (7µs+360µs) by Module::Pluggable::Object::_require at line 14
use English qw< -no_match_vars >;
# spent 367µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@14 # spent 360µs making 1 call to English::import
15
16239µs119µs
# spent 19µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@16 which was called: # once (19µs+0s) by Module::Pluggable::Object::_require at line 16
use PPI::Token::Magic;
# spent 19µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@16
17
181200ns
# spent 431µs (7+424) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@18 which was called: # once (7µs+424µs) by Module::Pluggable::Object::_require at line 20
use Perl::Critic::Utils qw<
19 :characters :severities :data_conversion :booleans
20123µs2856µs>;
# spent 431µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@18 # spent 424µs making 1 call to Exporter::import
21
2221.00ms2115µs
# spent 61µs (7+54) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@22 which was called: # once (7µs+54µs) by Module::Pluggable::Object::_require at line 22
use base 'Perl::Critic::Policy';
# spent 61µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::BEGIN@22 # spent 54µs making 1 call to base::import
23
241600nsour $VERSION = '1.121';
25
26#-----------------------------------------------------------------------------
27
2812µs130µsReadonly::Scalar my $DESC => q<Magic punctuation variable %s used>;
# spent 30µs making 1 call to Readonly::Scalar
2912µs142µsReadonly::Scalar my $EXPL => [79];
# spent 42µs making 1 call to Readonly::Scalar
30
31#-----------------------------------------------------------------------------
32
33# There is no English.pm equivalent for $].
34
# spent 22µs (20+2) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::supported_parameters which was called: # once (20µs+2µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
35 return (
36 {
37118µs22µs name => 'allow',
# spent 2µs making 2 calls to Readonly::Scalar::FETCH, avg 1µs/call
38 description => 'The additional variables to allow.',
39 default_string => $EMPTY,
40 behavior => 'string list',
41 list_always_present_values =>
42 [ qw< $_ @_ $1 $2 $3 $4 $5 $6 $7 $8 $9 _ $] > ],
43 },
44 {
45 name => 'string_mode',
46 description =>
47 'Controls checking interpolated strings for punctuation variables.',
48 default_string => 'thorough',
49 behavior => 'enumeration',
50 enumeration_values => [ qw< simple disable thorough > ],
51 enumeration_allow_multiple_values => 0,
52 },
53 );
54}
55
5611µs
# spent 6µs (5+1) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::default_severity which was called: # once (5µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_LOW }
57sub default_themes { return qw< core pbp cosmetic > }
58
59sub applies_to {
60 return qw<
61 PPI::Token::Magic
62 PPI::Token::Quote::Double
63 PPI::Token::Quote::Interpolate
64 PPI::Token::QuoteLike::Command
65 PPI::Token::QuoteLike::Backtick
66 PPI::Token::QuoteLike::Regexp
67 PPI::Token::QuoteLike::Readline
68 PPI::Token::HereDoc
69 >;
70}
71
72#-----------------------------------------------------------------------------
73
74
75# This list matches the initialization of %PPI::Token::Magic::magic.
76## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
7712µs159µsReadonly::Array my @MAGIC_VARIABLES =>
# spent 59µs making 1 call to Readonly::Array
78 qw{
79 $1 $2 $3 $4 $5 $6 $7 $8 $9
80 $_ $& $` $' $+ @+ %+ $* $. $/ $|
81 $\\ $" $; $% $= $- @- %- $)
82 $~ $^ $: $? $! %! $@ $$ $< $>
83 $( $0 $[ $] @_ @*
84
85 $^L $^A $^E $^C $^D $^F $^H
86 $^I $^M $^N $^O $^P $^R $^S
87 $^T $^V $^W $^X %^H
88
89 $::|
90 },
91 q<$}>,
92 q<$,>,
93 q<$#>,
94 q<$#+>,
95 q<$#->;
96## use critic
97
98# The main regular expression for detecting magic variables.
9912µs2868µsReadonly::Scalar my $MAGIC_REGEX => _create_magic_detector();
# spent 842µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector # spent 26µs making 1 call to Readonly::Scalar
100
101# The magic vars in this array will be ignored in interpolated strings
102# in simple mode. See CONFIGURATION in the pod.
10312µs121µsReadonly::Array my @IGNORE_FOR_INTERPOLATION =>
# spent 21µs making 1 call to Readonly::Array
104 ( q{$'}, q{$$}, q{$#}, q{$:}, ); ## no critic ( RequireInterpolationOfMetachars, ProhibitQuotedWordLists )
105
106#-----------------------------------------------------------------------------
107
108sub violates {
109 my ( $self, $elem, undef ) = @_;
110
111 if ( $elem->isa('PPI::Token::Magic') ) {
112 return _violates_magic( $self, $elem );
113 }
114 elsif ( $elem->isa('PPI::Token::HereDoc') ) {
115 return _violates_heredoc( $self, $elem );
116 }
117
118 #the remaining applies_to() classes are all interpolated strings
119 return _violates_string( $self, $elem );
120}
121
122#-----------------------------------------------------------------------------
123
124# Helper functions for the three types of violations: code, quotes, heredoc
125
126sub _violates_magic {
127 my ( $self, $elem, undef ) = @_;
128
129 if ( !exists $self->{_allow}->{$elem} ) {
130 return $self->_make_violation( $DESC, $EXPL, $elem );
131 }
132
133 return; # no violation
134}
135
136sub _violates_string {
137 my ( $self, $elem, undef ) = @_;
138
139 # RT #55604: Variables::ProhibitPunctuationVars gives false-positive on
140 # qr// regexp's ending in '$'
141 # We want to analyze the content of the string in the dictionary sense of
142 # the word 'content'. We can not simply use the PPI content() method to
143 # get this, because content() includes the delimiters.
144 my $string;
145 if ( $elem->can( 'string' ) ) {
146 # If we have a string() method (currently only the PPI::Token::Quote
147 # classes) use it to extract the content of the string.
148 $string = $elem->string();
149 } else {
150 # Lacking string(), we fake it under the assumption that the content
151 # of our element represents one of the 'normal' Perl strings, with a
152 # single-character delimiter, possibly preceded by an operator like
153 # 'qx' or 'qr'. If there is a leading operator, spaces may appear
154 # after it.
155 $string = $elem->content();
156 $string =~ s/ \A \w* \s* . //smx;
157 chop $string;
158 }
159
160 my %matches = _strings_helper( $self, $string );
161 if (%matches) {
162 my $DESC = qq<$DESC in interpolated string>;
163 return $self->_make_violation( $DESC, $EXPL, $elem, \%matches );
164 }
165
166 return; # no violation
167}
168
169sub _violates_heredoc {
170 my ( $self, $elem, undef ) = @_;
171
172 if ( $elem->{_mode} eq 'interpolate' or $elem->{_mode} eq 'command' ) {
173 my $heredoc_string = join "\n", $elem->heredoc();
174 my %matches = _strings_helper( $self, $heredoc_string );
175 if (%matches) {
176 my $DESC = qq<$DESC in interpolated here-document>;
177 return $self->_make_violation( $DESC, $EXPL, $elem, \%matches );
178 }
179 }
180
181 return; # no violation
182}
183
184#-----------------------------------------------------------------------------
185
186# Helper functions specific to interpolated strings
187
188sub _strings_helper {
189 my ( $self, $target_string, undef ) = @_;
190
191 return if ( $self->{_string_mode} eq 'disable' );
192 return _strings_thorough( $self, $target_string )
193 if $self->{_string_mode} eq 'thorough';
194
195 # we are in string_mode = simple
196
197 my @raw_matches = map { _unbracket_variable_name( $_ ) }
198 $target_string =~ m/$MAGIC_REGEX/goxms;
199 return if not @raw_matches;
200
201 my %matches = hashify(@raw_matches);
202
203 delete @matches{ keys %{ $self->{_allow} } };
204 delete @matches{@IGNORE_FOR_INTERPOLATION};
205
206 return %matches;
207}
208
209sub _strings_thorough {
210 my ( $self, $target_string, undef ) = @_;
211 my %matches;
212
213 MATCH:
214 while ( my ($match) = $target_string =~ m/$MAGIC_REGEX/gcxms ) {
215 my $nextchar = substr $target_string, $LAST_MATCH_END[0], 1;
216 my $vname = _unbracket_variable_name( $match );
217 my $c = $vname . $nextchar;
218
219 # These tests closely parallel those in PPI::Token::Magic,
220 # from which the regular expressions were taken.
221 # A degree of simplicity is sacrificed to maintain the parallel.
222 # $c is so named by analogy to that module.
223
224 # possibly *not* a magic variable
225 if ($c =~ m/ ^ \$ .* [ \w : \$ { ] $ /xms) {
226 ## no critic (RequireInterpolationOfMetachars)
227
228 if (
229 $c =~ m/ ^(\$(?:\_[\w:]|::)) /xms
230 or $c =~ m/ ^\$\'[\w] /xms )
231 {
232 next MATCH
233 if $c !~ m/ ^\$\'\d$ /xms;
234 # It not $' followed by a digit.
235 # So it's magic var with something immediately after.
236 }
237
238 next MATCH
239 if $c =~ m/ ^\$\$\w /xms; # It's a scalar dereference
240 next MATCH
241 if $c eq '$#$'
242 or $c eq '$#{'; # It's an index dereferencing cast
243 next MATCH
244 if $c =~ m/ ^(\$\#)\w /xms
245 ; # It's an array index thingy, e.g. $#array_name
246
247 # PPI's checks for long escaped vars like $^WIDE_SYSTEM_CALLS
248 # appear to be erroneous, and are omitted here.
249 # if ( $c =~ m/^\$\^\w{2}$/xms ) {
250 # }
251
252 next MATCH if $c =~ m/ ^ \$ \# [{] /xms; # It's a $#{...} cast
253 }
254
255 # The additional checking that PPI::Token::Magic does at this point
256 # is not necessary here, in an interpolated string context.
257
258 $matches{$vname} = 1;
259 }
260
261 delete @matches{ keys %{ $self->{_allow} } };
262
263 return %matches;
264}
265
266# RT #72910: A magic variable may appear in bracketed form; e.g. "$$" as
267# "${$}". Generate the bracketed form from the unbracketed form, and
268# return both.
269
# spent 123µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_bracketed_form_of_variable_name which was called 66 times, avg 2µs/call: # 66 times (123µs+0s) by Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector at line 305, avg 2µs/call
sub _bracketed_form_of_variable_name {
2706614µs my ( $name ) = @_;
271667µs length $name > 1
272 or return ( $name );
273667µs my $brktd = $name;
274667µs substr $brktd, 1, 0, '{';
275666µs $brktd .= '}';
27666138µs return( $name, $brktd );
277}
278
279# RT #72910: Since we loaded both bracketed and unbracketed forms of the
280# punctuation variables into our detecting regex, we need to detect and
281# strip the brackets if they are present to recover the canonical name.
282sub _unbracket_variable_name {
283 my ( $name ) = @_;
284 $name =~ m/ \A ( . ) [{] ( .+ ) [}] \z /smx
285 and return "$1$2";
286 return $name;
287}
288
289#-----------------------------------------------------------------------------
290
291
# spent 842µs (438+404) within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector which was called: # once (438µs+404µs) by Module::Pluggable::Object::_require at line 99
sub _create_magic_detector {
2921200ns my ($config) = @_;
293
294 # Set up the regexp alternation for matching magic variables.
295 # We can't process $config->{_allow} here because of a quirk in the
296 # way Perl::Critic handles testing.
297 #
298 # The sort is needed so that, e.g., $^ doesn't mask out $^M
299 my $magic_alternation =
300 '(?:'
301 . (
302 join
303 q<|>,
304 map { quotemeta $_ }
3056647µs66123µs reverse sort { length $a <=> length $b }
# spent 123µs making 66 calls to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_bracketed_form_of_variable_name, avg 2µs/call
306 map { _bracketed_form_of_variable_name( $_ ) }
3071273µs72147µs grep { q<%> ne substr $_, 0, 1 }
# spent 89µs making 70 calls to Readonly::Array::FETCH, avg 1µs/call # spent 57µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:sort # spent 1µs making 1 call to Readonly::Array::FETCHSIZE
308 @MAGIC_VARIABLES
309 )
310 . ')';
311
3121148µs2134µs return qr<
# spent 133µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:regcomp # spent 1µs making 1 call to Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:qr
313 (?: \A | [^\\] ) # beginning-of-string or any non-backslash
314 (?: \\{2} )* # zero or more double-backslashes
315 ( $magic_alternation ) # any magic punctuation variable
316 >xsm;
317}
318
319sub _make_violation {
320 my ( $self, $desc, $expl, $elem, $vars ) = @_;
321
322 my $vname = 'HASH' eq ref $vars ?
323 join ', ', sort keys %{ $vars } :
324 $elem->content();
325 return $self->violation( sprintf( $desc, $vname ), $expl, $elem );
326}
327
328112µs1;
329
330__END__
 
# spent 1µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:qr which was called: # once (1µs+0s) by Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector at line 312
sub Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:qr; # opcode
# spent 133µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:regcomp which was called: # once (133µs+0s) by Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector at line 312
sub Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:regcomp; # opcode
# spent 57µs within Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:sort which was called: # once (57µs+0s) by Perl::Critic::Policy::Variables::ProhibitPunctuationVars::_create_magic_detector at line 307
sub Perl::Critic::Policy::Variables::ProhibitPunctuationVars::CORE:sort; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.