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

Filename	/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/Subroutines/ProtectPrivateSubs.pm
Statements	Executed 28 statements in 683µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	26µs	46µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_parse_private_name_regex
1	1	1	22µs	25µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::supported_parameters
1	1	1	17µs	17µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@10
1	1	1	15µs	87µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@15
1	1	1	13µs	16µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@13
1	1	1	8µs	29µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@16
1	1	1	8µs	18µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@12
1	1	1	8µs	187µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@18
1	1	1	8µs	60µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@21
1	1	1	6µs	6µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:regcomp (opcode)
1	1	1	6µs	7µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::default_severity
1	1	1	1µs	1µs	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:qr (opcode)
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_is_other_pkg_private_function
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_is_other_pkg_private_method
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::applies_to
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::default_themes
0	0	0	0s	0s	Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::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::ProtectPrivateSubs;
9
10	2	40µs	1	17µs	# spent 17µs within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@10 which was called: # once (17µs+0s) by Module::Pluggable::Object::_require at line 10 use 5.006001; # spent 17µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@10
11
12	2	20µs	2	30µs	# spent 18µs (8+11) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@12 which was called: # once (8µs+11µs) by Module::Pluggable::Object::_require at line 12 use strict; # spent 18µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@12 # spent 11µs making 1 call to strict::import
13	2	24µs	2	20µs	# spent 16µs (13+4) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@13 which was called: # once (13µs+4µs) by Module::Pluggable::Object::_require at line 13 use warnings; # spent 16µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@13 # spent 4µs making 1 call to warnings::import
14
15	2	33µs	2	159µs	# spent 87µs (15+72) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@15 which was called: # once (15µs+72µs) by Module::Pluggable::Object::_require at line 15 use English qw< $EVAL_ERROR -no_match_vars >; # spent 87µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@15 # spent 72µs making 1 call to English::import
16	2	34µs	2	49µs	# spent 29µs (8+20) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@16 which was called: # once (8µs+20µs) by Module::Pluggable::Object::_require at line 16 use Readonly; # spent 29µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@16 # spent 20µs making 1 call to Exporter::import
17
18	1	200ns			# spent 187µs (8+180) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@18 which was called: # once (8µs+180µs) by Module::Pluggable::Object::_require at line 20 use Perl::Critic::Utils qw<
19					:severities $EMPTY is_function_call is_method_call
20	1	23µs	2	367µs	>; # spent 187µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@18 # spent 180µs making 1 call to Exporter::import
21	2	453µs	2	113µs	# spent 60µs (8+53) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@21 which was called: # once (8µs+53µs) by Module::Pluggable::Object::_require at line 21 use base 'Perl::Critic::Policy'; # spent 60µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::BEGIN@21 # spent 53µs making 1 call to base::import
22
23	1	600ns			our $VERSION = '1.121';
24
25					#-----------------------------------------------------------------------------
26
27	1	2µs	1	28µs	Readonly::Scalar my $DESC => q<Private subroutine/method used>; # spent 28µs making 1 call to Readonly::Scalar
28	1	1µs	1	21µs	Readonly::Scalar my $EXPL => q<Use published APIs>; # spent 21µs making 1 call to Readonly::Scalar
29
30					#-----------------------------------------------------------------------------
31
32					# spent 25µs (22+3) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::supported_parameters which was called: # once (22µs+3µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm sub supported_parameters {
33					return (
34					{
35	1	20µs	2	3µs	name => 'private_name_regex', # spent 3µs making 2 calls to Readonly::Scalar::FETCH, avg 1µs/call
36					description => 'Pattern that determines what a private subroutine is.',
37					default_string => '\b_\w+\b', ## no critic (RequireInterpolationOfMetachars)
38					behavior => 'string',
39					parser => \& _parse_private_name_regex,
40					},
41					{
42					name => 'allow',
43					description =>
44					q<Subroutines matching the private name regex to allow under this policy.>,
45					default_string => $EMPTY,
46					behavior => 'string list',
47					list_always_present_values => [ qw<
48					POSIX::_PC_CHOWN_RESTRICTED
49					POSIX::_PC_LINK_MAX
50					POSIX::_PC_MAX_CANON
51					POSIX::_PC_MAX_INPUT
52					POSIX::_PC_NAME_MAX
53					POSIX::_PC_NO_TRUNC
54					POSIX::_PC_PATH_MAX
55					POSIX::_PC_PIPE_BUF
56					POSIX::_PC_VDISABLE
57					POSIX::_POSIX_ARG_MAX
58					POSIX::_POSIX_CHILD_MAX
59					POSIX::_POSIX_CHOWN_RESTRICTED
60					POSIX::_POSIX_JOB_CONTROL
61					POSIX::_POSIX_LINK_MAX
62					POSIX::_POSIX_MAX_CANON
63					POSIX::_POSIX_MAX_INPUT
64					POSIX::_POSIX_NAME_MAX
65					POSIX::_POSIX_NGROUPS_MAX
66					POSIX::_POSIX_NO_TRUNC
67					POSIX::_POSIX_OPEN_MAX
68					POSIX::_POSIX_PATH_MAX
69					POSIX::_POSIX_PIPE_BUF
70					POSIX::_POSIX_SAVED_IDS
71					POSIX::_POSIX_SSIZE_MAX
72					POSIX::_POSIX_STREAM_MAX
73					POSIX::_POSIX_TZNAME_MAX
74					POSIX::_POSIX_VDISABLE
75					POSIX::_POSIX_VERSION
76					POSIX::_SC_ARG_MAX
77					POSIX::_SC_CHILD_MAX
78					POSIX::_SC_CLK_TCK
79					POSIX::_SC_JOB_CONTROL
80					POSIX::_SC_NGROUPS_MAX
81					POSIX::_SC_OPEN_MAX
82					POSIX::_SC_PAGESIZE
83					POSIX::_SC_SAVED_IDS
84					POSIX::_SC_STREAM_MAX
85					POSIX::_SC_TZNAME_MAX
86					POSIX::_SC_VERSION
87					POSIX::_exit
88					> ],
89					},
90					);
91					}
92
93	1	1µs			# spent 7µs (6+1) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::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 }
94					sub default_themes { return qw( core maintenance certrule ) }
95					sub applies_to { return 'PPI::Token::Word' }
96
97					#-----------------------------------------------------------------------------
98
99					# spent 46µs (26+20) within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_parse_private_name_regex which was called: # once (26µs+20µs) by Perl::Critic::PolicyParameter::parse_and_validate_config_value at line 231 of Perl/Critic/PolicyParameter.pm sub _parse_private_name_regex {
100	1	700ns			my ($self, $parameter, $config_string) = @_;
101
102	1	2µs	1	2µs	defined $config_string # spent 2µs making 1 call to Perl::Critic::PolicyParameter::get_default_string
103					or $config_string = $parameter->get_default_string();
104
105	1	400ns			my $regex;
106	3	18µs	2	7µs	eval { $regex = qr/$config_string/; 1 } ## no critic (RegularExpressions) # spent 6µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:regcomp # spent 1µs making 1 call to Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:qr
107					or $self->throw_parameter_value_exception(
108					'private_name_regex',
109					$config_string,
110					undef,
111					"is not a valid regular expression: $EVAL_ERROR",
112					);
113
114	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
115
116	1	3µs			return;
117					}
118
119					#-----------------------------------------------------------------------------
120
121					sub violates {
122					my ( $self, $elem, undef ) = @_;
123
124					if ( my $prior = $elem->sprevious_sibling() ) {
125					my $prior_name = $prior->content();
126					return if $prior_name eq 'package';
127					return if $prior_name eq 'require';
128					return if $prior_name eq 'use';
129					}
130
131					if (
132					$self->_is_other_pkg_private_function($elem)
133					or $self->_is_other_pkg_private_method($elem)
134					) {
135					return $self->violation( $DESC, $EXPL, $elem );
136					}
137
138					return; # ok!
139					}
140
141					sub _is_other_pkg_private_function {
142					my ( $self, $elem ) = @_;
143
144					return if ! is_function_call($elem) && ! is_method_call($elem);
145
146					my $private_name_regex = $self->{_private_name_regex};
147					my $content = $elem->content();
148					return
149					$content =~ m< \w+::$private_name_regex \z >xms
150					&& $content !~ m< \A SUPER::$private_name_regex \z >xms
151					&& ! $self->{_allow}{$content};
152					}
153
154					sub _is_other_pkg_private_method {
155					my ( $self, $elem ) = @_;
156
157					my $private_name_regex = $self->{_private_name_regex};
158					my $content = $elem->content();
159
160					# look for structures like "Some::Package->_foo()"
161					return if $content !~ m< \A $private_name_regex \z >xms;
162					my $operator = $elem->sprevious_sibling() or return;
163					return if $operator->content() ne q[->];
164
165					my $package = $operator->sprevious_sibling() or return;
166					return if not $package->isa('PPI::Token::Word');
167
168					# sometimes the previous sib is a keyword, as in:
169					# shift->_private_method(); This is typically used as
170					# shorthand for "my $self=shift; $self->_private_method()"
171					return if $package eq 'shift' or $package eq '__PACKAGE__';
172
173					# Maybe the user wanted to exempt this explicitly.
174					return if $self->{_allow}{"${package}::$content"};
175
176					return 1;
177					}
178
179	1	3µs			1;
180
181					__END__

					# spent 1µs within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:qr which was called: # once (1µs+0s) by Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_parse_private_name_regex at line 106 sub Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:qr; # opcode
					# spent 6µs within Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:regcomp which was called: # once (6µs+0s) by Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::_parse_private_name_regex at line 106 sub Perl::Critic::Policy::Subroutines::ProtectPrivateSubs::CORE:regcomp; # opcode