File Coverage

blib/lib/Perl/Lint/Policy/Subroutines/RequireArgUnpacking.pm
Criterion Covered Total %
statement 84 86 97.6
branch 46 48 95.8
condition 32 36 88.8
subroutine 8 8 100.0
pod 0 1 0.0
total 170 179 94.9


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::Subroutines::RequireArgUnpacking;
2 133     133   69730 use strict;
  133         182  
  133         3207  
3 133     133   446 use warnings;
  133         179  
  133         2935  
4 133     133   449 use List::Util qw/any/;
  133         166  
  133         6698  
5 133     133   896 use Perl::Lint::Constants::Type;
  133         198  
  133         58908  
6 133     133   636 use parent "Perl::Lint::Policy";
  133         180  
  133         661  
7              
8             use constant {
9 133         68101 DESC => 'Always unpack @_ first',
10             EXPL => [178],
11 133     133   6766 };
  133         209  
12              
13             sub evaluate {
14 21     21 0 41 my ($class, $file, $tokens, $src, $args) = @_;
15              
16 21         33 my $require_arg_unpacking_arg = $args->{require_arg_unpacking};
17 21   100     73 my $short_subroutine_statements = $require_arg_unpacking_arg->{short_subroutine_statements} || undef;
18 21   100     65 my $allow_subscripts = $require_arg_unpacking_arg->{allow_subscripts} || 0;
19 21   100     83 my @allow_delegation_to = split(/ /, $require_arg_unpacking_arg->{allow_delegation_to} || '');
20              
21 21         21 my @violations;
22 21         57 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
23 72         53 my $token_type = $token->{type};
24 72         69 my $next_token = $tokens->[$i+1];
25              
26 72 100 66     194 if (
      66        
27             $token_type == FUNCTION_DECL ||
28             ($token_type == KEY && $next_token->{type} == LEFT_BRACE)
29             ) {
30 21         17 my $function_token = $token;
31 21         54 for ($i++; $token = $tokens->[$i]; $i++) {
32 82         61 $token_type = $token->{type};
33              
34 82 100       205 if ($token_type == LEFT_BRACE) {
    100          
35 32         37 my $begin_line = $token->{line};
36              
37             # variable for each line
38 32         25 my $is_inherited = 0;
39 32         35 my $package_name = '';
40              
41 32         24 my $is_violated = 0;
42 32         24 my $left_brace_num = 1;
43 32         64 for ($i++; $token = $tokens->[$i]; $i++) {
44 823         614 $token_type = $token->{type};
45 823         608 my $token_data = $token->{data};
46              
47 823 100 100     5184 if ($token_type == LEFT_BRACE) {
    100 66        
    100 100        
    100 100        
    100          
    100          
    100          
    100          
48 20         36 $left_brace_num++;
49             }
50             elsif ($token_type == RIGHT_BRACE) {
51 52 100       95 if (--$left_brace_num <= 0) {
52 32         26 my $end_line = $token->{line};
53 32 100       56 if ($is_violated) {
54 15 100 100     37 if (
55             not(defined $short_subroutine_statements) ||
56             (($end_line - $begin_line - 1) > $short_subroutine_statements)
57             ) {
58             push @violations, {
59             filename => $file,
60             line => $function_token->{line},
61 14         64 description => DESC,
62             explanation => EXPL,
63             policy => __PACKAGE__,
64             };
65             }
66             }
67 32         108 last;
68             }
69             }
70             elsif ($token_type == BUILTIN_FUNC && $token_data eq 'shift') {
71 11         13 $token = $tokens->[++$i];
72 11         13 $token_type = $token->{type};
73 11 50       16 if ($token_type == LEFT_PAREN) {
74 0         0 $token = $tokens->[++$i];
75 0         0 $token_type = $token->{type};
76             }
77 11 100       27 if ($token_type == ARGUMENT_ARRAY) {
78 2         5 $is_violated = 1;
79             }
80             }
81             elsif ($token_type == SPECIFIC_VALUE && $token_data eq '$_') {
82 29         32 $token = $tokens->[++$i];
83 29         27 $token_type = $token->{type};
84 29 50       43 if ($token_type == LEFT_BRACKET) {
85 29         17 $token = $tokens->[++$i];
86 29         24 $token_type = $token->{type};
87 29 100       38 if ($token_type == INT) {
88 26         36 $is_violated = 1;
89             }
90             }
91             }
92             elsif ($token_type == ARGUMENT_ARRAY && !$allow_subscripts) {
93 56         61 $token = $tokens->[++$i];
94 56         45 $token_type = $token->{type};
95 56 100       115 if ($token_type == LEFT_BRACKET) {
96 1         4 $is_violated = 1;
97             }
98             }
99             elsif ($token_type == NAMESPACE || $token_type == METHOD) {
100 13 100 100     60 if ($is_inherited || $token_data eq 'NEXT' || $token_data eq 'SUPER') {
      100        
101 4         2 $is_inherited = 1;
102 4         5 $package_name .= $token_data;
103 4         8 next;
104             }
105              
106 9         11 my $next_token = $tokens->[$i+1];
107 9         10 my $next_token_type = $next_token->{type};
108 9 100       17 if ($next_token_type == LEFT_PAREN) {
109 5         8 $next_token = $tokens->[$i+2];
110 5         8 $next_token_type = $next_token->{type};
111             }
112 9 100       14 if ($next_token_type == ARGUMENT_ARRAY) {
113 4 100 66 3   40 if (@allow_delegation_to && any {$_ eq $package_name || $_ eq $token_data} @allow_delegation_to) {
  3 100       14  
114 2         9 next;
115             }
116 2         3 $is_violated = 1;
117             }
118 7         16 $package_name .= $token_data;
119             }
120             elsif ($token_type == NAMESPACE_RESOLVER) {
121 6         10 $package_name .= $token_data;
122             }
123             elsif ($token_type == SEMI_COLON) {
124 102         75 $is_inherited = 0;
125 102         160 $package_name = '';
126             }
127             }
128             }
129             elsif ($token_type == SEMI_COLON) {
130 1         5 last;
131             }
132             }
133             }
134             }
135              
136 21         87 return \@violations;
137             }
138              
139             1;
140