File Coverage

blib/lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm
Criterion Covered Total %
statement 66 66 100.0
branch 39 42 92.8
condition 14 21 66.6
subroutine 18 18 100.0
pod 4 5 80.0
total 141 152 92.7


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins;
2              
3 40     40   38763 use 5.010001;
  40         191  
4 40     40   268 use strict;
  40         127  
  40         1055  
5 40     40   275 use warnings;
  40         115  
  40         1221  
6 40     40   289 use Readonly;
  40         115  
  40         2518  
7              
8 40         2205 use Perl::Critic::Utils qw{
9             :booleans :severities :data_conversion :classification :language
10 40     40   321 };
  40         149  
11 40     40   20399 use parent 'Perl::Critic::Policy';
  40         166  
  40         277  
12              
13             our $VERSION = '1.148';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Array my @ALLOW => qw( my our local return state );
18             Readonly::Hash my %ALLOW => hashify( @ALLOW );
19              
20             Readonly::Scalar my $DESC => q{Builtin function called with parentheses};
21             Readonly::Scalar my $EXPL => [ 13 ];
22              
23             Readonly::Scalar my $PRECEDENCE_OF_LIST => precedence_of(q{>>}) + 1;
24             Readonly::Scalar my $PRECEDENCE_OF_COMMA => precedence_of(q{,});
25              
26             #-----------------------------------------------------------------------------
27             # These are all the functions that are considered named unary
28             # operators. These frequently require parentheses because they have lower
29             # precedence than ordinary function calls.
30              
31             Readonly::Array my @NAMED_UNARY_OPS => qw(
32             alarm glob rand
33             caller gmtime readlink
34             chdir hex ref
35             chroot int require
36             cos lc return
37             defined lcfirst rmdir
38             delete length scalar
39             do localtime sin
40             eval lock sleep
41             exists log sqrt
42             exit lstat srand
43             getgrp my stat
44             gethostbyname oct uc
45             getnetbyname ord ucfirst
46             getprotobyname quotemeta umask
47             undef
48             );
49             Readonly::Hash my %NAMED_UNARY_OPS => hashify( @NAMED_UNARY_OPS );
50              
51             #-----------------------------------------------------------------------------
52              
53 101     101 0 1754 sub supported_parameters { return () }
54 82     82 1 383 sub default_severity { return $SEVERITY_LOWEST }
55 84     84 1 363 sub default_themes { return qw( core pbp cosmetic ) }
56 42     42 1 144 sub applies_to { return 'PPI::Token::Word' }
57              
58             #-----------------------------------------------------------------------------
59              
60             sub violates {
61 405     405 1 886 my ( $self, $elem, undef ) = @_;
62              
63 405 100       956 return if exists $ALLOW{$elem};
64 298 100       4254 return if not is_perl_builtin($elem);
65 122 100       1705 return if not is_function_call($elem);
66              
67 115         381 my $sibling = $elem->snext_sibling();
68 115 100       2424 return if not $sibling;
69 114 100       436 if ( $sibling->isa('PPI::Structure::List') ) {
70 35         314 my $elem_after_parens = $sibling->snext_sibling();
71              
72 35 100       762 return if _is_named_unary_with_operator_inside_parens_exemption($elem, $sibling);
73 30 100       274 return if _is_named_unary_with_operator_following_parens_exemption($elem, $elem_after_parens);
74 20 100       68 return if _is_precedence_exemption($elem_after_parens);
75 11 100       31 return if _is_equals_exemption($sibling);
76 10 100       61 return if _is_sort_exemption($elem, $sibling);
77              
78             # If we get here, it must be a violation
79 8         41 return $self->violation( $DESC, $EXPL, $elem );
80             }
81 79         303 return; #ok!
82             }
83              
84             #-----------------------------------------------------------------------------
85             # EXCEPTION 1: If the function is a named unary and there is an
86             # operator with higher precedence right after the parentheses.
87             # Example: int( 1.5 ) + 0.5;
88              
89             sub _is_named_unary_with_operator_following_parens_exemption {
90 30     30   67 my ($elem, $elem_after_parens) = @_;
91              
92 30 100 100     66 if ( _is_named_unary( $elem ) && $elem_after_parens ){
93             # Smaller numbers mean higher precedence
94 12         218 my $precedence = precedence_of( $elem_after_parens );
95 12 100 66     254 return $TRUE if defined $precedence && $precedence < $PRECEDENCE_OF_LIST;
96             }
97              
98 20         213 return $FALSE;
99             }
100              
101             sub _is_named_unary {
102 65     65   121 my ($elem) = @_;
103              
104 65         182 return exists $NAMED_UNARY_OPS{$elem->content};
105             }
106              
107             #-----------------------------------------------------------------------------
108             # EXCEPTION 2, If there is an operator immediately after the
109             # parentheses, and that operator has precedence greater than
110             # or equal to a comma.
111             # Example: join($delim, @list) . "\n";
112              
113             sub _is_precedence_exemption {
114 20     20   54 my ($elem_after_parens) = @_;
115              
116 20 100       65 if ( $elem_after_parens ){
117             # Smaller numbers mean higher precedence
118 17         56 my $precedence = precedence_of( $elem_after_parens );
119 17 100 100     300 return $TRUE if defined $precedence && $precedence <= $PRECEDENCE_OF_COMMA;
120             }
121              
122 11         38 return $FALSE;
123             }
124              
125             #-----------------------------------------------------------------------------
126             # EXCEPTION 3: If the first operator within the parentheses is '='
127             # Example: chomp( my $foo = <STDIN> );
128              
129             sub _is_equals_exemption {
130 11     11   24 my ($sibling) = @_;
131              
132 11 100       40 if ( my $first_op = $sibling->find_first('PPI::Token::Operator') ){
133 5 100       1833 return $TRUE if $first_op eq q{=};
134             }
135              
136 10         1459 return $FALSE;
137             }
138              
139             #-----------------------------------------------------------------------------
140             # EXCEPTION 4: sort with default comparator but a function for the list data
141             # Example: sort(foo(@x))
142              
143             sub _is_sort_exemption {
144 10     10   26 my ($elem, $sibling) = @_;
145              
146 10 100       32 if ( $elem eq 'sort' ) {
147 2         54 my $first_arg = $sibling->schild(0);
148 2 50 33     42 if ( $first_arg && $first_arg->isa('PPI::Statement::Expression') ) {
149 2         7 $first_arg = $first_arg->schild(0);
150             }
151 2 50 33     40 if ( $first_arg && $first_arg->isa('PPI::Token::Word') ) {
152 2         7 my $next_arg = $first_arg->snext_sibling;
153 2 50 33     50 return $TRUE if $next_arg && $next_arg->isa('PPI::Structure::List');
154             }
155             }
156              
157 8         127 return $FALSE;
158             }
159              
160             #-----------------------------------------------------------------------------
161             # EXCEPTION 5: If the function is a named unary and there is an operator
162             # inside the parentheses.
163             # Example: length($foo || $bar);
164              
165             sub _is_named_unary_with_operator_inside_parens_exemption {
166 35     35   97 my ($elem, $parens) = @_;
167 35   100     93 return _is_named_unary($elem) && _contains_operators($parens);
168             }
169              
170             sub _contains_operators {
171 18     18   301 my ($parens) = @_;
172 18 100       59 return $TRUE if $parens->find_first('PPI::Token::Operator');
173 13         2848 return $FALSE;
174             }
175              
176             #-----------------------------------------------------------------------------
177             1;
178              
179             __END__
180              
181              
182             =pod
183              
184             =for stopwords disambiguates builtins
185              
186             =head1 NAME
187              
188             Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins - Write C<open $handle, $path> instead of C<open($handle, $path)>.
189              
190              
191             =head1 AFFILIATION
192              
193             This Policy is part of the core L<Perl::Critic|Perl::Critic>
194             distribution.
195              
196              
197             =head1 DESCRIPTION
198              
199             Conway suggests that all built-in functions be called without
200             parentheses around the argument list. This reduces visual clutter and
201             disambiguates built-in functions from user functions. Exceptions are
202             made for C<my>, C<local>, and C<our> which require parentheses when
203             called with multiple arguments.
204              
205             open($handle, '>', $filename); #not ok
206             open $handle, '>', $filename; #ok
207              
208             split(/$pattern/, @list); #not ok
209             split /$pattern/, @list; #ok
210              
211              
212             =head1 CONFIGURATION
213              
214             This Policy is not configurable except for the standard options.
215              
216              
217             =head1 NOTES
218              
219             Coding with parentheses can sometimes lead to verbose and awkward
220             constructs, so I think the intent of Conway's guideline is to remove
221             only the F<unnecessary> parentheses. This policy makes exceptions for
222             some common situations where parentheses are usually required.
223             However, you may find other situations where the parentheses are
224             necessary to enforce precedence, but they cause still violations. In
225             those cases, consider using the '## no critic' comments to silence
226             Perl::Critic.
227              
228              
229             =head1 BUGS
230              
231             Some builtin functions (particularly those that take a variable number
232             of scalar arguments) should probably get parentheses. This policy
233             should be enhanced to allow the user to specify a list of builtins
234             that are exempt from the policy.
235              
236              
237             =head1 AUTHOR
238              
239             Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
240              
241              
242             =head1 COPYRIGHT
243              
244             Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
245              
246             This program is free software; you can redistribute it and/or modify
247             it under the same terms as Perl itself. The full text of this license
248             can be found in the LICENSE file included with this module.
249              
250             =cut
251              
252             # Local Variables:
253             # mode: cperl
254             # cperl-indent-level: 4
255             # fill-column: 78
256             # indent-tabs-mode: nil
257             # c-indentation-style: bsd
258             # End:
259             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :