File Coverage

blib/lib/Perl/Lint/Policy/Subroutines/ProhibitExcessComplexity.pm
Criterion Covered Total %
statement 35 36 97.2
branch 10 12 83.3
condition 53 53 100.0
subroutine 6 6 100.0
pod 0 1 0.0
total 104 108 96.3


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::Subroutines::ProhibitExcessComplexity;
2 133     133   70424 use strict;
  133         198  
  133         3164  
3 133     133   436 use warnings;
  133         184  
  133         2524  
4 133     133   818 use Perl::Lint::Constants::Type;
  133         177  
  133         60806  
5 133     133   602 use parent "Perl::Lint::Policy";
  133         202  
  133         612  
6              
7             use constant {
8 133         36426 DESC => 'The maximum complexity score allowed',
9             EXPL => 'Consider refactoring',
10 133     133   6555 };
  133         175  
11              
12             sub evaluate {
13 5     5 0 12 my ($class, $file, $tokens, $src, $args) = @_;
14              
15 5   100     21 my $max_mccabe = $args->{prohibit_excess_complexity}->{max_mccabe} || 20;
16              
17 5         8 my @violations;
18 5         21 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
19 5         8 my $token_type = $token->{type};
20              
21 5         8 my $left_brace_num = 0;
22 5 50       18 if ($token_type == FUNCTION_DECL) {
23 5         6 my $mccabe = 0;
24 5         6 my $function_decl_token = $token;
25 5         16 for ($i++; $token = $tokens->[$i]; $i++) {
26 282         173 $token_type = $token->{type};
27              
28 282         184 my $next_token = $tokens->[$i+1];
29 282         193 my $next_token_type = $next_token->{type};
30              
31 282 100 100     4661 if ($token_type == LEFT_BRACE) {
    100 100        
    100 100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
      100        
32 25         31 $left_brace_num++;
33             }
34             elsif ($token_type == RIGHT_BRACE) {
35 25 50       58 if (--$left_brace_num < 0) {
36 0         0 last;
37             }
38             }
39             elsif (
40             $token_type == AND ||
41             $token_type == OR ||
42             $token_type == ALPHABET_AND ||
43             $token_type == ALPHABET_OR ||
44             $token_type == ALPHABET_XOR ||
45             $token_type == OR_EQUAL ||
46             $token_type == AND_EQUAL ||
47             $token_type == THREE_TERM_OP ||
48             $token_type == IF_STATEMENT ||
49             $token_type == ELSIF_STATEMENT ||
50             $token_type == ELSE_STATEMENT ||
51             $token_type == UNLESS_STATEMENT ||
52             $token_type == WHILE_STATEMENT ||
53             $token_type == UNTIL_STATEMENT ||
54             $token_type == FOR_STATEMENT ||
55             $token_type == FOREACH_STATEMENT ||
56             $token_type == LEFT_SHIFT_EQUAL ||
57             $token_type == RIGHT_SHIFT_EQUAL
58             ) {
59 53         76 $mccabe++;
60             }
61             }
62              
63 5 100       13 if ($mccabe > $max_mccabe) {
64             push @violations, {
65             filename => $file,
66             line => $function_decl_token->{line},
67 3         26 description => DESC,
68             explanation => EXPL,
69             policy => __PACKAGE__,
70             };
71             }
72             }
73             }
74              
75 5         20 return \@violations;
76             }
77              
78             1;
79