File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitQuotesAsQuotelikeOperatorDelimiters.pm
Criterion Covered Total %
statement 53 53 100.0
branch 9 10 90.0
condition n/a
subroutine 20 20 100.0
pod 5 6 83.3
total 87 89 97.7


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