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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.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::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{
  16     :booleans :characters :severities :data_conversion
  17 };
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Hash my %DESCRIPTIONS => (
  25     $QUOTE    => q{Single-quote used as quote-like operator delimiter},
  26     $DQUOTE   => q{Double-quote used as quote-like operator delimiter},
  27     $BACKTICK => q{Back-quote (back-tick) used as quote-like operator delimiter},
  28 );
  29
  30 Readonly::Scalar my $EXPL =>
  31     q{Using quotes as delimiters for quote-like operators obfuscates code};
  32
  33 Readonly::Array my @OPERATORS => qw{ m q qq qr qw qx s tr y };
  34
  35 Readonly::Hash my %INFO_RETRIEVERS_BY_PPI_CLASS => (
  36     'PPI::Token::Quote::Literal'        => \&_info_for_single_character_operator,
  37     'PPI::Token::Quote::Interpolate'    => \&_info_for_two_character_operator,
  38     'PPI::Token::QuoteLike::Command'    => \&_info_for_two_character_operator,
  39     'PPI::Token::QuoteLike::Regexp'     => \&_info_for_two_character_operator,
  40     'PPI::Token::QuoteLike::Words'      => \&_info_for_two_character_operator,
  41     'PPI::Token::Regexp::Match'         => \&_info_for_match,
  42     'PPI::Token::Regexp::Substitute'    => \&_info_for_single_character_operator,
  43     'PPI::Token::Regexp::Transliterate' => \&_info_for_transliterate,
  44 );
  45
  46 #-----------------------------------------------------------------------------
  47
  48 sub supported_parameters {
  49     return (
  50         {
  51             name               => 'single_quote_allowed_operators',
  52             description        =>
  53                 'The operators to allow single-quotes as delimiters for.',
  54             default_string     => 'm s qr qx',
  55             behavior           => 'enumeration',
  56             enumeration_values => [ @OPERATORS ],
  57             enumeration_allow_multiple_values => 1,
  58         },
  59         {
  60             name               => 'double_quote_allowed_operators',
  61             description        =>
  62                 'The operators to allow double-quotes as delimiters for.',
  63             default_string     => $EMPTY,
  64             behavior           => 'enumeration',
  65             enumeration_values => [ @OPERATORS ],
  66             enumeration_allow_multiple_values => 1,
  67         },
  68         {
  69             name               => 'back_quote_allowed_operators',
  70             description        =>
  71                 'The operators to allow back-quotes (back-ticks) as delimiters for.',
  72             default_string     => $EMPTY,
  73             behavior           => 'enumeration',
  74             enumeration_values => [ @OPERATORS ],
  75             enumeration_allow_multiple_values => 1,
  76         },
  77     );
  78 }
  79
  80 sub default_severity { return $SEVERITY_MEDIUM       }
  81 sub default_themes   { return qw( core maintenance ) }
  82
  83 sub applies_to {
  84     return qw{
  85         PPI::Token::Quote::Interpolate
  86         PPI::Token::Quote::Literal
  87         PPI::Token::QuoteLike::Command
  88         PPI::Token::QuoteLike::Regexp
  89         PPI::Token::QuoteLike::Words
  90         PPI::Token::Regexp::Match
  91         PPI::Token::Regexp::Substitute
  92         PPI::Token::Regexp::Transliterate
  93     };
  94 }
  95
  96 #-----------------------------------------------------------------------------
  97
  98 sub initialize_if_enabled {
  99     my ($self, $config) = @_;
 100
 101     $self->{_allowed_operators_by_delimiter} = {
 102         $QUOTE    => $self->_single_quote_allowed_operators(),
 103         $DQUOTE   => $self->_double_quote_allowed_operators(),
 104         $BACKTICK => $self->_back_quote_allowed_operators(),
 105     };
 106
 107     return $TRUE;
 108 }
 109
 110 #-----------------------------------------------------------------------------
 111
 112 sub _single_quote_allowed_operators {
 113     my ( $self ) = @_;
 114
 115     return $self->{_single_quote_allowed_operators};
 116 }
 117
 118 sub _double_quote_allowed_operators {
 119     my ( $self ) = @_;
 120
 121     return $self->{_double_quote_allowed_operators};
 122 }
 123
 124 sub _back_quote_allowed_operators {
 125     my ( $self ) = @_;
 126
 127     return $self->{_back_quote_allowed_operators};
 128 }
 129
 130 sub _allowed_operators_by_delimiter {
 131     my ( $self ) = @_;
 132
 133     return $self->{_allowed_operators_by_delimiter};
 134 }
 135
 136 #-----------------------------------------------------------------------------
 137
 138 sub violates {
 139     my ( $self, $elem, undef ) = @_;
 140
 141     my $info_retriever = $INFO_RETRIEVERS_BY_PPI_CLASS{ ref $elem };
 142     return if not $info_retriever;
 143
 144     my ($operator, $delimiter) = $info_retriever->( $elem );
 145
 146     my $allowed_operators =
 147         $self->_allowed_operators_by_delimiter()->{$delimiter};
 148     return if not $allowed_operators;
 149
 150     if ( not $allowed_operators->{$operator} ) {
 151         return $self->violation( $DESCRIPTIONS{$delimiter}, $EXPL, $elem );
 152     }
 153
 154     return;
 155 }
 156
 157 #-----------------------------------------------------------------------------
 158
 159 sub _info_for_single_character_operator {
 160     my ( $elem ) = @_;
 161
 162     ## no critic (ProhibitParensWithBuiltins)
 163     return ( substr ($elem, 0, 1), substr ($elem, 1, 1) );
 164     ## use critic
 165 }
 166
 167 #-----------------------------------------------------------------------------
 168
 169 sub _info_for_two_character_operator {
 170     my ( $elem ) = @_;
 171
 172     ## no critic (ProhibitParensWithBuiltins)
 173     return ( substr ($elem, 0, 2), substr ($elem, 2, 1) );
 174     ## use critic
 175 }
 176
 177 #-----------------------------------------------------------------------------
 178
 179 sub _info_for_match {
 180     my ( $elem ) = @_;
 181
 182     if ( $elem =~ m/ ^ m /xms ) {
 183         return ('m', substr $elem, 1, 1);
 184     }
 185
 186     return ('m', q{/});
 187 }
 188
 189 #-----------------------------------------------------------------------------
 190
 191 sub _info_for_transliterate {
 192     my ( $elem ) = @_;
 193
 194     if ( $elem =~ m/ ^ tr /xms ) {
 195         return ('tr', substr $elem, 2, 1);
 196     }
 197
 198     return ('y', substr $elem, 1, 1);
 199 }
 200
 201
 202 1;
 203
 204 __END__
 205
 206 #-----------------------------------------------------------------------------
 207
 208 =pod
 209
 210 =for stopwords MSCHWERN
 211
 212 =head1 NAME
 213
 214 Perl::Critic::Policy::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters - Don't use quotes (C<'>, C<">, C<`>) as delimiters for the quote-like operators.
 215
 216
 217 =head1 AFFILIATION
 218
 219 This Policy is part of the core L<Perl::Critic> distribution.
 220
 221
 222 =head1 DESCRIPTION
 223
 224 With the obvious exception of using single-quotes to prevent
 225 interpolation, using quotes with the quote-like operators kind of
 226 defeats the purpose of them and produces obfuscated code, causing
 227 problems for future maintainers and their editors/IDEs.
 228
 229   $x = q"q";                #not ok
 230   $x = q'q';                #not ok
 231   $x = q`q`;                #not ok
 232
 233   $x = qq"q";               #not ok
 234   $x = qr"r";               #not ok
 235   $x = qw"w";               #not ok
 236
 237   $x = qx`date`;            #not ok
 238
 239   $x =~ m"m";               #not ok
 240   $x =~ s"s"x";             #not ok
 241   $x =~ tr"t"r";            #not ok
 242   $x =~ y"x"y";             #not ok
 243
 244   $x =~ m'$x';              #ok
 245   $x =~ s'$x'y';            #ok
 246   $x = qr'$x'm;             #ok
 247   $x = qx'finger foo@bar';  #ok
 248
 249
 250 =head1 CONFIGURATION
 251
 252 This policy has three options: C<single_quote_allowed_operators>,
 253 C<double_quote_allowed_operators>, and
 254 C<back_quote_allowed_operators>, which control which operators are
 255 allowed to use each of C<'>, C<">, C<`> as delimiters, respectively.
 256
 257 The values allowed for these options are a whitespace delimited
 258 selection of the C<m>, C<q>, C<qq>, C<qr>, C<qw>, C<qx>, C<s>, C<tr>,
 259 and C<y> operators.
 260
 261 By default, double quotes and back quotes (backticks) are not allowed
 262 as delimiters for any operators and single quotes are allowed as
 263 delimiters for the C<m>, C<qr>, C<qx>, and C<s> operators.  These
 264 defaults are equivalent to having the following in your
 265 F<.perlcriticrc>:
 266
 267   [ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters]
 268   single_quote_allowed_operators = m s qr qx
 269   double_quote_allowed_operators =
 270   back_quote_allowed_operators =
 271
 272
 273 =head1 SUGGESTED BY
 274
 275 MSCHWERN
 276
 277
 278 =head1 AUTHOR
 279
 280 Elliot Shank C<< <perl@galumph.com> >>
 281
 282
 283 =head1 COPYRIGHT
 284
 285 Copyright (c) 2007-2008 Elliot Shank.  All rights reserved.
 286
 287 This program is free software; you can redistribute it and/or modify
 288 it under the same terms as Perl itself.  The full text of this license
 289 can be found in the LICENSE file included with this module.
 290
 291 =cut
 292
 293 # Local Variables:
 294 #   mode: cperl
 295 #   cperl-indent-level: 4
 296 #   fill-column: 78
 297 #   indent-tabs-mode: nil
 298 #   c-indentation-style: bsd
 299 # End:
 300 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :