git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/RegularExpressions/ProhibitUnusualDelimiters.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use English qw(-no_match_vars);
  16 use Carp;
  17
  18 use Perl::Critic::Utils qw{ :booleans :severities hashify };
  19 use Perl::Critic::Utils::PPIRegexp qw{ get_delimiters };
  20 use base 'Perl::Critic::Policy';
  21
  22 our $VERSION = '1.088';
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Scalar my $DESC => q<Use only '//' or '{}' to delimit regexps>;
  27 Readonly::Scalar my $EXPL => [246];
  28
  29 Readonly::Array my @EXTRA_BRACKETS => qw{ () [] <> };
  30
  31 #-----------------------------------------------------------------------------
  32
  33 sub supported_parameters {
  34     return (
  35         {
  36             name               => 'allow_all_brackets',
  37             description        =>
  38                 q[In addition to allowing '{}', allow '()', '[]', and '{}'.],
  39             behavior           => 'boolean',
  40         },
  41     );
  42 }
  43
  44 sub default_severity     { return $SEVERITY_LOWEST        }
  45 sub default_themes       { return qw( core pbp cosmetic ) }
  46 sub applies_to           { return qw(PPI::Token::Regexp::Match
  47                                      PPI::Token::Regexp::Substitute
  48                                      PPI::Token::QuoteLike::Regexp) }
  49
  50 #-----------------------------------------------------------------------------
  51
  52 sub initialize_if_enabled {
  53     my ( $self, $config ) = @_;
  54
  55     my %delimiters = hashify( qw< // {} > );
  56     if ( $self->{_allow_all_brackets} ) {
  57         @delimiters{ @EXTRA_BRACKETS } = (1) x @EXTRA_BRACKETS;
  58     }
  59
  60     $self->{_allowed_delimiters} = \%delimiters;
  61
  62     return $TRUE;
  63 }
  64
  65 #-----------------------------------------------------------------------------
  66
  67 sub violates {
  68     my ( $self, $elem, undef ) = @_;
  69
  70     my $allowed_delimiters = $self->{_allowed_delimiters};
  71     foreach my $delimiter (get_delimiters($elem)) {
  72         next if $allowed_delimiters->{$delimiter};
  73         return $self->violation( $DESC, $EXPL, $elem );
  74     }
  75
  76     return;  # OK
  77 }
  78
  79 1;
  80
  81 __END__
  82
  83 #-----------------------------------------------------------------------------
  84
  85 =pod
  86
  87 =head1 NAME
  88
  89 Perl::Critic::Policy::RegularExpressions::ProhibitUnusualDelimiters - Use only C<//> or C<{}> to delimit regexps.
  90
  91
  92 =head1 AFFILIATION
  93
  94 This Policy is part of the core L<Perl::Critic> distribution.
  95
  96
  97 =head1 DESCRIPTION
  98
  99 Perl lets you delimit regular expressions with almost any character,
 100 but most choices are illegible.  Compare these equivalent expressions:
 101
 102   s/foo/bar/;   # good
 103   s{foo}{bar};  # good
 104   s#foo#bar#;   # bad
 105   s;foo;bar;;   # worse
 106   s|\|\||\||;   # eye-gouging bad
 107
 108
 109 =head1 CONFIGURATION
 110
 111 There is one option for this policy, C<allow_all_brackets>.  If this
 112 is true, then, in addition to allowing C<//> and C<{}>, the other
 113 matched pairs of C<()>, C<[]>, and C<< <> >> are allowed.
 114
 115
 116 =head1 CREDITS
 117
 118 Initial development of this policy was supported by a grant from the
 119 Perl Foundation.
 120
 121
 122 =head1 AUTHOR
 123
 124 Chris Dolan <cdolan@cpan.org>
 125
 126
 127 =head1 COPYRIGHT
 128
 129 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 130
 131 This program is free software; you can redistribute it and/or modify
 132 it under the same terms as Perl itself.  The full text of this license
 133 can be found in the LICENSE file included with this module
 134
 135 =cut
 136
 137 # Local Variables:
 138 #   mode: cperl
 139 #   cperl-indent-level: 4
 140 #   fill-column: 78
 141 #   indent-tabs-mode: nil
 142 #   c-indentation-style: bsd
 143 # End:
 144 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :