vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/RegularExpressions/ProhibitSingleCharAlternation.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/RegularExpressions/ProhibitSingleCharAlternation.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::ProhibitSingleCharAlternation;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15 use Readonly;
  16 use Carp;
  17
  18 use Perl::Critic::Utils qw{ :booleans :characters :severities };
  19 use Perl::Critic::Utils::PPIRegexp qw{ ppiify parse_regexp };
  20 use base 'Perl::Critic::Policy';
  21
  22 our $VERSION = '1.088';
  23
  24 #-----------------------------------------------------------------------------
  25
  26 Readonly::Scalar my $DESC => q{Use [abc] instead of a|b|c};
  27 Readonly::Scalar my $EXPL => [265];
  28
  29 #-----------------------------------------------------------------------------
  30
  31 sub supported_parameters { return qw()                    }
  32 sub default_severity     { return $SEVERITY_LOWEST        }
  33 sub default_themes       { return qw( core pbp performance ) }
  34 sub applies_to           { return qw(PPI::Token::Regexp::Match
  35                                      PPI::Token::Regexp::Substitute
  36                                      PPI::Token::QuoteLike::Regexp) }
  37
  38 #-----------------------------------------------------------------------------
  39
  40 sub violates {
  41     my ( $self, $elem, undef ) = @_;
  42
  43     # optimization: don't bother parsing the regexp if there are no pipes
  44     return if $elem !~ m/[|]/xms;
  45
  46     my $re = ppiify(parse_regexp($elem));
  47     return if !$re;
  48
  49     # Must pass a sub to find() because our node classes don't start with PPI::
  50     my $branches =
  51         $re->find(sub {$_[1]->isa('Perl::Critic::PPIRegexp::branch')});
  52     return if not $branches;
  53     for my $branch (@{$branches}) {
  54         my @singles =
  55             grep
  56                 {
  57                         $_->isa('Perl::Critic::PPIRegexp::exact')
  58                     and 1 == length $_
  59                 }
  60                 $branch->children;
  61         if (1 < @singles) {
  62             my $description =
  63                   'Use ['
  64                 . join( $EMPTY, @singles )
  65                 . '] instead of '
  66                 . join q<|>, @singles;
  67             return $self->violation( $description, $EXPL, $elem );
  68         }
  69     }
  70
  71     return;  # OK
  72 }
  73
  74 1;
  75
  76 __END__
  77
  78 #-----------------------------------------------------------------------------
  79
  80 =pod
  81
  82 =head1 NAME
  83
  84 Perl::Critic::Policy::RegularExpressions::ProhibitSingleCharAlternation - Use C<[abc]> instead of C<a|b|c>.
  85
  86 =head1 AFFILIATION
  87
  88 This Policy is part of the core L<Perl::Critic> distribution.
  89
  90
  91 =head1 DESCRIPTION
  92
  93 Character classes (like C<[abc]>) are significantly faster than single
  94 character alternations (like C<(?:a|b|c)>).  This policy complains if you have
  95 more than one instance of a single character in an alternation.  So
  96 C<(?:a|the)> is allowed, but C<(?:a|e|i|o|u)> is not.
  97
  98 NOTE: Perl 5.10 (not released as of this writing) has major regexp
  99 optimizations which may mitigate the performance penalty of
 100 alternations, which will be rewritten behind the scenes as something
 101 like character classes.
 102
 103
 104 =head1 CONFIGURATION
 105
 106 This Policy is not configurable except for the standard options.
 107
 108
 109 =head1 CREDITS
 110
 111 Initial development of this policy was supported by a grant from the Perl Foundation.
 112
 113 =head1 AUTHOR
 114
 115 Chris Dolan <cdolan@cpan.org>
 116
 117 =head1 COPYRIGHT
 118
 119 Copyright (c) 2007-2008 Chris Dolan.  Many rights reserved.
 120
 121 This program is free software; you can redistribute it and/or modify
 122 it under the same terms as Perl itself.  The full text of this license
 123 can be found in the LICENSE file included with this module
 124
 125 =cut
 126
 127 # Local Variables:
 128 #   mode: cperl
 129 #   cperl-indent-level: 4
 130 #   fill-column: 78
 131 #   indent-tabs-mode: nil
 132 #   c-indentation-style: bsd
 133 # End:
 134 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :