vcs.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitLongChainsOfMethodCalls.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::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13 use Readonly;
  14
  15 use Perl::Critic::Utils qw{ :characters :severities };
  16 use Perl::Critic::Utils::PPI qw{ is_ppi_expression_or_generic_statement };
  17
  18 use base 'Perl::Critic::Policy';
  19
  20 our $VERSION = '1.088';
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Scalar my $EXPL =>
  25     q{Long chains of method calls indicate code that is too tightly coupled};
  26
  27 #-----------------------------------------------------------------------------
  28
  29 sub supported_parameters {
  30     return (
  31         {
  32             name            => 'max_chain_length',
  33             description     => 'The number of chained calls to allow.',
  34             default_string  => '3',
  35             behavior        => 'integer',
  36             integer_minimum => 1,
  37         },
  38     );
  39 }
  40
  41 sub default_severity { return $SEVERITY_LOW          }
  42 sub default_themes   { return qw( core maintenance ) }
  43 sub applies_to       { return qw{ PPI::Statement };  }
  44
  45 #-----------------------------------------------------------------------------
  46
  47 sub _max_chain_length {
  48     my ( $self ) = @_;
  49
  50     return $self->{_max_chain_length};
  51 }
  52
  53 #-----------------------------------------------------------------------------
  54
  55 sub violates {
  56     my ( $self, $elem, undef ) = @_;
  57
  58     return if not is_ppi_expression_or_generic_statement($elem);
  59
  60     my $chain_length = 0;
  61     my $max_chain_length = $self->_max_chain_length();
  62     my @children = $elem->schildren();
  63     my $child = shift @children;
  64
  65     while ($child) {
  66         # if it looks like we've got a subroutine call, drop the parameter
  67         # list.
  68         if (
  69                 $child->isa('PPI::Token::Word')
  70             and @children
  71             and $children[0]->isa('PPI::Structure::List')
  72         ) {
  73             shift @children;
  74         }
  75
  76         if (
  77                 $child->isa('PPI::Token::Word')
  78             or  $child->isa('PPI::Token::Symbol')
  79         ) {
  80             if ( @children ) {
  81                 if ( $children[0]->isa('PPI::Token::Operator') ) {
  82                     if ( q{->} eq $children[0]->content() ) {
  83                         $chain_length++;
  84                         shift @children;
  85                     }
  86                 }
  87                 elsif ( not  $children[0]->isa('PPI::Token::Structure') ) {
  88                     $chain_length = 0;
  89                 }
  90             }
  91         }
  92         else {
  93             if ($chain_length > $max_chain_length) {
  94                 return
  95                     $self->violation(
  96                         "Found method-call chain of length $chain_length.",
  97                         $EXPL,
  98                         $elem,
  99                     );
 100             }
 101
 102             $chain_length = 0;
 103         }
 104
 105         $child = shift @children;
 106     }
 107
 108     if ($chain_length > $max_chain_length) {
 109         return
 110             $self->violation(
 111                 "Found method-call chain of length $chain_length.",
 112                 $EXPL,
 113                 $elem,
 114             );
 115     }
 116
 117     return;
 118 }
 119
 120
 121 1;
 122
 123 __END__
 124
 125 #-----------------------------------------------------------------------------
 126
 127 =pod
 128
 129 =for stopwords MSCHWERN
 130
 131 =head1 NAME
 132
 133 Perl::Critic::Policy::ValuesAndExpressions::ProhibitLongChainsOfMethodCalls - Long chains of method calls indicate tightly coupled code.
 134
 135
 136 =head1 AFFILIATION
 137
 138 This Policy is part of the core L<Perl::Critic> distribution.
 139
 140
 141 =head1 DESCRIPTION
 142
 143 A long chain of method calls usually indicates that the code knows too
 144 much about the interrelationships between objects.  If the code is
 145 able to directly navigate far down a network of objects, then when the
 146 network changes structure in the future, the code will need to be
 147 modified to deal with the change.  The code is too tightly coupled and
 148 is brittle.
 149
 150
 151   $x = $y->a;           #ok
 152   $x = $y->a->b;        #ok
 153   $x = $y->a->b->c;     #questionable, but allowed by default
 154   $x = $y->a->b->c->d;  #not ok
 155
 156
 157 =head1 CONFIGURATION
 158
 159 This policy has one option: C<max_chain_length> which controls how far
 160 the code is allowed to navigate.  The default value is 3.
 161
 162
 163 =head1 AUTHOR
 164
 165 Elliot Shank C<< <perl@galumph.com> >>
 166
 167
 168 =head1 COPYRIGHT
 169
 170 Copyright (c) 2007-2008 Elliot Shank.  All rights reserved.
 171
 172 This program is free software; you can redistribute it and/or modify
 173 it under the same terms as Perl itself.  The full text of this license
 174 can be found in the LICENSE file included with this module.
 175
 176 =cut
 177
 178 # Local Variables:
 179 #   mode: cperl
 180 #   cperl-indent-level: 4
 181 #   fill-column: 78
 182 #   indent-tabs-mode: nil
 183 #   c-indentation-style: bsd
 184 # End:
 185 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :