Login
Clean up Schwern's
authorElliot Shank <perl@galumph.com>
Sun, 17 Aug 2008 10:18:21 +0000 (10:18 +0000)
committerElliot Shank <perl@galumph.com>
Sun, 17 Aug 2008 10:18:21 +0000 (10:18 +0000)
RegularExpressions::RequireExtendedFormatting patch. Renamed
the min_regex_length option to
minimum_regex_length_to_complain_about. The way the
allow_with_whitespace was coded, if the regex contained any
whitespace at all, it was exempt. Instead, I made regexes
that only contain word characters and whitespace exempt by
default, and added a strict option.  I'm not so sure about
this one.

Changes
lib/Perl/Critic/Policy/RegularExpressions/RequireExtendedFormatting.pm
t/RegularExpressions/RequireExtendedFormatting.run

diff --git a/Changes b/Changes
index 75e175d..0454c25 100644 (file)
--- a/Changes
+++ b/Changes
@@ -12,6 +12,9 @@
       import arguments of a C<use> statement.  RT #24467.
     * ErrorHandling::RequireCheckingReturnValueOfEval now recognizes
       ternary left-sides as valid checks.
       import arguments of a C<use> statement.  RT #24467.
     * ErrorHandling::RequireCheckingReturnValueOfEval now recognizes
       ternary left-sides as valid checks.
+    * RegularExpressions::RequireExtendedFormatting gains
+      minimum_regex_length_to_complain_about and strict options thanks
+      to Michael Schwern.  RT #38531.
     * TestingAndDebugging/ProhibitNoWarnings now supports a
       allow_with_category_restriction option, thanks to Michael Schwern.
       RT #38514.
     * TestingAndDebugging/ProhibitNoWarnings now supports a
       allow_with_category_restriction option, thanks to Michael Schwern.
       RT #38514.
index 38d54b0..ef1fe23 100644 (file)
@@ -28,27 +28,32 @@ Readonly::Scalar my $EXPL => [ 236 ];
 sub supported_parameters {
     return (
         {
 sub supported_parameters {
     return (
         {
-            name               => 'allow_short_regex',
+            name               => 'minimum_regex_length_to_complain_about',
             description        =>
             description        =>
-                q[Regexes below a given length are ok.],
+                q<The number of characters that a regular expression must contain before this policy will complain.>,
             behavior           => 'integer',
             default_string     => '0',
             integer_minimum    => 0,
         },
         {
             behavior           => 'integer',
             default_string     => '0',
             integer_minimum    => 0,
         },
         {
-            name               => 'allow_with_whitespace',
+            name               => 'strict',
             description        =>
             description        =>
-                q[Regexes with spaces can be harder to read with /x],
+                q<Should regexes that only contain whitespace and word characters be complained about?>,
             behavior           => 'boolean',
             behavior           => 'boolean',
+            default_string     => '0',
         },
     );
 }
 
         },
     );
 }
 
-sub default_severity     { return $SEVERITY_MEDIUM         }
-sub default_themes       { return qw(core pbp maintenance) }
-sub applies_to           { return qw(PPI::Token::Regexp::Match
-                                     PPI::Token::Regexp::Substitute
-                                     PPI::Token::QuoteLike::Regexp) }
+sub default_severity     { return $SEVERITY_MEDIUM           }
+sub default_themes       { return qw< core pbp maintenance > }
+sub applies_to           {
+    return qw<
+        PPI::Token::Regexp::Match
+        PPI::Token::Regexp::Substitute
+        PPI::Token::QuoteLike::Regexp
+    >;
+}
 
 #-----------------------------------------------------------------------------
 
 
 #-----------------------------------------------------------------------------
 
@@ -56,14 +61,15 @@ sub violates {
     my ( $self, $elem, undef ) = @_;
 
     my $match = get_match_string($elem);
     my ( $self, $elem, undef ) = @_;
 
     my $match = get_match_string($elem);
-    return if length $match <= $self->{_allow_short_regex};
-    return if $self->{_allow_with_whitespace} and $match =~ /\s/;
+    return if length $match <= $self->{_minimum_regex_length_to_complain_about};
+    return if not $self->{_strict} and $match =~ m< \A [\s\w]* \z >xms;
 
     my %mods = get_modifiers($elem);
 
     my %mods = get_modifiers($elem);
-    if ( ! $mods{x} ) {
+    if ( not $mods{x} ) {
         return $self->violation( $DESC, $EXPL, $elem );
     }
         return $self->violation( $DESC, $EXPL, $elem );
     }
-    return; #ok!;
+
+    return; # ok!;
 }
 
 1;
 }
 
 1;
@@ -94,39 +100,47 @@ comments into the pattern, thus making them much more readable.
 
     m{'[^\\']*(?:\\.[^\\']*)*'};  #Huh?
 
 
     m{'[^\\']*(?:\\.[^\\']*)*'};  #Huh?
 
-    #Same thing with extended format...
+    # Same thing with extended format...
 
 
-    m{ '           #an opening single quote
-       [^\\']      #any non-special chars (i.e. not backslash or single quote)
-       (?:         #then all of...
-          \\ .     #   any explicitly backslashed char
-          [^\\']*  #   followed by an non-special chars
-       )*          #...repeated zero or more times
-       '           # a closing single quote
-     }x;
+    m{
+        '           # an opening single quote
+        [^\\']      # any non-special chars (i.e. not backslash or single quote)
+        (?:         # then all of...
+            \\ .    #    any explicitly backslashed char
+            [^\\']* #    followed by an non-special chars
+        )*          # ...repeated zero or more times
+        '           # a closing single quote
+    }x;
 
 
 =head1 CONFIGURATION
 
 
 
 =head1 CONFIGURATION
 
-Because using C</x> on a regex which has whitespace in it can make it harder
-to read, you have to escape all that innocent whitespace, you can add an
-exception by turning on C<allow_with_whitespace>.
+You might find that putting a C</x> on short regular expressions to be
+excessive.  An exception can be made for them by setting
+C<minimum_regex_length_to_complain_about> to the minimum match length
+you'll allow without a C</x>.  The length only counts the regular
+expression, not the braces or operators.
 
     [RegularExpressions::RequireExtendedFormatting]
 
     [RegularExpressions::RequireExtendedFormatting]
-    allow_with_whitespace = 1
+    minimum_regex_length_to_complain_about = 5
 
 
-    $string =~ /Basset hounds got long ears/;  # ok
+    $num =~ m<(\d+)>;              # ok, only 5 characters
+    $num =~ m<\d\.(\d+)>;          # not ok, 9 characters
 
 
-You might find that putting a C</x> on short regexes to be excessive.  An
-exception can be made for them by setting C<allow_short_regex> to the minimum
-match length you'll allow without a C</x>.  The length only counts the regular
-expression, not the braces or operators.
+This option defaults to 0.
+
+Because using C</x> on a regex which has whitespace in it can make it
+harder to read (you have to escape all that innocent whitespace), by
+default, you can have a regular expression that only contains
+whitespace and word characters without the modifier.  If you want to
+restrict this, turn on the C<strict> option.
 
     [RegularExpressions::RequireExtendedFormatting]
 
     [RegularExpressions::RequireExtendedFormatting]
-    allow_short_regex = 5
+    strict = 1
+
+    $string =~ m/Basset hounds got long ears/;  # no longer ok
 
 
-    $num =~ m{(\d+)};              # ok, only 5 characters
-    $num =~ m{\d\.(\d+)};          # not ok, 9 characters
+This option defaults to false.
 
 
 =head1 NOTES
 
 
 =head1 NOTES
index d6aa80a..bdada81 100644 (file)
@@ -8,54 +8,66 @@
 ## name basic passes
 ## failures 0
 ## cut
 ## name basic passes
 ## failures 0
 ## cut
-my $string =~ m{pattern}x;
-my $string =~ m{pattern}gimx;
-my $string =~ m{pattern}gixs;
-my $string =~ m{pattern}xgms;
 
 
-my $string =~ m/pattern/x;
-my $string =~ m/pattern/gimx;
-my $string =~ m/pattern/gixs;
-my $string =~ m/pattern/xgms;
+my $string =~ m{pattern};
+my $string =~ m{pattern}gim;
+my $string =~ m{pattern}gis;
+my $string =~ m{pattern}gms;
+
+my $string =~ m{pattern.}x;
+my $string =~ m{pattern.}gimx;
+my $string =~ m{pattern.}gixs;
+my $string =~ m{pattern.}xgms;
+
+my $string =~ m/pattern./x;
+my $string =~ m/pattern./gimx;
+my $string =~ m/pattern./gixs;
+my $string =~ m/pattern./xgms;
 
 
-my $string =~ /pattern/x;
-my $string =~ /pattern/gimx;
-my $string =~ /pattern/gixs;
-my $string =~ /pattern/xgms;
+my $string =~ /pattern./x;
+my $string =~ /pattern./gimx;
+my $string =~ /pattern./gixs;
+my $string =~ /pattern./xgms;
 
 
-my $string =~ s/pattern/foo/x;
-my $string =~ s/pattern/foo/gimx;
-my $string =~ s/pattern/foo/gixs;
-my $string =~ s/pattern/foo/xgms;
+my $string =~ s/pattern./foo/x;
+my $string =~ s/pattern./foo/gimx;
+my $string =~ s/pattern./foo/gixs;
+my $string =~ s/pattern./foo/xgms;
 
 
-my $re =~ qr/pattern/x;
+my $string =~ s/pattern/foo./;
+my $string =~ s/pattern/foo./gim;
+my $string =~ s/pattern/foo./gis;
+my $string =~ s/pattern/foo./gms;
+
+my $re =~ qr/pattern./x;
 
 #-----------------------------------------------------------------------------
 
 ## name basic failures
 ## failures 17
 ## cut
 
 #-----------------------------------------------------------------------------
 
 ## name basic failures
 ## failures 17
 ## cut
-my $string =~ m{pattern};
-my $string =~ m{pattern}gim;
-my $string =~ m{pattern}gis;
-my $string =~ m{pattern}gms;
 
 
-my $string =~ m/pattern/;
-my $string =~ m/pattern/gim;
-my $string =~ m/pattern/gis;
-my $string =~ m/pattern/gms;
+my $string =~ m{pattern.};
+my $string =~ m{pattern.}gim;
+my $string =~ m{pattern.}gis;
+my $string =~ m{pattern.}gms;
 
 
-my $string =~ /pattern/;
-my $string =~ /pattern/gim;
-my $string =~ /pattern/gis;
-my $string =~ /pattern/gms;
+my $string =~ m/pattern./;
+my $string =~ m/pattern./gim;
+my $string =~ m/pattern./gis;
+my $string =~ m/pattern./gms;
 
 
-my $string =~ s/pattern/foo/;
-my $string =~ s/pattern/foo/gim;
-my $string =~ s/pattern/foo/gis;
-my $string =~ s/pattern/foo/gms;
+my $string =~ /pattern./;
+my $string =~ /pattern./gim;
+my $string =~ /pattern./gis;
+my $string =~ /pattern./gms;
 
 
-my $re =~ qr/pattern/;
+my $string =~ s/pattern./foo/;
+my $string =~ s/pattern./foo/gim;
+my $string =~ s/pattern./foo/gis;
+my $string =~ s/pattern./foo/gms;
+
+my $re =~ qr/pattern./;
 
 #-----------------------------------------------------------------------------
 
 
 #-----------------------------------------------------------------------------
 
@@ -77,55 +89,42 @@ my $string =~ y/[A-Z]/[a-z]/cds;
 
 #-----------------------------------------------------------------------------
 
 
 #-----------------------------------------------------------------------------
 
-## name allow_short_regex, pass
+## name minimum_regex_length_to_complain_about, pass
 ## failures 0
 ## failures 0
-## parms { allow_short_regex => 5 }
+## parms { minimum_regex_length_to_complain_about => 5 }
 ## cut
 
 ## cut
 
-my $string =~ m/foo/;
+my $string =~ m/foo./;
 
 
-my $string =~ s/foo//;
-my $string =~ s/foo/bar/;
-my $string =~ s/foo/barbarbar/;
-my $string =~ s/12345//;
+my $string =~ s/foo.//;
+my $string =~ s/foo./bar/;
+my $string =~ s/foo./barbarbar/;
+my $string =~ s/1234.//;
 
 
 #-----------------------------------------------------------------------------
 
 
 
 #-----------------------------------------------------------------------------
 
-## name allow_short_regex, fail
+## name minimum_regex_length_to_complain_about, fail
 ## failures 2
 ## failures 2
-## parms { allow_short_regex => 5 }
-## cut
-
-my $string =~ m/foofoo/;
-
-my $string =~ s/foofoo//;
-
-
-#-----------------------------------------------------------------------------
-
-## name allow_with_whitespace, pass
-## failures 0
-## parms { allow_with_whitespace => 1 }
+## parms { minimum_regex_length_to_complain_about => 5 }
 ## cut
 
 ## cut
 
-my $string =~ m/foo bar/;
+my $string =~ m/fooba./;
 
 
-my $string =~ s/foo bar//;
+my $string =~ s/fooba.//;
 
 
 #-----------------------------------------------------------------------------
 
 
 
 #-----------------------------------------------------------------------------
 
-## name allow_with_whitespace, fail
+## name strict
 ## failures 2
 ## failures 2
-## parms { allow_with_whitespace => 1 }
+## parms { strict => 1 }
 ## cut
 
 my $string =~ m/foobar/;
 
 my $string =~ s/foobar/foo bar/;
 
 ## cut
 
 my $string =~ m/foobar/;
 
 my $string =~ s/foobar/foo bar/;
 
-
 #-----------------------------------------------------------------------------
 # Local Variables:
 #   mode: cperl
 #-----------------------------------------------------------------------------
 # Local Variables:
 #   mode: cperl