Login
Clean up some self-compliance issues now that MagicNumbers
[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / Subroutines / ProhibitManyArgs.pm
CommitLineData
c6e19b74
CD
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::Subroutines::ProhibitManyArgs;
9
10use strict;
11use warnings;
12use Readonly;
13
14use File::Spec;
15use List::Util qw(first);
16use List::MoreUtils qw(uniq any);
17use English qw(-no_match_vars);
18use Carp;
19
70f3f307 20use Perl::Critic::Utils qw{ :booleans :severities split_nodes_on_comma };
c6e19b74
CD
21use base 'Perl::Critic::Policy';
22
add38467 23our $VERSION = '1.082';
c6e19b74
CD
24
25#-----------------------------------------------------------------------------
26
c6e19b74
CD
27Readonly::Scalar my $AT => q{@}; ##no critic(Interpolation)
28Readonly::Scalar my $AT_ARG => q{@_}; ##no critic(Interpolation)
29
30Readonly::Scalar my $DESC => q{Too many arguments};
31Readonly::Scalar my $EXPL => [182];
32
33#-----------------------------------------------------------------------------
34
c957fc12
ES
35sub supported_parameters {
36 return (
37 {
38 name => 'max_arguments',
39 description =>
40 'The maximum number of arguments to allow a subroutine to have.',
41 default_string => '5',
42 behavior => 'integer',
43 integer_minimum => 1,
44 },
45 );
46}
47
c6e19b74
CD
48sub default_severity { return $SEVERITY_MEDIUM }
49sub default_themes { return qw( core pbp maintance ) }
50sub applies_to { return 'PPI::Statement::Sub' }
51
52#-----------------------------------------------------------------------------
53
c6e19b74
CD
54sub violates {
55 my ( $self, $elem, undef ) = @_;
56
57 # forward declaration?
58 return if !$elem->block;
59
60 my $num_args;
61 if ($elem->prototype) {
c957fc12 62 # subtract two for the "()" on the prototype
29e94807 63 $num_args = -2 + length $elem->prototype; ## no critic (ProhibitMagicNumbers)
c6e19b74
CD
64 } else {
65 $num_args = _count_args($elem->block->schildren);
66 }
67
68 if ($self->{_max_arguments} < $num_args) {
69 return $self->violation( $DESC, $EXPL, $elem );
70 }
71 return; # OK
72}
73
74sub _count_args {
75 my @statements = @_;
76
77 # look for these patterns:
78 # " ... = @_;" => then examine previous variable list
79 # " ... = shift;" => counts as one arg, then look for more
c957fc12 80
c6e19b74
CD
81 return 0 if !@statements; # no statements
82
83 my $statement = shift @statements;
84 my @elements = $statement->schildren();
85 my $operand = pop @elements;
86 while ($operand && $operand->isa('PPI::Token::Structure') && q{;} eq $operand) {
87 $operand = pop @elements;
88 }
89 return 0 if !$operand;
90
91 #print "pulled off last, remaining: '@elements'\n";
92 my $operator = pop @elements;
93 return 0 if !$operator;
94 return 0 if !$operator->isa('PPI::Token::Operator');
95 return 0 if q{=} ne $operator;
96
97 if ($operand->isa('PPI::Token::Magic') && $AT_ARG eq $operand) {
98 return _count_list_elements(@elements);
99 } elsif ($operand->isa('PPI::Token::Word') && 'shift' eq $operand) {
100 return 1 + _count_args(@statements);
101 }
102
103 return 0;
104}
105
106sub _count_list_elements {
107 my @elements = @_;
108
109 my $list = pop @elements;
110 return 0 if !$list;
111 return 0 if !$list->isa('PPI::Structure::List');
112 my @inner = $list->schildren;
113 if (1 == @inner && $inner[0]->isa('PPI::Statement::Expression')) {
114 @inner = $inner[0]->schildren;
115 }
116 return scalar split_nodes_on_comma(@inner);
117}
118
1191;
120
121__END__
122
123#-----------------------------------------------------------------------------
124
125=pod
126
127=for stopwords refactored
128
129=head1 NAME
130
131Perl::Critic::Policy::Subroutines::ProhibitManyArgs
132
133=head1 DESCRIPTION
134
135Subroutines that expect large numbers of arguments are hard to use
136because programmers routinely have to look at documentation to
137remember the order of those arguments. Many arguments is often a sign
138that a subroutine should be refactored or that an object should be
139passed to the routine.
140
141=head1 CONFIGURATION
142
143By default, this policy allows up to 5 arguments without warning. To
144change this threshold, put entries in a F<.perlcriticrc> file like
145this:
146
147 [Subroutines::ProhibitManyArgs]
148 max_arguments = 6
149
150=head1 CAVEATS
151
152PPI doesn't currently detect anonymous subroutines, so we don't check those.
153This should just work when PPI gains that feature.
154
155We don't check for C<@ARG>, the alias for C<@_> from English.pm. That's
156deprecated anyway.
157
158=head1 CREDITS
159
160Initial development of this policy was supported by a grant from the Perl Foundation.
161
162=head1 AUTHOR
163
164Chris Dolan <cdolan@cpan.org>
165
166=head1 COPYRIGHT
167
20dfddeb 168Copyright (c) 2007-2008 Chris Dolan. Many rights reserved.
c6e19b74
CD
169
170This program is free software; you can redistribute it and/or modify
171it under the same terms as Perl itself. The full text of this license
172can be found in the LICENSE file included with this module
173
174=cut
175
176# Local Variables:
177# mode: cperl
178# cperl-indent-level: 4
179# fill-column: 78
180# indent-tabs-mode: nil
181# c-indentation-style: bsd
182# End:
183# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :