← 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/ProhibitManyArgs.pm
StatementsExecuted 30 statements in 659µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11115µs15µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@10Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@10
11114µs39µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@16Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@16
11110µs395µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@18Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@18
1118µs41µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@19Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@19
1118µs18µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@11Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@11
1117µs27µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@13Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@13
1117µs3.10msPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@17Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@17
1117µs196µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@21Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@21
1117µs10µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@12Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@12
1117µs55µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@22Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@22
1116µs6µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::BEGIN@15Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@15
1116µs7µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::default_severityPerl::Critic::Policy::Subroutines::ProhibitManyArgs::default_severity
1114µs4µsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::supported_parametersPerl::Critic::Policy::Subroutines::ProhibitManyArgs::supported_parameters
0000s0sPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::_count_argsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::_count_args
0000s0sPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::_count_list_elementsPerl::Critic::Policy::Subroutines::ProhibitManyArgs::_count_list_elements
0000s0sPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::applies_toPerl::Critic::Policy::Subroutines::ProhibitManyArgs::applies_to
0000s0sPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::default_themesPerl::Critic::Policy::Subroutines::ProhibitManyArgs::default_themes
0000s0sPerl::Critic::Policy::Subroutines::ProhibitManyArgs::::violatesPerl::Critic::Policy::Subroutines::ProhibitManyArgs::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::ProhibitManyArgs;
9
10238µs115µs
# spent 15µs within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@10 which was called: # once (15µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
11219µs229µs
# spent 18µs (8+11) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@11 which was called: # once (8µs+11µs) by Module::Pluggable::Object::_require at line 11
use strict;
# spent 18µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@11 # spent 11µs making 1 call to strict::import
12217µs214µs
# spent 10µs (7+3) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@12 which was called: # once (7µs+3µs) by Module::Pluggable::Object::_require at line 12
use warnings;
# spent 10µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@12 # spent 4µs making 1 call to warnings::import
13219µs247µs
# spent 27µs (7+20) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::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::Subroutines::ProhibitManyArgs::BEGIN@13 # spent 20µs making 1 call to Exporter::import
14
15221µs16µs
# spent 6µs within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@15 which was called: # once (6µs+0s) by Module::Pluggable::Object::_require at line 15
use File::Spec;
16222µs247µs
# spent 39µs (14+25) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@16 which was called: # once (14µs+25µs) by Module::Pluggable::Object::_require at line 16
use List::Util qw(first);
# spent 39µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@16 # spent 8µs making 1 call to List::Util::import
17227µs26.20ms
# spent 3.10ms (7µs+3.10) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@17 which was called: # once (7µs+3.10ms) by Module::Pluggable::Object::_require at line 17
use List::MoreUtils qw(uniq any);
# spent 3.10ms making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@17 # spent 3.10ms making 1 call to Exporter::Tiny::import
18225µs2780µs
# spent 395µs (10+385) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@18 which was called: # once (10µs+385µs) by Module::Pluggable::Object::_require at line 18
use English qw(-no_match_vars);
# spent 395µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@18 # spent 385µs making 1 call to English::import
19225µs273µs
# spent 41µs (8+32) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@19 which was called: # once (8µs+32µs) by Module::Pluggable::Object::_require at line 19
use Carp;
# spent 41µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@19 # spent 32µs making 1 call to Exporter::import
20
21223µs2385µs
# spent 196µs (7+189) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@21 which was called: # once (7µs+189µs) by Module::Pluggable::Object::_require at line 21
use Perl::Critic::Utils qw{ :booleans :severities split_nodes_on_comma };
# spent 196µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@21 # spent 189µs making 1 call to Exporter::import
222405µs2103µs
# spent 55µs (7+48) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@22 which was called: # once (7µs+48µs) by Module::Pluggable::Object::_require at line 22
use base 'Perl::Critic::Policy';
# spent 55µs making 1 call to Perl::Critic::Policy::Subroutines::ProhibitManyArgs::BEGIN@22 # spent 48µs making 1 call to base::import
23
241600nsour $VERSION = '1.121';
25
26#-----------------------------------------------------------------------------
27
2812µs129µsReadonly::Scalar my $AT => q{@};
# spent 29µs making 1 call to Readonly::Scalar
2911µs121µsReadonly::Scalar my $AT_ARG => q{@_}; ## no critic (InterpolationOfMetachars)
# spent 21µs making 1 call to Readonly::Scalar
30
3111µs120µsReadonly::Scalar my $DESC => q{Too many arguments};
# spent 20µs making 1 call to Readonly::Scalar
3212µs140µsReadonly::Scalar my $EXPL => [182];
# spent 40µs making 1 call to Readonly::Scalar
33
34#-----------------------------------------------------------------------------
35
36
# spent 4µs within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::supported_parameters which was called: # once (4µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
37 return (
38 {
3917µs name => 'max_arguments',
40 description =>
41 'The maximum number of arguments to allow a subroutine to have.',
42 default_string => '5',
43 behavior => 'integer',
44 integer_minimum => 1,
45 },
46 );
47}
48
4912µs
# spent 7µs (6+1) within Perl::Critic::Policy::Subroutines::ProhibitManyArgs::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 }
50sub default_themes { return qw( core pbp maintenance ) }
51sub applies_to { return 'PPI::Statement::Sub' }
52
53#-----------------------------------------------------------------------------
54
55sub violates {
56 my ( $self, $elem, undef ) = @_;
57
58 # forward declaration?
59 return if !$elem->block;
60
61 my $num_args;
62 if ($elem->prototype) {
63 my $prototype = $elem->prototype();
64 $prototype =~ s/ \\ [[] .*? []] /*/smxg; # Allow for grouping
65 $num_args = $prototype =~ tr/$@%&*_+/$@%&*_+/; # RT 56627
66 } else {
67 $num_args = _count_args($elem->block->schildren);
68 }
69
70 if ($self->{_max_arguments} < $num_args) {
71 return $self->violation( $DESC, $EXPL, $elem );
72 }
73 return; # OK
74}
75
76sub _count_args {
77 my @statements = @_;
78
79 # look for these patterns:
80 # " ... = @_;" => then examine previous variable list
81 # " ... = shift;" => counts as one arg, then look for more
82
83 return 0 if !@statements; # no statements
84
85 my $statement = shift @statements;
86 my @elements = $statement->schildren();
87 my $operand = pop @elements;
88 while ($operand && $operand->isa('PPI::Token::Structure') && q{;} eq $operand) {
89 $operand = pop @elements;
90 }
91 return 0 if !$operand;
92
93 #print "pulled off last, remaining: '@elements'\n";
94 my $operator = pop @elements;
95 return 0 if !$operator;
96 return 0 if !$operator->isa('PPI::Token::Operator');
97 return 0 if q{=} ne $operator;
98
99 if ($operand->isa('PPI::Token::Magic') && $AT_ARG eq $operand) {
100 return _count_list_elements(@elements);
101 } elsif ($operand->isa('PPI::Token::Word') && 'shift' eq $operand) {
102 return 1 + _count_args(@statements);
103 }
104
105 return 0;
106}
107
108sub _count_list_elements {
109 my @elements = @_;
110
111 my $list = pop @elements;
112 return 0 if !$list;
113 return 0 if !$list->isa('PPI::Structure::List');
114 my @inner = $list->schildren;
115 if (1 == @inner && $inner[0]->isa('PPI::Statement::Expression')) {
116 @inner = $inner[0]->schildren;
117 }
118 return scalar split_nodes_on_comma(@inner);
119}
120
12114µs1;
122
123__END__