Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/ValuesAndExpressions/ProhibitComplexVersion.pm |
Statements | Executed 29 statements in 853µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 16µs | 19µs | supported_parameters | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 16µs | 16µs | BEGIN@10 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 9µs | 28µs | BEGIN@23 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 8µs | 26µs | BEGIN@22 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 8µs | 380µs | BEGIN@16 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 8µs | 40µs | BEGIN@14 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 7µs | 388µs | BEGIN@15 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 7µs | 37µs | BEGIN@17 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 7µs | 18µs | BEGIN@11 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 7µs | 11µs | BEGIN@12 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 7µs | 56µs | BEGIN@25 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
1 | 1 | 1 | 6µs | 7µs | default_severity | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | __ANON__[:158] | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | _get_simple_statement | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | _validate_fully_qualified_symbols | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | applies_to | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | default_themes | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
0 | 0 | 0 | 0s | 0s | violates | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::
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::ProhibitComplexVersion; | ||||
9 | |||||
10 | 2 | 44µs | 1 | 16µs | # spent 16µs within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::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::ProhibitComplexVersion::BEGIN@10 |
11 | 2 | 25µs | 2 | 30µs | # spent 18µs (7+11) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::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::ProhibitComplexVersion::BEGIN@11
# spent 11µs making 1 call to strict::import |
12 | 2 | 18µs | 2 | 15µs | # spent 11µs (7+4) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::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::ProhibitComplexVersion::BEGIN@12
# spent 4µs making 1 call to warnings::import |
13 | |||||
14 | 2 | 22µs | 2 | 73µs | # spent 40µs (8+33) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@14 which was called:
# once (8µs+33µs) by Module::Pluggable::Object::_require at line 14 # spent 40µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@14
# spent 33µs making 1 call to Exporter::import |
15 | 2 | 36µs | 2 | 769µs | # spent 388µs (7+381) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@15 which was called:
# once (7µs+381µs) by Module::Pluggable::Object::_require at line 15 # spent 388µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@15
# spent 381µs making 1 call to English::import |
16 | 2 | 27µs | 2 | 752µs | # spent 380µs (8+372) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@16 which was called:
# once (8µs+372µs) by Module::Pluggable::Object::_require at line 16 # spent 380µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@16
# spent 372µs making 1 call to Exporter::import |
17 | 1 | 400ns | # spent 37µs (7+29) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@17 which was called:
# once (7µs+29µs) by Module::Pluggable::Object::_require at line 21 | ||
18 | get_next_element_in_same_simple_statement | ||||
19 | get_previous_module_used_on_same_line | ||||
20 | is_ppi_simple_statement | ||||
21 | 1 | 37µs | 2 | 66µs | }; # spent 37µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@17
# spent 29µs making 1 call to Exporter::import |
22 | 2 | 21µs | 2 | 45µs | # spent 26µs (8+18) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@22 which was called:
# once (8µs+18µs) by Module::Pluggable::Object::_require at line 22 # spent 26µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@22
# spent 18µs making 1 call to Exporter::import |
23 | 2 | 23µs | 2 | 47µs | # spent 28µs (9+19) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@23 which was called:
# once (9µs+19µs) by Module::Pluggable::Object::_require at line 23 # spent 28µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@23
# spent 19µs making 1 call to Exporter::import |
24 | |||||
25 | 2 | 570µs | 2 | 104µs | # spent 56µs (7+49) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@25 which was called:
# once (7µs+49µs) by Module::Pluggable::Object::_require at line 25 # spent 56µs making 1 call to Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@25
# spent 49µs making 1 call to base::import |
26 | |||||
27 | 1 | 600ns | our $VERSION = '1.121'; | ||
28 | |||||
29 | #----------------------------------------------------------------------------- | ||||
30 | |||||
31 | 1 | 2µs | 1 | 30µs | Readonly::Scalar my $DOLLAR => q<$>; # spent 30µs making 1 call to Readonly::Scalar |
32 | # All uses of the $DOLLAR variable below are to prevent false failures in | ||||
33 | # xt/author/93_version.t. | ||||
34 | 1 | 900ns | 1 | 21µs | Readonly::Scalar my $VERSION_MODULE => q<version>; # spent 21µs making 1 call to Readonly::Scalar |
35 | 1 | 3µs | 2 | 22µs | Readonly::Scalar my $VERSION_VARIABLE => $DOLLAR . q<VERSION>; # spent 20µs making 1 call to Readonly::Scalar
# spent 2µs making 1 call to Readonly::Scalar::FETCH |
36 | |||||
37 | 1 | 3µs | 2 | 22µs | Readonly::Scalar my $DESC => # spent 20µs making 1 call to Readonly::Scalar
# spent 1µs making 1 call to Readonly::Scalar::FETCH |
38 | $DOLLAR . q<VERSION value should not come from outside module>; | ||||
39 | 1 | 1µs | 1 | 20µs | Readonly::Scalar my $EXPL => # spent 20µs making 1 call to Readonly::Scalar |
40 | q<If the version comes from outside the module, you can get everything from unexpected version changes to denial-of-service attacks.>; | ||||
41 | |||||
42 | #----------------------------------------------------------------------------- | ||||
43 | |||||
44 | # spent 19µs (16+3) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::supported_parameters which was called:
# once (16µs+3µs) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm | ||||
45 | { | ||||
46 | 1 | 12µs | 3 | 3µs | name => 'forbid_use_version', # spent 3µs making 3 calls to Readonly::Scalar::FETCH, avg 1µs/call |
47 | description => | ||||
48 | qq<Make "use version; our ${DOLLAR}VERSION = qv('1.2.3');" a violation of this policy.>, | ||||
49 | default_string => $FALSE, | ||||
50 | behavior => 'boolean', | ||||
51 | }, | ||||
52 | ); | ||||
53 | } | ||||
54 | 1 | 2µs | # spent 7µs (6+1) within Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::default_severity which was called:
# once (6µs+1µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm | ||
55 | sub default_themes { return qw( core maintenance ) } | ||||
56 | sub applies_to { return 'PPI::Token::Symbol' } | ||||
57 | |||||
58 | #----------------------------------------------------------------------------- | ||||
59 | |||||
60 | sub violates { | ||||
61 | my ( $self, $elem, $doc ) = @_; | ||||
62 | |||||
63 | # Any variable other than $VERSION is ignored. | ||||
64 | return if $VERSION_VARIABLE ne $elem->content(); | ||||
65 | |||||
66 | # We are only interested in assignments to $VERSION, but it might be a | ||||
67 | # list assignment, so if we do not find an assignment, we move up the | ||||
68 | # parse tree. If we hit a statement (or no parent at all) we do not | ||||
69 | # understand the code to be an assignment statement, and we simply return. | ||||
70 | my $operator; | ||||
71 | return if | ||||
72 | not $operator = get_next_element_in_same_simple_statement( $elem ) | ||||
73 | or $EQUAL ne $operator; | ||||
74 | |||||
75 | # Find the simple statement we are in. If we can not find it, abandon the | ||||
76 | # attempt to analyze the code. | ||||
77 | my $statement = $self->_get_simple_statement( $elem ) | ||||
78 | or return; | ||||
79 | |||||
80 | # Check all symbols in the statement for violation. | ||||
81 | my $exception; | ||||
82 | return $exception if | ||||
83 | $exception = | ||||
84 | $self->_validate_fully_qualified_symbols($elem, $statement, $doc); | ||||
85 | |||||
86 | # At this point we have found no data that is explicitly from outside the | ||||
87 | # file. If the author wants to use a $VERSION from another module, _and_ | ||||
88 | # wants MM->parse_version to understand it, the other module must be used | ||||
89 | # on the same line. So we assume no violation unless this has been done. | ||||
90 | my $module = get_previous_module_used_on_same_line( $elem ) | ||||
91 | or return; | ||||
92 | |||||
93 | # We make an exception for 'use version' unless configured otherwise; so | ||||
94 | # let it be written, so let it be done. | ||||
95 | return if $module eq $VERSION_MODULE and not $self->{_forbid_use_version}; | ||||
96 | |||||
97 | # We assume nefarious intent if we have any other module used on the same | ||||
98 | # line as the $VERSION assignment. | ||||
99 | return $self->violation( $DESC, $EXPL, $elem ); | ||||
100 | } | ||||
101 | |||||
102 | #----------------------------------------------------------------------------- | ||||
103 | |||||
104 | # Return the simple statement that contains our element. The classification | ||||
105 | # done by is_ppi_simple_statement is not quite good enough in this case -- if | ||||
106 | # our parent is a PPI::Structure::List, we want to keep looking. | ||||
107 | |||||
108 | sub _get_simple_statement { | ||||
109 | my ( $self, $elem ) = @_; | ||||
110 | |||||
111 | my $statement = $elem; | ||||
112 | |||||
113 | while ( $statement) { | ||||
114 | my $parent; | ||||
115 | if ( is_ppi_simple_statement( $statement ) ) { | ||||
116 | return $statement if | ||||
117 | not $parent = $statement->parent() | ||||
118 | or not $parent->isa( 'PPI::Structure::List' ); | ||||
119 | $statement = $parent; | ||||
120 | } else { | ||||
121 | $statement = $statement->parent(); | ||||
122 | } | ||||
123 | } | ||||
124 | |||||
125 | return; | ||||
126 | } | ||||
127 | |||||
128 | #----------------------------------------------------------------------------- | ||||
129 | |||||
130 | sub _validate_fully_qualified_symbols { | ||||
131 | my ( $self, $elem, $statement, $doc ) = @_; | ||||
132 | |||||
133 | # Find the package(s) in this file. | ||||
134 | my %local_package = | ||||
135 | map { $_->schild( 1 ) => 1 } | ||||
136 | @{ $doc->find( 'PPI::Statement::Package' ) || [] }; | ||||
137 | $local_package{main} = 1; # For completeness. | ||||
138 | |||||
139 | # Check all symbols in the statement for violation. | ||||
140 | foreach my $symbol ( | ||||
141 | @{ $statement->find( 'PPI::Token::Symbol' ) || [] } | ||||
142 | ) { | ||||
143 | if ( $symbol->canonical() =~ m< \A [@\$%&] ([\w:]*) :: >smx ) { | ||||
144 | $local_package{ $1 } | ||||
145 | or return $self->violation( $DESC, $EXPL, $elem ); | ||||
146 | } | ||||
147 | } | ||||
148 | |||||
149 | # Check all interpolatable strings in the statement for violation. | ||||
150 | # TODO this does not correctly handle "@{[some_expression()]}". | ||||
151 | foreach my $string ( | ||||
152 | @{ | ||||
153 | $statement->find( | ||||
154 | sub { | ||||
155 | return | ||||
156 | $_[1]->isa('PPI::Token::Quote::Double') | ||||
157 | || $_[1]->isa('PPI::Token::Quote::Interpolate'); | ||||
158 | } | ||||
159 | ) | ||||
160 | or [] | ||||
161 | } | ||||
162 | ) { | ||||
163 | my $unquoted = $string->string(); | ||||
164 | while ( | ||||
165 | $unquoted =~ | ||||
166 | m< | ||||
167 | (?: \A | [^\\] ) | ||||
168 | (?: \\{2} )* | ||||
169 | [@\$] | ||||
170 | [{]? | ||||
171 | ([\w:]*) | ||||
172 | :: | ||||
173 | >gsmx | ||||
174 | ) { | ||||
175 | next if $local_package{ $1 }; | ||||
176 | |||||
177 | return $self->violation( $DESC, $EXPL, $elem ); | ||||
178 | } | ||||
179 | } | ||||
180 | |||||
181 | # Check all words in the statement for violation. | ||||
182 | foreach my $symbol ( @{ $statement->find( 'PPI::Token::Word' ) || [] } ) { | ||||
183 | if ( $symbol->content() =~ m/ \A ([\w:]*) :: /smx ) { | ||||
184 | return $self->violation( $DESC, $EXPL, $elem ) | ||||
185 | if not $local_package{ $1 }; | ||||
186 | } | ||||
187 | } | ||||
188 | |||||
189 | return; | ||||
190 | } | ||||
191 | |||||
192 | 1 | 4µs | 1; | ||
193 | |||||
194 | __END__ |