File Coverage

blib/lib/Perl/Critic/Policy/RegularExpressions/ProhibitFixedStringMatches.pm
Criterion Covered Total %
statement 40 40 100.0
branch 11 12 91.6
condition 2 3 66.6
subroutine 13 13 100.0
pod 4 5 80.0
total 70 73 95.8


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