--- /dev/null
+##############################################################################
+# $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.pm $
+# $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
+# $Author: clonezone $
+# $Revision: 2489 $
+##############################################################################
+
+package Perl::Critic::Policy::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters;
+
+use 5.006001;
+use strict;
+use warnings;
+use Readonly;
+
+use Perl::Critic::Utils qw{
+ :booleans :characters :severities :data_conversion
+};
+use base 'Perl::Critic::Policy';
+
+our $VERSION = '1.088';
+
+#-----------------------------------------------------------------------------
+
+Readonly::Hash my %DESCRIPTIONS => (
+ $QUOTE => q{Single-quote used as quote-like operator delimiter},
+ $DQUOTE => q{Double-quote used as quote-like operator delimiter},
+ $BACKTICK => q{Back-quote (back-tick) used as quote-like operator delimiter},
+);
+
+Readonly::Scalar my $EXPL =>
+ q{Using quotes as delimiters for quote-like operators obfuscates code};
+
+Readonly::Array my @OPERATORS => qw{ m q qq qr qw qx s tr y };
+
+Readonly::Hash my %INFO_RETRIEVERS_BY_PPI_CLASS => (
+ 'PPI::Token::Quote::Literal' => \&_info_for_single_character_operator,
+ 'PPI::Token::Quote::Interpolate' => \&_info_for_two_character_operator,
+ 'PPI::Token::QuoteLike::Command' => \&_info_for_two_character_operator,
+ 'PPI::Token::QuoteLike::Regexp' => \&_info_for_two_character_operator,
+ 'PPI::Token::QuoteLike::Words' => \&_info_for_two_character_operator,
+ 'PPI::Token::Regexp::Match' => \&_info_for_match,
+ 'PPI::Token::Regexp::Substitute' => \&_info_for_single_character_operator,
+ 'PPI::Token::Regexp::Transliterate' => \&_info_for_transliterate,
+);
+
+#-----------------------------------------------------------------------------
+
+sub supported_parameters {
+ return (
+ {
+ name => 'single_quote_allowed_operators',
+ description =>
+ 'The operators to allow single-quotes as delimiters for.',
+ default_string => 'm s qr qx',
+ behavior => 'enumeration',
+ enumeration_values => [ @OPERATORS ],
+ enumeration_allow_multiple_values => 1,
+ },
+ {
+ name => 'double_quote_allowed_operators',
+ description =>
+ 'The operators to allow double-quotes as delimiters for.',
+ default_string => $EMPTY,
+ behavior => 'enumeration',
+ enumeration_values => [ @OPERATORS ],
+ enumeration_allow_multiple_values => 1,
+ },
+ {
+ name => 'back_quote_allowed_operators',
+ description =>
+ 'The operators to allow back-quotes (back-ticks) as delimiters for.',
+ default_string => $EMPTY,
+ behavior => 'enumeration',
+ enumeration_values => [ @OPERATORS ],
+ enumeration_allow_multiple_values => 1,
+ },
+ );
+}
+
+sub default_severity { return $SEVERITY_MEDIUM }
+sub default_themes { return qw( core maintenance ) }
+
+sub applies_to {
+ return qw{
+ PPI::Token::Quote::Interpolate
+ PPI::Token::Quote::Literal
+ PPI::Token::QuoteLike::Command
+ PPI::Token::QuoteLike::Regexp
+ PPI::Token::QuoteLike::Words
+ PPI::Token::Regexp::Match
+ PPI::Token::Regexp::Substitute
+ PPI::Token::Regexp::Transliterate
+ };
+}
+
+#-----------------------------------------------------------------------------
+
+sub initialize_if_enabled {
+ my ($self, $config) = @_;
+
+ $self->{_allowed_operators_by_delimiter} = {
+ $QUOTE => $self->_single_quote_allowed_operators(),
+ $DQUOTE => $self->_double_quote_allowed_operators(),
+ $BACKTICK => $self->_back_quote_allowed_operators(),
+ };
+
+ return $TRUE;
+}
+
+#-----------------------------------------------------------------------------
+
+sub _single_quote_allowed_operators {
+ my ( $self ) = @_;
+
+ return $self->{_single_quote_allowed_operators};
+}
+
+sub _double_quote_allowed_operators {
+ my ( $self ) = @_;
+
+ return $self->{_double_quote_allowed_operators};
+}
+
+sub _back_quote_allowed_operators {
+ my ( $self ) = @_;
+
+ return $self->{_back_quote_allowed_operators};
+}
+
+sub _allowed_operators_by_delimiter {
+ my ( $self ) = @_;
+
+ return $self->{_allowed_operators_by_delimiter};
+}
+
+#-----------------------------------------------------------------------------
+
+sub violates {
+ my ( $self, $elem, undef ) = @_;
+
+ my $info_retriever = $INFO_RETRIEVERS_BY_PPI_CLASS{ ref $elem };
+ return if not $info_retriever;
+
+ my ($operator, $delimiter) = $info_retriever->( $elem );
+
+ my $allowed_operators =
+ $self->_allowed_operators_by_delimiter()->{$delimiter};
+ return if not $allowed_operators;
+
+ if ( not $allowed_operators->{$operator} ) {
+ return $self->violation( $DESCRIPTIONS{$delimiter}, $EXPL, $elem );
+ }
+
+ return;
+}
+
+#-----------------------------------------------------------------------------
+
+sub _info_for_single_character_operator {
+ my ( $elem ) = @_;
+
+ ## no critic (ProhibitParensWithBuiltins)
+ return ( substr ($elem, 0, 1), substr ($elem, 1, 1) );
+ ## use critic
+}
+
+#-----------------------------------------------------------------------------
+
+sub _info_for_two_character_operator {
+ my ( $elem ) = @_;
+
+ ## no critic (ProhibitParensWithBuiltins)
+ return ( substr ($elem, 0, 2), substr ($elem, 2, 1) );
+ ## use critic
+}
+
+#-----------------------------------------------------------------------------
+
+sub _info_for_match {
+ my ( $elem ) = @_;
+
+ if ( $elem =~ m/ ^ m /xms ) {
+ return ('m', substr $elem, 1, 1);
+ }
+
+ return ('m', q{/});
+}
+
+#-----------------------------------------------------------------------------
+
+sub _info_for_transliterate {
+ my ( $elem ) = @_;
+
+ if ( $elem =~ m/ ^ tr /xms ) {
+ return ('tr', substr $elem, 2, 1);
+ }
+
+ return ('y', substr $elem, 1, 1);
+}
+
+
+1;
+
+__END__
+
+#-----------------------------------------------------------------------------
+
+=pod
+
+=for stopwords MSCHWERN
+
+=head1 NAME
+
+Perl::Critic::Policy::ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters - Don't use quotes (C<'>, C<">, C<`>) as delimiters for the quote-like operators.
+
+
+=head1 AFFILIATION
+
+This Policy is part of the core L<Perl::Critic> distribution.
+
+
+=head1 DESCRIPTION
+
+With the obvious exception of using single-quotes to prevent
+interpolation, using quotes with the quote-like operators kind of
+defeats the purpose of them and produces obfuscated code, causing
+problems for future maintainers and their editors/IDEs.
+
+ $x = q"q"; #not ok
+ $x = q'q'; #not ok
+ $x = q`q`; #not ok
+
+ $x = qq"q"; #not ok
+ $x = qr"r"; #not ok
+ $x = qw"w"; #not ok
+
+ $x = qx`date`; #not ok
+
+ $x =~ m"m"; #not ok
+ $x =~ s"s"x"; #not ok
+ $x =~ tr"t"r"; #not ok
+ $x =~ y"x"y"; #not ok
+
+ $x =~ m'$x'; #ok
+ $x =~ s'$x'y'; #ok
+ $x = qr'$x'm; #ok
+ $x = qx'finger foo@bar'; #ok
+
+
+=head1 CONFIGURATION
+
+This policy has three options: C<single_quote_allowed_operators>,
+C<double_quote_allowed_operators>, and
+C<back_quote_allowed_operators>, which control which operators are
+allowed to use each of C<'>, C<">, C<`> as delimiters, respectively.
+
+The values allowed for these options are a whitespace delimited
+selection of the C<m>, C<q>, C<qq>, C<qr>, C<qw>, C<qx>, C<s>, C<tr>,
+and C<y> operators.
+
+By default, double quotes and back quotes (backticks) are not allowed
+as delimiters for any operators and single quotes are allowed as
+delimiters for the C<m>, C<qr>, C<qx>, and C<s> operators. These
+defaults are equivalent to having the following in your
+F<.perlcriticrc>:
+
+ [ValuesAndExpressions::ProhibitQuotesAsQuotelikeOperatorDelimiters]
+ single_quote_allowed_operators = m s qr qx
+ double_quote_allowed_operators =
+ back_quote_allowed_operators =
+
+
+=head1 SUGGESTED BY
+
+MSCHWERN
+
+
+=head1 AUTHOR
+
+Elliot Shank C<< <perl@galumph.com> >>
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2007-2008 Elliot Shank. 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 :
projects / dh-make-perl / blobdiff