File Coverage

blib/lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormattingExceptForSplit.pm
Criterion Covered Total %
statement 42 42 100.0
branch 10 10 100.0
condition 3 3 100.0
subroutine 13 13 100.0
pod 5 5 100.0
total 73 73 100.0


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::RegularExpressions::RequireExtendedFormattingExceptForSplit;
2              
3             # ABSTRACT: Always use the C</x> modifier with regular expressions, except when the regex is used
4              
5 5     5   901113 use 5.006001;
  5         60  
6 5     5   28 use strict;
  5         11  
  5         105  
7 5     5   25 use warnings;
  5         11  
  5         112  
8 5     5   32 use Readonly;
  5         17  
  5         265  
9              
10 5     5   47 use Perl::Critic::Utils qw{ :severities };
  5         11  
  5         326  
11              
12 5     5   787 use base 'Perl::Critic::Policy';
  5         14  
  5         3051  
13              
14             our $VERSION = '2.05';
15              
16             #-----------------------------------------------------------------------------
17              
18             Readonly::Scalar my $DESC => q{Regular expression without "/x" flag - but not for split};
19             Readonly::Scalar my $EXPL => [ 236 ];
20              
21             #-----------------------------------------------------------------------------
22              
23             sub supported_parameters {
24             return (
25             {
26 16     16 1 3662082 name => 'minimum_regex_length_to_complain_about',
27             description =>
28             q<The number of characters that a regular expression must contain before this policy will complain.>,
29             behavior => 'integer',
30             default_string => '0',
31             integer_minimum => 0,
32             },
33             );
34             }
35              
36 16     16 1 1812407 sub default_severity { return $SEVERITY_MEDIUM }
37 1     1 1 669 sub default_themes { return qw<reneeb> }
38             sub applies_to {
39 5     5 1 108671 return qw<
40             PPI::Token::Regexp::Match
41             PPI::Token::Regexp::Substitute
42             PPI::Token::QuoteLike::Regexp
43             >;
44             }
45              
46             #-----------------------------------------------------------------------------
47              
48             sub violates {
49 23     23 1 1939 my ( $self, $elem, $doc ) = @_;
50              
51 23         106 my $match = $elem->get_match_string();
52              
53 23 100       443 return if $self->{_minimum_regex_length_to_complain_about} >= length $match;
54 18 100       63 return if _is_used_to_split( $elem );
55              
56 12         52 my $re = $doc->ppix_regexp_from_element( $elem );
57 12 100       122612 $re->modifier_asserted( 'x' )
58             or return $self->violation( $DESC, $EXPL, $elem );
59              
60 5         128 return; # ok!;
61             }
62              
63             sub _is_used_to_split {
64 18     18   40 my ($elem) = @_;
65              
66 18         43 my $is_to_split = _elem_has_split_as_sibling( $elem );
67              
68 18 100 100     119 if ( !$is_to_split && $elem->parent->isa( 'PPI::Statement::Expression' ) ) {
69 11         121 my $grandparent = $elem->parent->parent;
70 11         91 $is_to_split = _elem_has_split_as_sibling( $grandparent );
71             }
72              
73 18         77 return $is_to_split;
74             }
75              
76             sub _elem_has_split_as_sibling {
77 29     29   62 my ($elem) = @_;
78              
79 29         52 my $has_sibling;
80 29         126 while ( my $sib = $elem->sprevious_sibling ) {
81 70 100       2096 if ( "$sib" eq 'split' ) {
82 6         32 $has_sibling = 1;
83 6         13 last;
84             }
85              
86 64         409 $elem = $sib;
87             }
88              
89 29         404 return $has_sibling;
90             }
91              
92             1;
93              
94             =pod
95              
96             =encoding UTF-8
97              
98             =head1 NAME
99              
100             Perl::Critic::Policy::RegularExpressions::RequireExtendedFormattingExceptForSplit - Always use the C</x> modifier with regular expressions, except when the regex is used
101              
102             =head1 VERSION
103              
104             version 2.05
105              
106             =head1 DESCRIPTION
107              
108             Extended regular expression formatting allows you mix whitespace and
109             comments into the pattern, thus making them much more readable.
110              
111             # Match a single-quoted string efficiently...
112              
113             m{'[^\\']*(?:\\.[^\\']*)*'}; #Huh?
114              
115             # Same thing with extended format...
116              
117             m{
118             ' # an opening single quote
119             [^\\'] # any non-special chars (i.e. not backslash or single quote)
120             (?: # then all of...
121             \\ . # any explicitly backslashed char
122             [^\\']* # followed by an non-special chars
123             )* # ...repeated zero or more times
124             ' # a closing single quote
125             }x;
126              
127             =head1 CONFIGURATION
128              
129             You might find that putting a C</x> on short regular expressions to be
130             excessive. An exception can be made for them by setting
131             C<minimum_regex_length_to_complain_about> to the minimum match length
132             you'll allow without a C</x>. The length only counts the regular
133             expression, not the braces or operators.
134              
135             [RegularExpressions::RequireExtendedFormatting]
136             minimum_regex_length_to_complain_about = 5
137              
138             $num =~ m<(\d+)>; # ok, only 5 characters
139             $num =~ m<\d\.(\d+)>; # not ok, 9 characters
140              
141             This option defaults to 0.
142              
143             Because using C</x> on a regex which has whitespace in it can make it
144             harder to read (you have to escape all that innocent whitespace), by
145             default, you can have a regular expression that only contains
146             whitespace and word characters without the modifier. If you want to
147             restrict this, turn on the C<strict> option.
148              
149             [RegularExpressions::RequireExtendedFormattingExceptForSplit]
150             strict = 1
151              
152             $string =~ m/Basset hounds got long ears/; # no longer ok
153              
154             This option defaults to false.
155              
156             =head1 METHODS
157              
158             =head2 supported_parameters
159              
160             Currently only one parameter is supported: C<minimum_regex_length_to_complain_about>.
161              
162             Regular expressions that are shorter than this number, no violation is thrown.
163              
164             =head2 default_theme
165              
166             Default theme is C<reneeb>.
167              
168             =head2 default_severity
169              
170             Be default this policy is of medium severity.
171              
172             =head2 applies_to
173              
174             By default this policy applies to
175              
176             =over
177              
178             =item * PPI::Token::Regexp::Match
179              
180             =item * PPI::Token::Regexp::Substitute
181              
182             =item * PPI::Token::QuoteLike::Regexp
183              
184             =back
185              
186             =head1 NOTES
187              
188             For common regular expressions like e-mail addresses, phone numbers,
189             dates, etc., have a look at the L<Regexp::Common|Regexp::Common> module.
190             Also, be cautions about slapping modifier flags onto existing regular
191             expressions, as they can drastically alter their meaning. See
192             L<http://www.perlmonks.org/?node_id=484238> for an interesting
193             discussion on the effects of blindly modifying regular expression
194             flags.
195              
196             =head1 TO DO
197              
198             Add an exemption for regular expressions that contain C<\Q> at the
199             beginning and don't use C<\E> until the very end, if at all.
200              
201             =for Pod::Coverage supported_parameters
202              
203             =head1 AUTHOR
204              
205             Renee Baecker <reneeb@cpan.org>
206              
207             =head1 COPYRIGHT AND LICENSE
208              
209             This software is Copyright (c) 2015 by Renee Baecker.
210              
211             This is free software, licensed under:
212              
213             The Artistic License 2.0 (GPL Compatible)
214              
215             =cut
216              
217             __END__
218              
219             #-----------------------------------------------------------------------------
220              
221