vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/CodeLayout/ProhibitParensWithBuiltins.pm

   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) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{
  16     :booleans :severities :data_conversion :classification :language
  17 };
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Array my @ALLOW => qw( my our local return );
  25 Readonly::Hash my %ALLOW => hashify( @ALLOW );
  26
  27 Readonly::Scalar my $DESC  => q{Builtin function called with parentheses};
  28 Readonly::Scalar my $EXPL  => [ 13 ];
  29
  30 Readonly::Scalar my $PRECENDENCE_OF_LIST => precedence_of(q{>>}) + 1;
  31 Readonly::Scalar my $PRECEDENCE_OF_COMMA => precedence_of(q{,});
  32
  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.
  37
  38 Readonly::Array my @NAMED_UNARY_OPS => qw(
  39     alarm           glob        rand
  40     caller          gmtime      readlink
  41     chdir           hex         ref
  42     chroot          int         require
  43     cos             lc          return
  44     defined         lcfirst     rmdir
  45     delete          length      scalar
  46     do              localtime   sin
  47     eval            lock        sleep
  48     exists          log         sqrt
  49     exit            lstat       srand
  50     getgrp          my          stat
  51     gethostbyname   oct         uc
  52     getnetbyname    ord         ucfirst
  53     getprotobyname  quotemeta   umask
  54                                 undef
  55 );
  56 Readonly::Hash my %NAMED_UNARY_OPS => hashify( @NAMED_UNARY_OPS );
  57
  58 #-----------------------------------------------------------------------------
  59
  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'      }
  64
  65 #-----------------------------------------------------------------------------
  66
  67 sub violates {
  68     my ( $self, $elem, undef ) = @_;
  69
  70     return if exists $ALLOW{$elem};
  71     return if not is_perl_builtin($elem);
  72     return if not is_function_call($elem);
  73
  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();
  78
  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);
  83
  84         # If we get here, it must be a violation
  85         return $self->violation( $DESC, $EXPL, $elem );
  86     }
  87     return;    #ok!
  88 }
  89
  90 #-----------------------------------------------------------------------------
  91
  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;
  95
  96 sub _is_named_unary_exemption {
  97     my ($elem, $elem_after_parens) = @_;
  98
  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;
 103     }
 104
 105     return $FALSE;
 106 }
 107
 108 sub _is_named_unary {
 109     my ($elem) = @_;
 110
 111     return exists $NAMED_UNARY_OPS{$elem->content};
 112 }
 113
 114 #-----------------------------------------------------------------------------
 115
 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";
 120
 121 sub _is_precedence_exemption {
 122     my ($elem_after_parens) = @_;
 123
 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;
 128     }
 129
 130     return $FALSE;
 131 }
 132
 133 # EXCEPTION 3: If the first operator within the parentheses is '='
 134 # Example: chomp( my $foo = <STDIN> );
 135
 136 sub _is_equals_exemption {
 137     my ($sibling) = @_;
 138
 139     if ( my $first_op = $sibling->find_first('PPI::Token::Operator') ){
 140         return $TRUE if $first_op eq q{=};
 141     }
 142
 143     return $FALSE;
 144 }
 145
 146 # EXCEPTION 4: sort with default comparator but a function for the list data
 147 # Example: sort(foo(@x))
 148
 149 sub _is_sort_exemption {
 150     my ($elem, $sibling) = @_;
 151
 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);
 156         }
 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');
 160         }
 161     }
 162
 163     return $FALSE;
 164 }
 165
 166 1;
 167
 168 __END__
 169
 170 #-----------------------------------------------------------------------------
 171
 172 =pod
 173
 174 =for stopwords disambiguates
 175
 176 =head1 NAME
 177
 178 Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins - Write C<open $handle, $path> instead of C<open($handle, $path)>.
 179
 180 =head1 AFFILIATION
 181
 182 This Policy is part of the core L<Perl::Critic> distribution.
 183
 184
 185 =head1 DESCRIPTION
 186
 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.
 192
 193   open($handle, '>', $filename); #not ok
 194   open $handle, '>', $filename;  #ok
 195
 196   split(/$pattern/, @list); #not ok
 197   split /$pattern/, @list;  #ok
 198
 199
 200 =head1 CONFIGURATION
 201
 202 This Policy is not configurable except for the standard options.
 203
 204
 205 =head1 NOTES
 206
 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
 214 Perl::Critic.
 215
 216 =head1 AUTHOR
 217
 218 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 219
 220 =head1 COPYRIGHT
 221
 222 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 223
 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.
 227
 228 =cut
 229
 230 # Local Variables:
 231 #   mode: cperl
 232 #   cperl-indent-level: 4
 233 #   fill-column: 78
 234 #   indent-tabs-mode: nil
 235 #   c-indentation-style: bsd
 236 # End:
 237 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :