| 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__ |