← 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:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/InputOutput/RequireBriefOpen.pm
StatementsExecuted 28 statements in 1.05ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11116µs16µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@10Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@10
1118µs144µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@16Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@16
1118µs56µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@21Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@21
1117µs453µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@18Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@18
1117µs9µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::default_severityPerl::Critic::Policy::InputOutput::RequireBriefOpen::default_severity
1117µs28µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@14Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@14
1117µs10µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@12Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@12
1116µs18µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::BEGIN@11Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@11
1115µs5µsPerl::Critic::Policy::InputOutput::RequireBriefOpen::::supported_parametersPerl::Critic::Policy::InputOutput::RequireBriefOpen::supported_parameters
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::__ANON__[:102]Perl::Critic::Policy::InputOutput::RequireBriefOpen::__ANON__[:102]
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::__ANON__[:141]Perl::Critic::Policy::InputOutput::RequireBriefOpen::__ANON__[:141]
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::_find_close_invocations_or_returnPerl::Critic::Policy::InputOutput::RequireBriefOpen::_find_close_invocations_or_return
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::_get_opened_fhPerl::Critic::Policy::InputOutput::RequireBriefOpen::_get_opened_fh
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::_get_scopePerl::Critic::Policy::InputOutput::RequireBriefOpen::_get_scope
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::_unwrap_blockPerl::Critic::Policy::InputOutput::RequireBriefOpen::_unwrap_block
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::applies_toPerl::Critic::Policy::InputOutput::RequireBriefOpen::applies_to
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::default_themesPerl::Critic::Policy::InputOutput::RequireBriefOpen::default_themes
0000s0sPerl::Critic::Policy::InputOutput::RequireBriefOpen::::violatesPerl::Critic::Policy::InputOutput::RequireBriefOpen::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::InputOutput::RequireBriefOpen;
9
10238µs116µs
# spent 16µs within Perl::Critic::Policy::InputOutput::RequireBriefOpen::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::InputOutput::RequireBriefOpen::BEGIN@10
11219µs229µs
# spent 18µs (6+11) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@11 which was called: # once (6µs+11µs) by Module::Pluggable::Object::_require at line 11
use strict;
# spent 18µs making 1 call to Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@11 # spent 11µs making 1 call to strict::import
12218µs214µs
# spent 10µs (7+4) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::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::InputOutput::RequireBriefOpen::BEGIN@12 # spent 4µs making 1 call to warnings::import
13
14226µs249µs
# spent 28µs (7+21) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@14 which was called: # once (7µs+21µs) by Module::Pluggable::Object::_require at line 14
use Readonly;
# spent 28µs making 1 call to Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@14 # spent 21µs making 1 call to Exporter::import
15
16226µs2281µs
# spent 144µs (8+137) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@16 which was called: # once (8µs+137µs) by Module::Pluggable::Object::_require at line 16
use List::MoreUtils qw(any);
# spent 144µs making 1 call to Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@16 # spent 137µs making 1 call to Exporter::Tiny::import
17
181200ns
# spent 453µs (7+446) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@18 which was called: # once (7µs+446µs) by Module::Pluggable::Object::_require at line 20
use Perl::Critic::Utils qw{ :severities :classification :booleans
19 hashify parse_arg_list
20124µs2899µs};
# spent 453µs making 1 call to Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@18 # spent 446µs making 1 call to Exporter::import
212871µs2104µs
# spent 56µs (8+48) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@21 which was called: # once (8µs+48µs) by Module::Pluggable::Object::_require at line 21
use base 'Perl::Critic::Policy';
# spent 56µs making 1 call to Perl::Critic::Policy::InputOutput::RequireBriefOpen::BEGIN@21 # spent 48µs making 1 call to base::import
22
231600nsour $VERSION = '1.121';
24
25#-----------------------------------------------------------------------------
26
2712µs130µsReadonly::Scalar my $DESC => q<Close filehandles as soon as possible after opening them..>;
# spent 30µs making 1 call to Readonly::Scalar
2812µs142µsReadonly::Scalar my $EXPL => [209];
# spent 42µs making 1 call to Readonly::Scalar
29
301900ns120µsReadonly::Scalar my $SCALAR_SIGIL => q<$>;
# spent 20µs making 1 call to Readonly::Scalar
3111µs120µsReadonly::Scalar my $GLOB_SIGIL => q<*>;
# spent 20µs making 1 call to Readonly::Scalar
32
33# Identify the builtins that are equivalent to 'open' and 'close'. Note that
34# 'return' is considered equivalent to 'close'.
3512µs227µsReadonly::Hash my %CLOSE_BUILTIN => hashify( qw{
# spent 24µs making 1 call to Readonly::Hash # spent 3µs making 1 call to Perl::Critic::Utils::hashify
36 close
37 CORE::close
38 CORE::GLOBAL::close
39 return
40} );
4112µs223µsReadonly::Hash my %OPEN_BUILTIN => hashify( qw{
# spent 21µs making 1 call to Readonly::Hash # spent 2µs making 1 call to Perl::Critic::Utils::hashify
42 open
43 CORE::open
44 CORE::GLOBAL::open
45} );
46
47# Possible values for $is_lexical
481900ns120µsReadonly::Scalar my $NOT_LEXICAL => 0; # Guaranteed only false value
# spent 20µs making 1 call to Readonly::Scalar
491800ns119µsReadonly::Scalar my $LOCAL_LEXICAL => 1;
# spent 19µs making 1 call to Readonly::Scalar
501900ns119µsReadonly::Scalar my $NON_LOCAL_LEXICAL => 2;
# spent 19µs making 1 call to Readonly::Scalar
51
521800ns119µsReadonly::Scalar my $LAST_ELEMENT => -1;
# spent 19µs making 1 call to Readonly::Scalar
53
54#-----------------------------------------------------------------------------
55
56
# spent 5µs within Perl::Critic::Policy::InputOutput::RequireBriefOpen::supported_parameters which was called: # once (5µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
57 return (
58 {
5917µs name => 'lines',
60 description => 'The maximum number of lines between an open() and a close().',
61 default_string => '9',
62 behavior => 'integer',
63 integer_minimum => 1,
64 },
65 );
66}
67
6812µs
# spent 9µs (7+2) within Perl::Critic::Policy::InputOutput::RequireBriefOpen::default_severity which was called: # once (7µs+2µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_HIGH }
69sub default_themes { return qw< core pbp maintenance > }
70sub applies_to { return 'PPI::Token::Word' }
71
72#-----------------------------------------------------------------------------
73
74sub violates {
75 my ( $self, $elem, undef ) = @_;
76
77 # Is it a call to open?
78 $OPEN_BUILTIN{$elem->content()} or return;
79 return if ! is_function_call($elem);
80 my @open_args = parse_arg_list($elem);
81 return if 2 > @open_args; # not a valid call to open()
82
83 my ($is_lexical, $fh) = _get_opened_fh($open_args[0]);
84 return if not $fh;
85 return if $fh =~ m< \A [*]? STD (?: IN|OUT|ERR ) \z >xms;
86
87 for my $close_token ( $self->_find_close_invocations_or_return(
88 $elem, $is_lexical ) ) {
89 # The $close_token might be a close() or a return()
90 # It doesn't matter which -- both satisfy this policy
91 if (is_function_call($close_token)) {
92 my @close_args = parse_arg_list($close_token);
93
94 my $close_parameter = $close_args[0];
95 if ('ARRAY' eq ref $close_parameter) {
96 $close_parameter = ${$close_parameter}[0];
97 }
98 if ( $close_parameter ) {
99 $close_parameter = "$close_parameter";
100 return if $fh eq $close_parameter;
101
102 if ( any { m< \A [*] >xms } ($fh, $close_parameter) ) {
103 (my $stripped_fh = $fh) =~ s< \A [*] ><>xms;
104 (my $stripped_parameter = $close_parameter) =~
105 s< \A [*] ><>xms;
106
107 return if $stripped_fh eq $stripped_parameter;
108 }
109 }
110 }
111 elsif ($is_lexical && is_method_call($close_token)) {
112 my $tok = $close_token->sprevious_sibling->sprevious_sibling;
113 return if $fh eq $tok;
114 }
115 }
116
117 return $self->violation( $DESC, $EXPL, $elem );
118}
119
120sub _find_close_invocations_or_return {
121 my ($self, $elem, $is_lexical) = @_;
122
123 my $parent = $self->_get_scope( $elem, $is_lexical );
124 return if !$parent; # I can't think of a scenario where this would happen
125
126 my $open_loc = $elem->location;
127 # we don't actually allow _lines to be zero or undef, but maybe we will
128 my $end_line = $self->{_lines} ? $open_loc->[0] + $self->{_lines} : undef;
129
130 my $closes = $parent->find(sub {
131 ##no critic (ProhibitExplicitReturnUndef)
132 my ($parent, $candidate) = @_; ## no critic(Variables::ProhibitReusedNames)
133 return undef if $candidate->isa('PPI::Statement::Sub');
134 my $candidate_loc = $candidate->location;
135 return undef if !defined $candidate_loc->[0];
136 return 0 if $candidate_loc->[0] < $open_loc->[0];
137 return 0 if $candidate_loc->[0] == $open_loc->[0] && $candidate_loc->[1] <= $open_loc->[1];
138 return undef if defined $end_line && $candidate_loc->[0] > $end_line;
139 return 0 if !$candidate->isa('PPI::Token::Word');
140 return $CLOSE_BUILTIN{ $candidate->content() } || 0;
141 });
142 return @{$closes || []};
143}
144
145sub _get_scope {
146 my ( $self, $elem, $is_lexical ) = @_;
147
148 my $open_loc = $elem->location;
149 my $end_line = ( $self->{_lines} && defined $open_loc->[0] ) ?
150 $open_loc->[0] + $self->{_lines} :
151 undef;
152
153 while ( my $dad = $elem->parent) {
154 $elem = $dad;
155 next if not $elem->scope;
156
157 # If we are analyzing something like 'open my $fh ...', the
158 # most-local scope suffices. RT #64437
159 return $elem if $LOCAL_LEXICAL == $is_lexical;
160 next if not defined $end_line; # Presume search everywhere
161
162 # If we are analyzing something like 'open $fh ...', 'open FH
163 # ...', or 'open *FH ...' we need to use a scope that includes
164 # the end of the legal range. We just give up and return the
165 # current scope if we can not determine any of the locations
166 # involved. RT #64437
167 return $elem if not $open_loc;
168 my $elem_loc = $elem->location
169 or return $elem;
170 my $last_kid = $elem->child( $LAST_ELEMENT )
171 or return $elem; # What? no children?
172 my $last_kid_loc = $last_kid->location
173 or return $elem;
174 # At this point, the scope we have, even if it is not the
175 # correct scope for the file handle, is big enough that if the
176 # corresponding close() is outside it, it must be a violation.
177 # RT #64437
178 return $elem if $last_kid_loc->[0] > $end_line;
179 }
180 return $elem; # Whatever the top-level PPI::Node was.
181}
182
183sub _get_opened_fh {
184 my ($tokens) = shift;
185
186 my $is_lexical;
187 my $fh;
188
189 if ( 2 == @{$tokens} ) {
190 if ('my' eq $tokens->[0] &&
191 $tokens->[1]->isa('PPI::Token::Symbol') &&
192 $SCALAR_SIGIL eq $tokens->[1]->raw_type) {
193
194 $is_lexical = $LOCAL_LEXICAL;
195 $fh = $tokens->[1];
196 }
197 }
198 elsif (1 == @{$tokens}) {
199 my $argument = _unwrap_block( $tokens->[0] );
200 if ( $argument->isa('PPI::Token::Symbol') ) {
201 my $sigil = $argument->raw_type();
202 if ($SCALAR_SIGIL eq $sigil) {
203 $is_lexical = $NON_LOCAL_LEXICAL; # We need to
204 # distinguish between
205 # 'open my $fh ...' and
206 # 'open $fh ...'. RT #64437
207 $fh = $argument;
208 }
209 elsif ($GLOB_SIGIL eq $sigil) {
210 $is_lexical = $NOT_LEXICAL;
211 $fh = $argument;
212 }
213 }
214 elsif ($argument->isa('PPI::Token::Word') && $argument eq uc $argument) {
215 $is_lexical = $NOT_LEXICAL;
216 $fh = $argument;
217 }
218 }
219
220 return ($is_lexical, $fh);
221}
222
223sub _unwrap_block {
224 my ($element) = @_;
225
226 return $element if not $element->isa('PPI::Structure::Block');
227
228 my @children = $element->schildren();
229 return $element if 1 != @children;
230 my $child = $children[0];
231
232 return $child if not $child->isa('PPI::Statement');
233
234 my @grandchildren = $child->schildren();
235 return $element if 1 != @grandchildren;
236
237 return $grandchildren[0];
238}
239
24017µs1;
241
242__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.