Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.pm |
Statements | Executed 19 statements in 462µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 16µs | 16µs | BEGIN@10 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 10µs | 334µs | BEGIN@15 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 8µs | 29µs | BEGIN@16 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 7µs | 28µs | BEGIN@13 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 7µs | 11µs | BEGIN@12 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 7µs | 57µs | BEGIN@18 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 7µs | 18µs | BEGIN@11 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 6µs | 7µs | default_severity | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
1 | 1 | 1 | 5µs | 5µs | supported_parameters | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
0 | 0 | 0 | 0s | 0s | _max_chain_length | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
0 | 0 | 0 | 0s | 0s | applies_to | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
0 | 0 | 0 | 0s | 0s | default_themes | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
0 | 0 | 0 | 0s | 0s | violates | Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::
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::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls; | ||||
9 | |||||
10 | 2 | 40µs | 1 | 16µs | # spent 16µs within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@10 which was called:
# once (16µs+0s) by Module::Pluggable::Object::_require at line 10 # spent 16µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@10 |
11 | 2 | 20µs | 2 | 29µs | # spent 18µs (7+11) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@11 which was called:
# once (7µs+11µs) by Module::Pluggable::Object::_require at line 11 # spent 18µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@11
# spent 11µs making 1 call to strict::import |
12 | 2 | 19µs | 2 | 14µs | # spent 11µs (7+4) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@12 which was called:
# once (7µs+4µs) by Module::Pluggable::Object::_require at line 12 # spent 11µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@12
# spent 4µs making 1 call to warnings::import |
13 | 2 | 26µs | 2 | 49µs | # spent 28µs (7+21) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@13 which was called:
# once (7µs+21µs) by Module::Pluggable::Object::_require at line 13 # spent 28µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@13
# spent 21µs making 1 call to Exporter::import |
14 | |||||
15 | 2 | 25µs | 2 | 657µs | # spent 334µs (10+323) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@15 which was called:
# once (10µs+323µs) by Module::Pluggable::Object::_require at line 15 # spent 334µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@15
# spent 323µs making 1 call to Exporter::import |
16 | 2 | 25µs | 2 | 49µs | # spent 29µs (8+20) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@16 which was called:
# once (8µs+20µs) by Module::Pluggable::Object::_require at line 16 # spent 29µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@16
# spent 20µs making 1 call to Exporter::import |
17 | |||||
18 | 2 | 292µs | 2 | 106µs | # spent 57µs (7+50) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@18 which was called:
# once (7µs+50µs) by Module::Pluggable::Object::_require at line 18 # spent 57µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::BEGIN@18
# spent 50µs making 1 call to base::import |
19 | |||||
20 | 1 | 600ns | our $VERSION = '1.121'; | ||
21 | |||||
22 | #----------------------------------------------------------------------------- | ||||
23 | |||||
24 | 1 | 2µs | 1 | 29µs | Readonly::Scalar my $EXPL => # spent 29µs making 1 call to Readonly::Scalar |
25 | q{Long chains of method calls indicate code that is too tightly coupled}; | ||||
26 | |||||
27 | #----------------------------------------------------------------------------- | ||||
28 | |||||
29 | # spent 5µs within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::supported_parameters which was called:
# once (5µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm | ||||
30 | return ( | ||||
31 | { | ||||
32 | 1 | 8µs | name => 'max_chain_length', | ||
33 | description => 'The number of chained calls to allow.', | ||||
34 | default_string => '3', | ||||
35 | behavior => 'integer', | ||||
36 | integer_minimum => 1, | ||||
37 | }, | ||||
38 | ); | ||||
39 | } | ||||
40 | |||||
41 | 1 | 2µs | # spent 7µs (6+1) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls::default_severity which was called:
# once (6µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm | ||
42 | sub default_themes { return qw( core maintenance ) } | ||||
43 | sub applies_to { return qw{ PPI::Statement }; } | ||||
44 | |||||
45 | #----------------------------------------------------------------------------- | ||||
46 | |||||
47 | sub _max_chain_length { | ||||
48 | my ( $self ) = @_; | ||||
49 | |||||
50 | return $self->{_max_chain_length}; | ||||
51 | } | ||||
52 | |||||
53 | #----------------------------------------------------------------------------- | ||||
54 | |||||
55 | sub violates { | ||||
56 | my ( $self, $elem, undef ) = @_; | ||||
57 | |||||
58 | return if not is_ppi_expression_or_generic_statement($elem); | ||||
59 | |||||
60 | my $chain_length = 0; | ||||
61 | my $max_chain_length = $self->_max_chain_length(); | ||||
62 | my @children = $elem->schildren(); | ||||
63 | my $child = shift @children; | ||||
64 | |||||
65 | while ($child) { | ||||
66 | # if it looks like we've got a subroutine call, drop the parameter | ||||
67 | # list. | ||||
68 | if ( | ||||
69 | $child->isa('PPI::Token::Word') | ||||
70 | and @children | ||||
71 | and $children[0]->isa('PPI::Structure::List') | ||||
72 | ) { | ||||
73 | shift @children; | ||||
74 | } | ||||
75 | |||||
76 | if ( | ||||
77 | $child->isa('PPI::Token::Word') | ||||
78 | or $child->isa('PPI::Token::Symbol') | ||||
79 | ) { | ||||
80 | if ( @children ) { | ||||
81 | if ( $children[0]->isa('PPI::Token::Operator') ) { | ||||
82 | if ( q{->} eq $children[0]->content() ) { | ||||
83 | $chain_length++; | ||||
84 | shift @children; | ||||
85 | } | ||||
86 | } | ||||
87 | elsif ( not $children[0]->isa('PPI::Token::Structure') ) { | ||||
88 | $chain_length = 0; | ||||
89 | } | ||||
90 | } | ||||
91 | } | ||||
92 | else { | ||||
93 | if ($chain_length > $max_chain_length) { | ||||
94 | return | ||||
95 | $self->violation( | ||||
96 | "Found method-call chain of length $chain_length.", | ||||
97 | $EXPL, | ||||
98 | $elem, | ||||
99 | ); | ||||
100 | } | ||||
101 | |||||
102 | $chain_length = 0; | ||||
103 | } | ||||
104 | |||||
105 | $child = shift @children; | ||||
106 | } | ||||
107 | |||||
108 | if ($chain_length > $max_chain_length) { | ||||
109 | return | ||||
110 | $self->violation( | ||||
111 | "Found method-call chain of length $chain_length.", | ||||
112 | $EXPL, | ||||
113 | $elem, | ||||
114 | ); | ||||
115 | } | ||||
116 | |||||
117 | return; | ||||
118 | } | ||||
119 | |||||
120 | |||||
121 | 1 | 3µs | 1; | ||
122 | |||||
123 | __END__ |