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) $
6 ##############################################################################
8 package Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches;
15 use English qw(-no_match_vars);
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';
22 our $VERSION = '1.088';
24 #-----------------------------------------------------------------------------
26 Readonly::Scalar my $DESC => q{Use 'eq' or hash instead of fixed-pattern regexps};
27 Readonly::Scalar my $EXPL => [271,272];
29 Readonly::Scalar my $RE_METACHAR => qr/[\\#\$()*+.?\@\[\]^{|}]/xms;
31 #-----------------------------------------------------------------------------
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) }
40 #-----------------------------------------------------------------------------
43 my ( $self, $elem, undef ) = @_;
45 my $re = get_match_string($elem);
47 # only flag regexps that are anchored front and back
49 (\\A|\^) # front anchor == $1
51 (\\z|\$) # end anchor == $2
54 my ($front_anchor, $words, $end_anchor) = ($1, $2, $3);
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);
62 # check for grouping and optional alternation. Grouping may or may not capture
63 if ($words =~ m{\A \s*
65 (?:[?]:)? # optional non-capturing indicator
66 \s* (.*?) \s* # interior of group
70 $words =~ s/[|]//gxms; # ignore alternation inside of parens -- just look at words
73 # Regexps that contain metachars are not fixed strings
74 return if $words =~ m/$RE_METACHAR/oxms;
76 return $self->violation( $DESC, $EXPL, $elem );
87 #-----------------------------------------------------------------------------
93 Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches - Use C<eq> or hash instead of fixed-pattern regexps.
97 This Policy is part of the core L<Perl::Critic> distribution.
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.
107 my $is_file_function = $token =~ m/\A (?: open | close | read ) \z/xms;
109 # Faster and more readable
110 my $is_file_function = $token eq 'open' ||
114 For larger numbers of strings, a hash is superior:
117 my $is_perl_keyword =
118 $token =~ m/\A (?: chomp | chop | chr | crypt | hex | index
119 lc | lcfirst | length | oct | ord | ... ) \z/xms;
122 Readonly::Hash my %PERL_KEYWORDS => map {$_ => 1} qw(
123 chomp chop chr crypt hex index lc lcfirst length oct ord ...
125 my $is_perl_keyword = $PERL_KEYWORD{$token};
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
143 Furthermore, this policy detects violations in C<m//>, C<s///> and C<qr//>
144 constructs, as you would expect.
149 This Policy is not configurable except for the standard options.
154 Initial development of this policy was supported by a grant from the Perl Foundation.
158 Chris Dolan <cdolan@cpan.org>
162 Copyright (c) 2007-2008 Chris Dolan. Many rights reserved.
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
172 # cperl-indent-level: 4
174 # indent-tabs-mode: nil
175 # c-indentation-style: bsd
177 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :