1 ##############################################################################
2 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/Subroutines/ProhibitManyArgs.pm $
3 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
6 ##############################################################################
8 package Perl::Critic::Policy::Subroutines::ProhibitManyArgs;
16 use List::Util qw(first);
17 use List::MoreUtils qw(uniq any);
18 use English qw(-no_match_vars);
21 use Perl::Critic::Utils qw{ :booleans :severities split_nodes_on_comma };
22 use base 'Perl::Critic::Policy';
24 our $VERSION = '1.088';
26 #-----------------------------------------------------------------------------
28 Readonly::Scalar my $AT => q{@}; ##no critic(Interpolation)
29 Readonly::Scalar my $AT_ARG => q{@_}; ##no critic(Interpolation)
31 Readonly::Scalar my $DESC => q{Too many arguments};
32 Readonly::Scalar my $EXPL => [182];
34 #-----------------------------------------------------------------------------
36 sub supported_parameters {
39 name => 'max_arguments',
41 'The maximum number of arguments to allow a subroutine to have.',
42 default_string => '5',
43 behavior => 'integer',
49 sub default_severity { return $SEVERITY_MEDIUM }
50 sub default_themes { return qw( core pbp maintenance ) }
51 sub applies_to { return 'PPI::Statement::Sub' }
53 #-----------------------------------------------------------------------------
56 my ( $self, $elem, undef ) = @_;
58 # forward declaration?
59 return if !$elem->block;
62 if ($elem->prototype) {
63 # subtract two for the "()" on the prototype
64 $num_args = -2 + length $elem->prototype; ## no critic (ProhibitMagicNumbers)
66 $num_args = _count_args($elem->block->schildren);
69 if ($self->{_max_arguments} < $num_args) {
70 return $self->violation( $DESC, $EXPL, $elem );
78 # look for these patterns:
79 # " ... = @_;" => then examine previous variable list
80 # " ... = shift;" => counts as one arg, then look for more
82 return 0 if !@statements; # no statements
84 my $statement = shift @statements;
85 my @elements = $statement->schildren();
86 my $operand = pop @elements;
87 while ($operand && $operand->isa('PPI::Token::Structure') && q{;} eq $operand) {
88 $operand = pop @elements;
90 return 0 if !$operand;
92 #print "pulled off last, remaining: '@elements'\n";
93 my $operator = pop @elements;
94 return 0 if !$operator;
95 return 0 if !$operator->isa('PPI::Token::Operator');
96 return 0 if q{=} ne $operator;
98 if ($operand->isa('PPI::Token::Magic') && $AT_ARG eq $operand) {
99 return _count_list_elements(@elements);
100 } elsif ($operand->isa('PPI::Token::Word') && 'shift' eq $operand) {
101 return 1 + _count_args(@statements);
107 sub _count_list_elements {
110 my $list = pop @elements;
112 return 0 if !$list->isa('PPI::Structure::List');
113 my @inner = $list->schildren;
114 if (1 == @inner && $inner[0]->isa('PPI::Statement::Expression')) {
115 @inner = $inner[0]->schildren;
117 return scalar split_nodes_on_comma(@inner);
124 #-----------------------------------------------------------------------------
128 =for stopwords refactored
132 Perl::Critic::Policy::Subroutines::ProhibitManyArgs - Too many arguments.
136 This Policy is part of the core L<Perl::Critic> distribution.
141 Subroutines that expect large numbers of arguments are hard to use
142 because programmers routinely have to look at documentation to
143 remember the order of those arguments. Many arguments is often a sign
144 that a subroutine should be refactored or that an object should be
145 passed to the routine.
149 By default, this policy allows up to 5 arguments without warning. To
150 change this threshold, put entries in a F<.perlcriticrc> file like
153 [Subroutines::ProhibitManyArgs]
158 PPI doesn't currently detect anonymous subroutines, so we don't check those.
159 This should just work when PPI gains that feature.
161 We don't check for C<@ARG>, the alias for C<@_> from English.pm. That's
166 Initial development of this policy was supported by a grant from the Perl Foundation.
170 Chris Dolan <cdolan@cpan.org>
174 Copyright (c) 2007-2008 Chris Dolan. Many rights reserved.
176 This program is free software; you can redistribute it and/or modify
177 it under the same terms as Perl itself. The full text of this license
178 can be found in the LICENSE file included with this module
184 # cperl-indent-level: 4
186 # indent-tabs-mode: nil
187 # c-indentation-style: bsd
189 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :