| 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 | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::supported_parameters |
| 1 | 1 | 1 | 16µs | 16µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@10 |
| 1 | 1 | 1 | 9µs | 28µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@23 |
| 1 | 1 | 1 | 8µs | 26µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@22 |
| 1 | 1 | 1 | 8µs | 380µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@16 |
| 1 | 1 | 1 | 8µs | 40µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@14 |
| 1 | 1 | 1 | 7µs | 388µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@15 |
| 1 | 1 | 1 | 7µs | 37µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@17 |
| 1 | 1 | 1 | 7µs | 18µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 11µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@12 |
| 1 | 1 | 1 | 7µs | 56µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::BEGIN@25 |
| 1 | 1 | 1 | 6µs | 7µs | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::default_severity |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::__ANON__[:158] |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::_get_simple_statement |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::_validate_fully_qualified_symbols |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::applies_to |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::default_themes |
| 0 | 0 | 0 | 0s | 0s | Perl::Critic::Policy::ValuesAndExpressions::ProhibitComplexVersion::violates |
| 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__ |