← 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/Subroutines/ProhibitUnusedPrivateSubroutines.pm
StatementsExecuted 29 statements in 1.17ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11127┬Ás50┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_parse_private_name_regexPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_parse_private_name_regex
11126┬Ás408┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@18Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@18
11116┬Ás16┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@10Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@10
11116┬Ás18┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::supported_parametersPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::supported_parameters
1118┬Ás8┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::CORE:regcompPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:regcomp (opcode)
1118┬Ás11┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@13Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@13
1118┬Ás26┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@16Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@16
1117┬Ás57┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@22Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@22
1117┬Ás18┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@12Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@12
1117┬Ás187┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::BEGIN@15Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@15
1116┬Ás7┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::default_severityPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::default_severity
1112┬Ás2┬ÁsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::CORE:qrPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:qr (opcode)
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_compare_token_locationsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_compare_token_locations
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_expand_elementPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_expand_element
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_find_regular_expressionsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_regular_expressions
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_find_sub_call_in_documentPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_call_in_document
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_find_sub_overload_in_documentPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_overload_in_document
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_find_sub_reference_in_documentPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_reference_in_document
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_find_sub_usage_in_regexpPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_usage_in_regexp
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::_get_include_argumentsPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_get_include_arguments
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::applies_toPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::applies_to
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::default_themesPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::default_themes
0000s0sPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::::violatesPerl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::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::Subroutines::ProhibitUnusedPrivateSubroutines;
9
10239┬Ás116┬Ás
# spent 16┬Ás within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@10 which was called: # once (16┬Ás+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
11
12222┬Ás229┬Ás
# spent 18┬Ás (7+11) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@12 which was called: # once (7┬Ás+11┬Ás) by Module::Pluggable::Object::_require at line 12
use strict;
# spent 18┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@12 # spent 11┬Ás making 1 call to strict::import
13221┬Ás215┬Ás
# spent 11┬Ás (8+4) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@13 which was called: # once (8┬Ás+4┬Ás) by Module::Pluggable::Object::_require at line 13
use warnings;
# spent 11┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@13 # spent 4┬Ás making 1 call to warnings::import
14
15222┬Ás2367┬Ás
# spent 187┬Ás (7+180) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@15 which was called: # once (7┬Ás+180┬Ás) by Module::Pluggable::Object::_require at line 15
use English qw< $EVAL_ERROR -no_match_vars >;
# spent 187┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@15 # spent 180┬Ás making 1 call to English::import
16225┬Ás245┬Ás
# spent 26┬Ás (8+19) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@16 which was called: # once (8┬Ás+19┬Ás) by Module::Pluggable::Object::_require at line 16
use Readonly;
# spent 26┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@16 # spent 19┬Ás making 1 call to Exporter::import
17
181300ns
# spent 408┬Ás (26+382) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@18 which was called: # once (26┬Ás+382┬Ás) by Module::Pluggable::Object::_require at line 21
use Perl::Critic::Utils qw{
19 :characters hashify is_function_call is_method_call :severities
20 $EMPTY $TRUE
21125┬Ás2790┬Ás};
# spent 408┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@18 # spent 382┬Ás making 1 call to Exporter::import
222959┬Ás2106┬Ás
# spent 57┬Ás (7+50) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@22 which was called: # once (7┬Ás+50┬Ás) by Module::Pluggable::Object::_require at line 22
use base 'Perl::Critic::Policy';
# spent 57┬Ás making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@22 # spent 50┬Ás making 1 call to base::import
23
241600nsour $VERSION = '1.121';
25
26#-----------------------------------------------------------------------------
27
2812┬Ás130┬ÁsReadonly::Scalar my $DESC =>
# spent 30┬Ás making 1 call to Readonly::Scalar
29 q{Private subroutine/method '%s' declared but not used};
301900ns121┬ÁsReadonly::Scalar my $EXPL => q{Eliminate dead code};
# spent 21┬Ás making 1 call to Readonly::Scalar
31
3213┬Ás237┬ÁsReadonly::Hash my %IS_COMMA => hashify( $COMMA, $FATCOMMA );
# spent 24┬Ás making 1 call to Readonly::Hash # spent 13┬Ás making 1 call to Perl::Critic::Utils::hashify
33
34#-----------------------------------------------------------------------------
35
36
# spent 18┬Ás (16+2) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::supported_parameters which was called: # once (16┬Ás+2┬Ás) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
37 return (
38 {
39114┬Ás22┬Ás name => 'private_name_regex',
# spent 2┬Ás making 2 calls to Readonly::Scalar::FETCH, avg 1┬Ás/call
40 description => 'Pattern that determines what a private subroutine is.',
41 default_string => '\b_\w+\b', ## no critic (RequireInterpolationOfMetachars)
42 behavior => 'string',
43 parser => \&_parse_private_name_regex,
44 },
45 {
46 name => 'allow',
47 description =>
48 q<Subroutines matching the private name regex to allow under this policy.>,
49 default_string => $EMPTY,
50 behavior => 'string list',
51 },
52 );
53}
54
5512┬Ás
# spent 7┬Ás (6+1) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::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_MEDIUM }
56sub default_themes { return qw( core maintenance certrec ) }
57sub applies_to { return 'PPI::Statement::Sub' }
58
59#-----------------------------------------------------------------------------
60
61
# spent 50┬Ás (27+23) within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_parse_private_name_regex which was called: # once (27┬Ás+23┬Ás) by Perl::Critic::PolicyParameter::parse_and_validate_config_value at line 231 of Perl/Critic/PolicyParameter.pm
sub _parse_private_name_regex {
621500ns my ($self, $parameter, $config_string) = @_;
6312┬Ás11┬Ás defined $config_string
# spent 1┬Ás making 1 call to Perl::Critic::PolicyParameter::get_default_string
64 or $config_string = $parameter->get_default_string();
65
661500ns my $regex;
67322┬Ás210┬Ás eval { $regex = qr/$config_string/; 1 } ## no critic (RegularExpressions)
68 or $self->throw_parameter_value_exception(
69 'private_name_regex',
70 $config_string,
71 undef,
72 "is not a valid regular expression: $EVAL_ERROR",
73 );
74
7514┬Ás111┬Ás $self->__set_parameter_value($parameter, $regex);
# spent 11┬Ás making 1 call to Perl::Critic::Policy::__set_parameter_value
76
7713┬Ás return;
78}
79
80#-----------------------------------------------------------------------------
81
82sub violates {
83 my ( $self, $elem, $document ) = @_;
84
85 # Not interested in forward declarations, only the real thing.
86 $elem->forward() and return;
87
88 # Not interested in subs without names.
89 my $name = $elem->name() or return;
90
91 # If the sub is shoved into someone else's name space, we wimp out.
92 $name =~ m/ :: /smx and return;
93
94 # If the name is explicitly allowed, we just return (OK).
95 $self->{_allow}{$name} and return;
96
97 # If the name is not an anonymous subroutine according to our definition,
98 # we just return (OK).
99 $name =~ m/ \A $self->{_private_name_regex} \z /smx or return;
100
101 # If the subroutine is called in the document, just return (OK).
102 $self->_find_sub_call_in_document( $elem, $document ) and return;
103
104 # If the subroutine is referred to in the document, just return (OK).
105 $self->_find_sub_reference_in_document( $elem, $document ) and return;
106
107 # If the subroutine is used in an overload, just return (OK).
108 $self->_find_sub_overload_in_document( $elem, $document ) and return;
109
110 # No uses of subroutine found. Return a violation.
111 return $self->violation( sprintf( $DESC, $name ), $EXPL, $elem );
112}
113
114
115# Basically the spaceship operator for token locations. The arguments are the
116# two tokens to compare. If either location is unavailable we return undef.
117sub _compare_token_locations {
118 my ( $left_token, $right_token ) = @_;
119 my $left_loc = $left_token->location() or return;
120 my $right_loc = $right_token->location() or return;
121 return $left_loc->[0] <=> $right_loc->[0] ||
122 $left_loc->[1] <=> $right_loc->[1];
123}
124
125# Find out if the subroutine defined in $elem is called in $document. Calls
126# inside the subroutine itself do not count.
127sub _find_sub_call_in_document {
128 my ( $self, $elem, $document ) = @_;
129
130 my $start_token = $elem->first_token();
131 my $finish_token = $elem->last_token();
132 my $name = $elem->name();
133
134 if ( my $found = $document->find( 'PPI::Token::Word' ) ) {
135 foreach my $usage ( @{ $found } ) {
136 $name eq $usage->content() or next;
137 is_function_call( $usage )
138 or is_method_call( $usage )
139 or next;
140 _compare_token_locations( $usage, $start_token ) < 0
141 and return $TRUE;
142 _compare_token_locations( $finish_token, $usage ) < 0
143 and return $TRUE;
144 }
145 }
146
147 foreach my $regexp ( _find_regular_expressions( $document ) ) {
148
149 _compare_token_locations( $regexp, $start_token ) >= 0
150 and _compare_token_locations( $finish_token, $regexp ) >= 0
151 and next;
152 _find_sub_usage_in_regexp( $name, $regexp, $document )
153 and return $TRUE;
154
155 }
156
157 return;
158}
159
160# Find analyzable regular expressions in the given document. This means
161# matches, substitutions, and the qr{} operator.
162sub _find_regular_expressions {
163 my ( $document ) = @_;
164
165 return ( map { @{ $document->find( $_ ) || [] } } qw{
166 PPI::Token::Regexp::Match
167 PPI::Token::Regexp::Substitute
168 PPI::Token::QuoteLike::Regexp
169 } );
170}
171
172# Find out if the subroutine named in $name is called in the given $regexp.
173# This could happen either by an explicit s/.../.../e, or by interpolation
174# (i.e. @{[...]} ).
175sub _find_sub_usage_in_regexp {
176 my ( $name, $regexp, $document ) = @_;
177
178 my $ppix = $document->ppix_regexp_from_element( $regexp ) or return;
179 $ppix->failures() and return;
180
181 foreach my $code ( @{ $ppix->find( 'PPIx::Regexp::Token::Code' ) || [] } ) {
182 my $doc = $code->ppi() or next;
183
184 foreach my $word ( @{ $doc->find( 'PPI::Token::Word' ) || [] } ) {
185 $name eq $word->content() or next;
186 is_function_call( $word )
187 or is_method_call( $word )
188 or next;
189 return $TRUE;
190 }
191
192 }
193
194 return;
195}
196
197# Find out if the subroutine defined in $elem handles an overloaded operator.
198# We recognize both string literals (the usual form) and words (in case
199# someone perversely followed the subroutine name by a fat comma). We ignore
200# the '\&_foo' construction, since _find_sub_reference_in_document() should
201# find this.
202sub _find_sub_overload_in_document {
203 my ( $self, $elem, $document ) = @_;
204
205 my $name = $elem->name();
206
207 if ( my $found = $document->find( 'PPI::Statement::Include' ) ) {
208 foreach my $usage ( @{ $found } ) {
209 'overload' eq $usage->module() or next;
210 my $inx;
211 foreach my $arg ( _get_include_arguments( $usage ) ) {
212 $inx++ % 2 or next;
213 @{ $arg } == 1 or next;
214 my $element = $arg->[0];
215
216 if ( $element->isa( 'PPI::Token::Quote' ) ) {
217 $element->string() eq $name and return $TRUE;
218 } elsif ( $element->isa( 'PPI::Token::Word' ) ) {
219 $element->content() eq $name and return $TRUE;
220 }
221 }
222 }
223 }
224
225 return;
226}
227
228# Find things of the form '&_foo'. This includes both references proper (i.e.
229# '\&foo'), calls using the sigil, and gotos. The latter two do not count if
230# inside the subroutine itself.
231sub _find_sub_reference_in_document {
232 my ( $self, $elem, $document ) = @_;
233
234 my $start_token = $elem->first_token();
235 my $finish_token = $elem->last_token();
236 my $symbol = q<&> . $elem->name();
237
238 if ( my $found = $document->find( 'PPI::Token::Symbol' ) ) {
239 foreach my $usage ( @{ $found } ) {
240 $symbol eq $usage->content() or next;
241
242 my $prior = $usage->sprevious_sibling();
243 $prior
244 and $prior->isa( 'PPI::Token::Cast' )
245 and q<\\> eq $prior->content()
246 and return $TRUE;
247
248 is_function_call( $usage )
249 or $prior
250 and $prior->isa( 'PPI::Token::Word' )
251 and 'goto' eq $prior->content()
252 or next;
253
254 _compare_token_locations( $usage, $start_token ) < 0
255 and return $TRUE;
256 _compare_token_locations( $finish_token, $usage ) < 0
257 and return $TRUE;
258 }
259 }
260
261 return;
262}
263
264# Expand the given element, losing any brackets along the way. This is
265# intended to be used to flatten the argument list of 'use overload'.
266sub _expand_element {
267 my ( $element ) = @_;
268 $element->isa( 'PPI::Node' )
269 and return ( map { _expand_element( $_ ) } $_->children() );
270 $element->significant() and return $element;
271 return;
272}
273
274# Given an include statement, return its arguments. The return is a flattened
275# list of lists of tokens, each list of tokens representing an argument.
276sub _get_include_arguments {
277 my ($include) = @_;
278
279 # If there are no arguments, just return. We flatten the list because
280 # someone might use parens to define it.
281 my @arguments = map { _expand_element( $_ ) } $include->arguments()
282 or return;
283
284 my @elements;
285 my $inx = 0;
286 foreach my $element ( @arguments ) {
287 if ( $element->isa( 'PPI::Token::Operator' ) &&
288 $IS_COMMA{$element->content()} ) {
289 $inx++;
290 } else {
291 push @{ $elements[$inx] ||= [] }, $element;
292 }
293 }
294
295 return @elements;
296}
297
29814┬Ás1;
299
300__END__
 
# spent 2┬Ás within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:qr which was called: # once (2┬Ás+0s) by Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_parse_private_name_regex at line 67
sub Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:qr; # opcode
# spent 8┬Ás within Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:regcomp which was called: # once (8┬Ás+0s) by Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_parse_private_name_regex at line 67
sub Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:regcomp; # opcode