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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/RegularExpressions/ProhibitFixedStringMatches.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::ProhibitFixedStringMatches;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use English qw(-no_match_vars);
  16 use Carp;
  17
  18 use Perl::Critic::Utils qw{ :booleans :severities };
  19 use Perl::Critic::Utils::PPIRegexp qw{ get_match_string get_modifiers };
  20 use base 'Perl::Critic::Policy';
  21
  22 our $VERSION = '1.088';
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Scalar my $DESC => q{Use 'eq' or hash instead of fixed-pattern regexps};
  27 Readonly::Scalar my $EXPL => [271,272];
  28
  29 Readonly::Scalar my $RE_METACHAR => qr/[\\#\$()*+.?\@\[\]^{|}]/xms;
  30
  31 #-----------------------------------------------------------------------------
  32
  33 sub supported_parameters { return qw()                       }
  34 sub default_severity     { return $SEVERITY_LOW              }
  35 sub default_themes       { return qw( core pbp performance ) }
  36 sub applies_to           { return qw(PPI::Token::Regexp::Match
  37                                      PPI::Token::Regexp::Substitute
  38                                      PPI::Token::QuoteLike::Regexp) }
  39
  40 #-----------------------------------------------------------------------------
  41
  42 sub violates {
  43     my ( $self, $elem, undef ) = @_;
  44
  45     my $re = get_match_string($elem);
  46
  47     # only flag regexps that are anchored front and back
  48     if ($re =~ m{\A \s*
  49                  (\\A|\^)  # front anchor == $1
  50                  (.*?)
  51                  (\\z|\$)  # end anchor == $2
  52                  \s* \z}xms) {
  53
  54         my ($front_anchor, $words, $end_anchor) = ($1, $2, $3);
  55
  56         # If it's a multiline match, then end-of-line anchors don't represent the whole string
  57         if ($front_anchor eq q{^} || $end_anchor eq q{$}) {
  58             my %mods = get_modifiers($elem);
  59             return if $mods{m};
  60         }
  61
  62         # check for grouping and optional alternation.  Grouping may or may not capture
  63         if ($words =~ m{\A \s*
  64                         [(]              # start group
  65                           (?:[?]:)?      # optional non-capturing indicator
  66                           \s* (.*?) \s*  # interior of group
  67                         [)]              # end of group
  68                         \s* \z}xms) {
  69             $words = $1;
  70             $words =~ s/[|]//gxms; # ignore alternation inside of parens -- just look at words
  71         }
  72
  73         # Regexps that contain metachars are not fixed strings
  74         return if $words =~ m/$RE_METACHAR/oxms;
  75
  76         return $self->violation( $DESC, $EXPL, $elem );
  77
  78     } else {
  79         return; # OK
  80     }
  81 }
  82
  83 1;
  84
  85 __END__
  86
  87 #-----------------------------------------------------------------------------
  88
  89 =pod
  90
  91 =head1 NAME
  92
  93 Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches - Use C<eq> or hash instead of fixed-pattern regexps.
  94
  95 =head1 AFFILIATION
  96
  97 This Policy is part of the core L<Perl::Critic> distribution.
  98
  99
 100 =head1 DESCRIPTION
 101
 102 A regular expression that matches just a fixed set of constant strings is wasteful
 103 of performance and is hard on maintainers.  It is much more readable and
 104 often faster to use C<eq> or a hash to match such strings.
 105
 106     # Bad
 107     my $is_file_function = $token =~ m/\A (?: open | close | read ) \z/xms;
 108
 109     # Faster and more readable
 110     my $is_file_function = $token eq 'open' ||
 111                            $token eq 'close' ||
 112                            $token eq 'read';
 113
 114 For larger numbers of strings, a hash is superior:
 115
 116     # Bad
 117     my $is_perl_keyword =
 118         $token =~ m/\A (?: chomp | chop | chr | crypt | hex | index
 119                            lc | lcfirst | length | oct | ord | ... ) \z/xms;
 120
 121     # Better
 122     Readonly::Hash my %PERL_KEYWORDS => map {$_ => 1} qw(
 123         chomp chop chr crypt hex index lc lcfirst length oct ord ...
 124     );
 125     my $is_perl_keyword = $PERL_KEYWORD{$token};
 126
 127 =head2 VARIANTS
 128
 129 This policy detects both grouped and non-grouped strings.  The grouping may or
 130 may not be capturing.  The grouped body may or may not be alternating.  C<\A>
 131 and C<\z> are always considered anchoring which C<^> and C<$> are considered
 132 anchoring is the C<m> regexp option is not in use.  Thus, all of these are
 133 violations:
 134
 135     m/^foo$/;
 136     m/\A foo \z/x;
 137     m/\A foo \z/xm;
 138     m/\A(foo)\z/;
 139     m/\A(?:foo)\z/;
 140     m/\A(foo|bar)\z/;
 141     m/\A(?:foo|bar)\z/;
 142
 143 Furthermore, this policy detects violations in C<m//>, C<s///> and C<qr//>
 144 constructs, as you would expect.
 145
 146
 147 =head1 CONFIGURATION
 148
 149 This Policy is not configurable except for the standard options.
 150
 151
 152 =head1 CREDITS
 153
 154 Initial development of this policy was supported by a grant from the Perl Foundation.
 155
 156 =head1 AUTHOR
 157
 158 Chris Dolan <cdolan@cpan.org>
 159
 160 =head1 COPYRIGHT
 161
 162 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 163
 164 This program is free software; you can redistribute it and/or modify
 165 it under the same terms as Perl itself.  The full text of this license
 166 can be found in the LICENSE file included with this module
 167
 168 =cut
 169
 170 # Local Variables:
 171 #   mode: cperl
 172 #   cperl-indent-level: 4
 173 #   fill-column: 78
 174 #   indent-tabs-mode: nil
 175 #   c-indentation-style: bsd
 176 # End:
 177 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :