Login
Implement RegularExpressions::RequireDotMatchAnything.
authorElliot Shank <perl@galumph.com>
Fri, 22 Aug 2008 01:43:08 +0000 (01:43 +0000)
committerElliot Shank <perl@galumph.com>
Fri, 22 Aug 2008 01:43:08 +0000 (01:43 +0000)
Changes
TODO.pod
lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm [new file with mode: 0644]
t/RegularExpressions/RequireDotMatchAnything.run [new file with mode: 0644]

diff --git a/Changes b/Changes
index d9894c7..0444945 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 [1.???] Released on 2008-??-??
 
     New Policies:
+    * RegularExpressions::RequireDotMatchAnything
     * ValuesAndExpressions::RequireConstantOnLeftSideOfEquality -- In
       case you accidentally say "if ($foo = 42) {...}"
 
index 767d379..bfc1442 100644 (file)
--- a/TODO.pod
+++ b/TODO.pod
@@ -205,8 +205,6 @@ Check for -w on the shbang line.
 
 =item * Modules::RequireThreePartVersion [405-406]
 
-=item * RegularExpressions::RequireDotMatchAnything [240-241]
-
 =back
 
 
diff --git a/lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm b/lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm
new file mode 100644 (file)
index 0000000..a262396
--- /dev/null
@@ -0,0 +1,115 @@
+##############################################################################
+#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/RegularExpressions/RequireDotMatchAnything.pm $
+#     $Date: 2008-07-22 06:47:03 -0700 (Tue, 22 Jul 2008) $
+#   $Author: clonezone $
+# $Revision: 2609 $
+##############################################################################
+
+package Perl::Critic::Policy::RegularExpressions::RequireDotMatchAnything;
+
+use 5.006001;
+use strict;
+use warnings;
+
+use Readonly;
+
+use Perl::Critic::Utils qw{ :severities };
+use Perl::Critic::Utils::PPIRegexp qw{ &get_modifiers };
+
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.090';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Scalar my $DESC => q{Regular expression without "/s" flag};
+Readonly::Scalar my $EXPL => [ 240, 241 ];
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters { return ()                    }
+sub default_severity     { return $SEVERITY_LOW         }
+sub default_themes       { return qw<core pbp cosmetic> }
+sub applies_to           { return qw<PPI::Token::Regexp::Match
+                                     PPI::Token::Regexp::Substitute
+                                     PPI::Token::QuoteLike::Regexp> }
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+    my ( $self, $elem, undef ) = @_;
+
+    my %modifiers = get_modifiers($elem);
+    if ( not $modifiers{s} ) {
+        return $self->violation( $DESC, $EXPL, $elem );
+    }
+    return; #ok!;
+}
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=head1 NAME
+
+Perl::Critic::Policy::RegularExpressions::RequireDotMatchAnything - Always use the C</s> modifier with regular expressions.
+
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic|Perl::Critic>
+distribution.
+
+
+=head1 DESCRIPTION
+
+When asked what C<.> in a regular expression means, most people will
+say that it matches any character, which isn't true.  It's actually
+shorthand for C<[^\n]>.  Using the C<s> modifier makes C<.> act like
+people expect it to.
+
+    my $match = m< foo.bar >xm;  # not ok
+    my $match = m< foo.bar >xms; # ok
+
+
+=head1 CONFIGURATION
+
+This Policy is not configurable except for the standard options.
+
+
+=head1 NOTES
+
+Be cautions about slapping modifier flags onto existing regular
+expressions, as they can drastically alter their meaning.  See
+L<http://www.perlmonks.org/?node_id=484238> for an interesting
+discussion on the effects of blindly modifying regular expression
+flags.
+
+
+=head1 AUTHOR
+
+Jeffrey Ryan Thalhammer  <thaljef@cpan.org>
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.  The full text of this license
+can be found in the LICENSE file included with this module.
+
+=cut
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :
diff --git a/t/RegularExpressions/RequireDotMatchAnything.run b/t/RegularExpressions/RequireDotMatchAnything.run
new file mode 100644 (file)
index 0000000..4b08465
--- /dev/null
@@ -0,0 +1,87 @@
+## name basic passes
+## failures 0
+## cut
+
+my $string =~ m{pattern}s;
+my $string =~ m{pattern}gisx;
+my $string =~ m{pattern}gmis;
+my $string =~ m{pattern}mgxs;
+
+my $string =~ m/pattern/s;
+my $string =~ m/pattern/gisx;
+my $string =~ m/pattern/gmis;
+my $string =~ m/pattern/mgxs;
+
+my $string =~ /pattern/s;
+my $string =~ /pattern/gisx;
+my $string =~ /pattern/gmis;
+my $string =~ /pattern/mgxs;
+
+my $string =~ s/pattern/foo/s;
+my $string =~ s/pattern/foo/gisx;
+my $string =~ s/pattern/foo/gmis;
+my $string =~ s/pattern/foo/mgxs;
+
+my $re = qr/pattern/s;
+
+#-----------------------------------------------------------------------------
+
+## name basic failures
+## failures 17
+## cut
+
+my $string =~ m{pattern};
+my $string =~ m{pattern}gix;
+my $string =~ m{pattern}gim;
+my $string =~ m{pattern}gxm;
+
+my $string =~ m/pattern/;
+my $string =~ m/pattern/gix;
+my $string =~ m/pattern/gim;
+my $string =~ m/pattern/gxm;
+
+my $string =~ /pattern/;
+my $string =~ /pattern/gix;
+my $string =~ /pattern/gim;
+my $string =~ /pattern/gxm;
+
+my $string =~ s/pattern/foo/;
+my $string =~ s/pattern/foo/gix;
+my $string =~ s/pattern/foo/gim;
+my $string =~ s/pattern/foo/gxm;
+
+my $re = qr/pattern/;
+
+#-----------------------------------------------------------------------------
+
+## name tr and y checking
+## failures 0
+## cut
+
+my $string =~ tr/[A-Z]/[a-z]/;
+my $string =~ tr|[A-Z]|[a-z]|;
+my $string =~ tr{[A-Z]}{[a-z]};
+
+my $string =~ y/[A-Z]/[a-z]/;
+my $string =~ y|[A-Z]|[a-z]|;
+my $string =~ y{[A-Z]}{[a-z]};
+
+my $string =~ tr/[A-Z]/[a-z]/cd;
+my $string =~ y/[A-Z]/[a-z]/cd;
+
+##############################################################################
+#      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/RegularExpressions/RequireLineBoundaryMatching.run $
+#     $Date: 2008-03-16 17:40:45 -0500 (Sun, 16 Mar 2008) $
+#   $Author: clonezone $
+# $Revision: 2187 $
+##############################################################################
+
+#-----------------------------------------------------------------------------
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 78
+#   indent-tabs-mode: nil
+#   c-indentation-style: bsd
+# End:
+# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :