1 ##############################################################################
2 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm $
3 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
6 ##############################################################################
8 package Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins;
15 use Perl::Critic::Utils qw{
16 :booleans :severities :data_conversion :classification :language
18 use base 'Perl::Critic::Policy';
20 our $VERSION = '1.088';
22 #-----------------------------------------------------------------------------
24 Readonly::Array my @ALLOW => qw( my our local return );
25 Readonly::Hash my %ALLOW => hashify( @ALLOW );
27 Readonly::Scalar my $DESC => q{Builtin function called with parentheses};
28 Readonly::Scalar my $EXPL => [ 13 ];
30 Readonly::Scalar my $PRECENDENCE_OF_LIST => precedence_of(q{>>}) + 1;
31 Readonly::Scalar my $PRECEDENCE_OF_COMMA => precedence_of(q{,});
33 #-----------------------------------------------------------------------------
34 # These are all the functions that are considered named unary
35 # operators. These frequently require parentheses because they have lower
36 # precedence than ordinary function calls.
38 Readonly::Array my @NAMED_UNARY_OPS => qw(
40 caller gmtime readlink
52 getnetbyname ord ucfirst
53 getprotobyname quotemeta umask
56 Readonly::Hash my %NAMED_UNARY_OPS => hashify( @NAMED_UNARY_OPS );
58 #-----------------------------------------------------------------------------
60 sub supported_parameters { return () }
61 sub default_severity { return $SEVERITY_LOWEST }
62 sub default_themes { return qw( core pbp cosmetic ) }
63 sub applies_to { return 'PPI::Token::Word' }
65 #-----------------------------------------------------------------------------
68 my ( $self, $elem, undef ) = @_;
70 return if exists $ALLOW{$elem};
71 return if not is_perl_builtin($elem);
72 return if not is_function_call($elem);
74 my $sibling = $elem->snext_sibling();
75 return if not $sibling;
76 if ( $sibling->isa('PPI::Structure::List') ) {
77 my $elem_after_parens = $sibling->snext_sibling();
79 return if _is_named_unary_exemption($elem, $elem_after_parens);
80 return if _is_precedence_exemption($elem_after_parens);
81 return if _is_equals_exemption($sibling);
82 return if _is_sort_exemption($elem, $sibling);
84 # If we get here, it must be a violation
85 return $self->violation( $DESC, $EXPL, $elem );
90 #-----------------------------------------------------------------------------
92 # EXCEPTION 1: If the function is a named unary and there is an
93 # operator with higher precedence right after the parentheses.
94 # Example: int( 1.5 ) + 0.5;
96 sub _is_named_unary_exemption {
97 my ($elem, $elem_after_parens) = @_;
99 if ( _is_named_unary( $elem ) && $elem_after_parens ){
100 # Smaller numbers mean higher precedence
101 my $precedence = precedence_of( $elem_after_parens );
102 return $TRUE if defined $precedence && $precedence < $PRECENDENCE_OF_LIST;
108 sub _is_named_unary {
111 return exists $NAMED_UNARY_OPS{$elem->content};
114 #-----------------------------------------------------------------------------
116 # EXCEPTION 2, If there is an operator immediately after the
117 # parentheses, and that operator has precedence greater than
118 # or equal to a comma.
119 # Example: join($delim, @list) . "\n";
121 sub _is_precedence_exemption {
122 my ($elem_after_parens) = @_;
124 if ( $elem_after_parens ){
125 # Smaller numbers mean higher precedence
126 my $precedence = precedence_of( $elem_after_parens );
127 return $TRUE if defined $precedence && $precedence <= $PRECEDENCE_OF_COMMA;
133 # EXCEPTION 3: If the first operator within the parentheses is '='
134 # Example: chomp( my $foo = <STDIN> );
136 sub _is_equals_exemption {
139 if ( my $first_op = $sibling->find_first('PPI::Token::Operator') ){
140 return $TRUE if $first_op eq q{=};
146 # EXCEPTION 4: sort with default comparator but a function for the list data
147 # Example: sort(foo(@x))
149 sub _is_sort_exemption {
150 my ($elem, $sibling) = @_;
152 if ( $elem eq 'sort' ) {
153 my $first_arg = $sibling->schild(0);
154 if ( $first_arg && $first_arg->isa('PPI::Statement::Expression') ) {
155 $first_arg = $first_arg->schild(0);
157 if ( $first_arg && $first_arg->isa('PPI::Token::Word') ) {
158 my $next_arg = $first_arg->snext_sibling;
159 return $TRUE if $next_arg && $next_arg->isa('PPI::Structure::List');
170 #-----------------------------------------------------------------------------
174 =for stopwords disambiguates
178 Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins - Write C<open $handle, $path> instead of C<open($handle, $path)>.
182 This Policy is part of the core L<Perl::Critic> distribution.
187 Conway suggests that all built-in functions be called without
188 parentheses around the argument list. This reduces visual clutter and
189 disambiguates built-in functions from user functions. Exceptions are
190 made for C<my>, C<local>, and C<our> which require parentheses when
191 called with multiple arguments.
193 open($handle, '>', $filename); #not ok
194 open $handle, '>', $filename; #ok
196 split(/$pattern/, @list); #not ok
197 split /$pattern/, @list; #ok
202 This Policy is not configurable except for the standard options.
207 Coding with parentheses can sometimes lead to verbose and awkward
208 constructs, so I think the intent of Conway's guideline is to remove
209 only the F<unnecessary> parentheses. This policy makes exceptions for
210 some common situations where parentheses are usually required.
211 However, you may find other situations where the parentheses are
212 necessary to enforce precedence, but they cause still violations. In
213 those cases, consider using the '## no critic' comments to silence
218 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
222 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
224 This program is free software; you can redistribute it and/or modify
225 it under the same terms as Perl itself. The full text of this license
226 can be found in the LICENSE file included with this module.
232 # cperl-indent-level: 4
234 # indent-tabs-mode: nil
235 # c-indentation-style: bsd
237 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :