File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitBarewordDoubleColon.pm
Criterion Covered Total %
statement 50 51 98.0
branch 13 14 92.8
condition 3 6 50.0
subroutine 14 14 100.0
pod 1 1 100.0
total 81 86 94.1


line stmt bran cond sub pod time code
1             # Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde
2              
3             # Perl-Critic-Pulp is free software; you can redistribute it and/or modify
4             # it under the terms of the GNU General Public License as published by the
5             # Free Software Foundation; either version 3, or (at your option) any later
6             # version.
7             #
8             # Perl-Critic-Pulp is distributed in the hope that it will be useful, but
9             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
11             # for more details.
12             #
13             # You should have received a copy of the GNU General Public License along
14             # with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
15              
16             package Perl::Critic::Policy::ValuesAndExpressions::ProhibitBarewordDoubleColon;
17 40     40   34890 use 5.006;
  40         172  
18 40     40   263 use strict;
  40         95  
  40         968  
19 40     40   214 use warnings;
  40         98  
  40         1161  
20 40     40   241 use List::Util;
  40         92  
  40         2504  
21              
22 40     40   280 use base 'Perl::Critic::Policy';
  40         104  
  40         5466  
23 40     40   191579 use Perl::Critic::Utils;
  40         509  
  40         892  
24              
25 40     40   36927 use Perl::Critic::Pulp;
  40         137  
  40         1292  
26 40     40   1433 use Perl::Critic::Pulp::Utils 'elem_is_comma_operator';
  40         128  
  40         3601  
27              
28             # uncomment this to run the ### lines
29             #use Smart::Comments;
30              
31             our $VERSION = 99;
32              
33 40         3187 use constant supported_parameters =>
34             ({ name => 'allow_indirect_syntax',
35             description => 'Whether to allow double-colon in indirect object syntax "new Foo:: arg,arg".',
36             behavior => 'boolean',
37             default_string => '1',
38 40     40   324 });
  40         103  
39              
40 40     40   278 use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST;
  40         105  
  40         3848  
41 40     40   293 use constant default_themes => qw(pulp cosmetic);
  40         90  
  40         2497  
42 40     40   272 use constant applies_to => 'PPI::Token::Word';
  40         96  
  40         11725  
43              
44             sub violates {
45 39     39 1 586968 my ($self, $elem, $document) = @_;
46              
47 39 100       120 $elem =~ /::$/ or return;
48              
49 13 100       148 if ($self->{'_allow_indirect_syntax'}) {
50 6 100       20 if (_word_is_indirect_call_classname($elem)) {
51 2         8 return;
52             }
53             }
54              
55 11         42 return $self->violation
56             ('Use plain string instead of Foo:: bareword',
57             '',
58             $elem);
59             }
60              
61             # $elem is a PPI::Token::Word.
62             # Return true if it's the class name in an indirect object syntax method call.
63             #
64             sub _word_is_indirect_call_classname {
65 6     6   14 my ($elem) = @_;
66             ### _word_is_indirect_call_classname(): "$elem"
67              
68 6   66     26 my $prev = $elem->sprevious_sibling || do {
69             ### no method preceding, not an indirect call ...
70             return 0;
71             };
72             ### prev: ref $prev, $prev->content
73              
74 5 100       186 if (! $prev->isa('PPI::Token::Word')) {
75             ### not a bareword method name preceding, not an indirect call ...
76 2         7 return 0;
77             }
78 3 100       14 if ($prev eq 'return') {
79             ### return is never an indirect call ...
80 1         21 return 0;
81             }
82              
83             # What about "foo bar Foo::"? Assume its function foo and method bar?
84             #
85             # $prev = $prev->sprevious_sibling;
86             # ### prev-prev: ref $prev, $prev->content
87             # if ($prev && $prev->isa('PPI::Token::Word')) { return 0; }
88              
89 2 100       45 if (my $next = $elem->snext_sibling) {
90 1 50 33     33 if ($next->isa('PPI::Token::Operator') && $next eq '=>') {
91             # "word1 word2 => ..." is either a function call to word1 or a syntax
92             # error, not an indirect call. But "word1 word2," can be an indirect
93             # call in a comma operator list
94             #
95             ### fat comma not an indirect ...
96 0         0 return 0;
97             }
98             }
99              
100 2         36 return 1;
101             }
102              
103             1;
104             __END__
105              
106             =for stopwords barewords bareword disambiguates ie runtime boolean Ryde
107              
108             =head1 NAME
109              
110             Perl::Critic::Policy::ValuesAndExpressions::ProhibitBarewordDoubleColon - don't use Foo:: style barewords
111              
112             =head1 DESCRIPTION
113              
114             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
115             add-on. It asks you not to use the double-colon bareword like
116              
117             $class = Foo::Bar::; # bad
118              
119             but instead a plain string
120              
121             $class = 'Foo::Bar'; # ok
122              
123             This is intended as a building block for a restricted coding style, or a
124             matter of personal preference if you think the C<::> is a bit obscure and
125             that it's clearer to write a string when you mean a string. On that basis
126             the policy is lowest severity and under the "cosmetic" theme (see
127             L<Perl::Critic/POLICY THEMES>).
128              
129             =head2 Indirect Object Syntax
130              
131             By default a double-colon is allowed in the indirect object syntax (see
132             L<perlobj/Indirect Object Syntax>).
133              
134             my $obj = new Foo::Bar:: $arg1,$arg2; # ok
135              
136             This is because C<::> there is important to disambiguate a class name
137             C<Foo::Bar> from a function C<Foo::Bar()>, ie. function C<Bar()> in package
138             C<Foo>.
139              
140             Whether you actually want indirect object syntax is a matter for other
141             policies, like
142             L<C<ProhibitIndirectSyntax>|Perl::Critic::Policy::Objects::ProhibitIndirectSyntax>.
143             If you don't want the double-colon bareword then change to arrow style
144             C<< Foo::Bar->new($arg,...) >>.
145              
146             =head2 Double-Colon Advantages
147              
148             The C<::> bareword is for use on package names, not general bareword
149             quoting. If there's no such package at compile time a warning is given (see
150             L<perldiag/Bareword "%s" refers to nonexistent package>)
151              
152             my $class = No::Such::Package::; # Perl warning
153              
154             This warning can help pick up typos, though it relies on relevant packages
155             being loaded at compile-time (ie. C<BEGIN>). If the package is loaded by a
156             C<require> at runtime then the warning fires even though the code runs
157             correctly. For reference, a warning isn't given for the indirect object
158             syntax, which rather limits its benefit.
159              
160             =head2 Disabling
161              
162             If you don't care about this you can always disable
163             C<ProhibitBarewordDoubleColon> from your F<.perlcriticrc> in the usual way
164             (see L<Perl::Critic/CONFIGURATION>),
165              
166             [-ValuesAndExpressions::ProhibitBarewordDoubleColon]
167              
168             =head1 CONFIGURATION
169              
170             =over 4
171              
172             =item C<allow_indirect_syntax> (boolean, default true)
173              
174             If true then allow double-colon in the indirect object syntax as shown
175             above. If false then report double-colons everywhere as violations
176              
177             # bad under allow_indirect_syntax=false
178             my $obj = new Foo::Bar:: $arg1,$arg2;
179              
180             This can be controlled from your F<~/.perlcriticrc> in the usual way. For
181             example
182              
183             [ValuesAndExpressions::ProhibitBarewordDoubleColon]
184             allow_indirect_syntax=no
185              
186             =back
187              
188             =head1 SEE ALSO
189              
190             L<Perl::Critic::Pulp>,
191             L<Perl::Critic>,
192             L<Perl::Critic::Policy::Objects::ProhibitIndirectSyntax>
193              
194             L<perl5005delta/"C<Foo::> can be used as implicitly quoted package name">
195              
196             =head1 HOME PAGE
197              
198             http://user42.tuxfamily.org/perl-critic-pulp/index.html
199              
200             =head1 COPYRIGHT
201              
202             Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Ryde
203              
204             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
205             under the terms of the GNU General Public License as published by the Free
206             Software Foundation; either version 3, or (at your option) any later
207             version.
208              
209             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
210             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
211             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
212             more details.
213              
214             You should have received a copy of the GNU General Public License along with
215             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses>.
216              
217             =cut