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