Profile of Perl/Critic/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm

Filename	/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm
Statements	Executed 29 statements in 1.17ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	27µs	50µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_parse_private_name_regex
1	1	1	26µs	408µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@18
1	1	1	16µs	16µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@10
1	1	1	16µs	18µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::supported_parameters
1	1	1	8µs	8µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:regcomp (opcode)
1	1	1	8µs	11µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@13
1	1	1	8µs	26µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@16
1	1	1	7µs	57µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@22
1	1	1	7µs	18µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@12
1	1	1	7µs	187µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@15
1	1	1	6µs	7µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::default_severity
1	1	1	2µs	2µs	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:qr (opcode)
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_compare_token_locations
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_expand_element
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_regular_expressions
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_call_in_document
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_overload_in_document
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_reference_in_document
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_find_sub_usage_in_regexp
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::_get_include_arguments
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::applies_to
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::default_themes
0	0	0	0s	0s	Perl::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
8					package Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines;
9
10	2	39µs	1	16µ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; # spent 16µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@10
11
12	2	22µs	2	29µ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
13	2	21µs	2	15µ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
15	2	22µs	2	367µ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
16	2	25µs	2	45µ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
18	1	300ns			# 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
21	1	25µs	2	790µs	}; # spent 408µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::BEGIN@18 # spent 382µs making 1 call to Exporter::import
22	2	959µs	2	106µ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
24	1	600ns			our $VERSION = '1.121';
25
26					#-----------------------------------------------------------------------------
27
28	1	2µs	1	30µs	Readonly::Scalar my $DESC => # spent 30µs making 1 call to Readonly::Scalar
29					q{Private subroutine/method '%s' declared but not used};
30	1	900ns	1	21µs	Readonly::Scalar my $EXPL => q{Eliminate dead code}; # spent 21µs making 1 call to Readonly::Scalar
31
32	1	3µs	2	37µs	Readonly::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					{
39	1	14µs	2	2µ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
55	1	2µ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 }
56					sub default_themes { return qw( core maintenance certrec ) }
57					sub 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 {
62	1	500ns			my ($self, $parameter, $config_string) = @_;
63	1	2µs	1	1µ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
66	1	500ns			my $regex;
67	3	22µs	2	10µs	eval { $regex = qr/$config_string/; 1 } ## no critic (RegularExpressions) # spent 8µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:regcomp # spent 2µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitUnusedPrivateSubroutines::CORE:qr
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
75	1	4µs	1	11µs	$self->__set_parameter_value($parameter, $regex); # spent 11µs making 1 call to Perl::Critic::Policy::__set_parameter_value
76
77	1	3µs			return;
78					}
79
80					#-----------------------------------------------------------------------------
81
82					sub 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.
117					sub _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.
127					sub _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.
162					sub _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. @{[...]} ).
175					sub _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.
202					sub _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.
231					sub _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'.
266					sub _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.
276					sub _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
298	1	4µs			1;
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