vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/RegularExpressions/ProhibitCaptureWithoutTest.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/RegularExpressions/ProhibitCaptureWithoutTest.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :severities };
  16 use base 'Perl::Critic::Policy';
  17
  18 our $VERSION = '1.088';
  19
  20 #-----------------------------------------------------------------------------
  21
  22 Readonly::Scalar my $DESC => q{Capture variable used outside conditional};
  23 Readonly::Scalar my $EXPL => [ 253 ];
  24
  25 #-----------------------------------------------------------------------------
  26
  27 sub supported_parameters { return ()                       }
  28 sub default_severity     { return $SEVERITY_MEDIUM         }
  29 sub default_themes       { return qw(core pbp maintenance) }
  30 sub applies_to           { return 'PPI::Token::Magic'      }
  31
  32 #-----------------------------------------------------------------------------
  33
  34 sub violates {
  35     my ($self, $elem, $doc) = @_;
  36     return if $elem !~ m/\A \$[1-9] \z/mx;
  37     return if _is_in_conditional_expression($elem);
  38     return if _is_in_conditional_structure($elem);
  39     return $self->violation( $DESC, $EXPL, $elem );
  40 }
  41
  42 sub _is_in_conditional_expression {
  43     my $elem = shift;
  44
  45     # simplistic check: is there one of qw(&& || ?) between a match and the capture var?
  46     my $psib = $elem->sprevious_sibling;
  47     while ($psib) {
  48         if ($psib->isa('PPI::Token::Operator')) {
  49             my $op = $psib->content;
  50             if ($op eq q{&&} || $op eq q{||} || $op eq q{?}) {
  51                 $psib = $psib->sprevious_sibling;
  52                 while ($psib) {
  53                     return 1 if ($psib->isa('PPI::Token::Regexp::Match'));
  54                     return 1 if ($psib->isa('PPI::Token::Regexp::Substitute'));
  55                     $psib = $psib->sprevious_sibling;
  56                 }
  57                 return; # false
  58             }
  59         }
  60         $psib = $psib->sprevious_sibling;
  61     }
  62
  63     return; # false
  64 }
  65
  66 sub _is_in_conditional_structure {
  67     my $elem = shift;
  68
  69     my $stmt = $elem->statement();
  70     while ($stmt && $elem->isa('PPI::Statement::Expression')) {
  71        #return if _is_in_conditional_expression($stmt);
  72        $stmt = $stmt->statement();
  73     }
  74     return if !$stmt;
  75
  76     # Check if any previous statements in the same scope have regexp matches
  77     my $psib = $stmt->sprevious_sibling;
  78     while ($psib) {
  79         if ($psib->isa('PPI::Node')) {  # skip tokens
  80             return if $psib->find_any('PPI::Token::Regexp::Match'); # fail
  81             return if $psib->find_any('PPI::Token::Regexp::Substitute'); # fail
  82         }
  83         $psib = $psib->sprevious_sibling;
  84     }
  85
  86     # Check for an enclosing 'if', 'unless', 'endif', or 'else'
  87     my $parent = $stmt->parent;
  88     while ($parent) { # never false as long as we're inside a PPI::Document
  89         if ($parent->isa('PPI::Statement::Compound')) {
  90             return 1;
  91         }
  92         elsif ($parent->isa('PPI::Structure')) {
  93            return 1 if _is_in_conditional_expression($parent);
  94            return 1 if _is_in_conditional_structure($parent);
  95            $parent = $parent->parent;
  96         }
  97         else {
  98            last;
  99         }
 100     }
 101
 102     return; # fail
 103 }
 104
 105 1;
 106
 107 #-----------------------------------------------------------------------------
 108
 109 __END__
 110
 111 =pod
 112
 113 =head1 NAME
 114
 115 Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest - Capture variable used outside conditional.
 116
 117 =head1 AFFILIATION
 118
 119 This Policy is part of the core L<Perl::Critic> distribution.
 120
 121
 122 =head1 DESCRIPTION
 123
 124 If a regexp match fails, then any capture variables (C<$1>, C<$2>,
 125 ...) will be undefined.  Therefore it's important to check the return
 126 value of a match before using those variables.
 127
 128 This policy checks that capture variables are inside a
 129 conditional and do not follow an regexps.
 130
 131 This policy does not check whether that conditional is actually
 132 testing a regexp result, nor does it check whether a regexp actually
 133 has a capture in it.  Those checks are too hard.
 134
 135
 136 =head1 CONFIGURATION
 137
 138 This Policy is not configurable except for the standard options.
 139
 140
 141 =head1 AUTHOR
 142
 143 Chris Dolan <cdolan@cpan.org>
 144
 145 =head1 COPYRIGHT
 146
 147 Copyright (C) 2006 Chris Dolan.  All rights reserved.
 148
 149 This program is free software; you can redistribute it and/or modify
 150 it under the same terms as Perl itself.
 151
 152 =cut
 153
 154 # Local Variables:
 155 #   mode: cperl
 156 #   cperl-indent-level: 4
 157 #   fill-column: 78
 158 #   indent-tabs-mode: nil
 159 #   c-indentation-style: bsd
 160 # End:
 161 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :