File Coverage

blib/lib/Perl/Lint/Policy/Subroutines/ProhibitUnusedPrivateSubroutines.pm
Criterion Covered Total %
statement 81 87 93.1
branch 47 52 90.3
condition 37 45 82.2
subroutine 7 7 100.0
pod 0 1 0.0
total 172 192 89.5


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::Subroutines::ProhibitUnusedPrivateSubroutines;
2 133     133   70387 use strict;
  133         192  
  133         3277  
3 133     133   434 use warnings;
  133         179  
  133         2570  
4 133     133   802 use Compiler::Lexer;
  133         5057  
  133         3933  
5 133     133   972 use Perl::Lint::Constants::Type;
  133         186  
  133         61752  
6 133     133   632 use parent "Perl::Lint::Policy";
  133         176  
  133         596  
7              
8             use constant {
9 133         78479 DESC => 'Private subroutine/method "%s" declared but not used',
10             EXPL => 'Eliminate dead code',
11 133     133   7021 };
  133         190  
12              
13             sub evaluate {
14 23     23 0 49 my ($class, $file, $tokens, $src, $args) = @_;
15              
16 23         22 my %allow;
17 23 100       75 if (my $allow = $args->{prohibit_unused_private_subroutines}->{allow}) {
18 1         6 $allow{$_} = 1 for split / /, $allow;
19             }
20 23         36 my $allow_regex = $args->{prohibit_unused_private_subroutines}->{private_name_regex};
21              
22 23         18 my $lexer;
23             my @violations;
24 0         0 my @private_functions;
25 0         0 my %ignores;
26 0         0 my %called;
27 23         63 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
28 153         115 my $token_type = $token->{type};
29 153         122 my $token_data = $token->{data};
30              
31 153 100 100     973 if ($token_type == FUNCTION_DECL) {
    100 100        
    100 100        
    100 100        
32 31         41 $token = $tokens->[++$i];
33 31         33 $token_data = $token->{data};
34 31         32 my $function_token = $token;
35 31 100 100     140 if (substr($token_data, 0, 1) eq '_' && !$allow{$token_data}) {
36 26 100 66     123 if (!$allow_regex || $token_data !~ /$allow_regex/) {
37 22         30 my $declared_private_function = '';
38 22         43 for (; $token = $tokens->[$i]; $i++) {
39 49         41 $token_type = $token->{type};
40 49 100 100     208 if ($token_type == NAMESPACE || $token_type == FUNCTION) {
    100          
    100          
    100          
41 22         48 $declared_private_function = $token->{data};
42             }
43             elsif ($token_type == NAMESPACE_RESOLVER) {
44 1         4 last;
45             }
46             elsif ($token_type == LEFT_BRACE) {
47 20         37 push @private_functions, $function_token;
48              
49 20         24 my $left_brace_num = 1;
50 20         44 for ($i++; $token = $tokens->[$i]; $i++) {
51 132         93 $token_type = $token->{type};
52 132 50 66     569 if ($token_type == LEFT_BRACE) {
    100 66        
    100          
53 0         0 $left_brace_num++;
54             }
55             elsif ($token_type == RIGHT_BRACE) {
56 20 50       65 last if --$left_brace_num <= 0;
57             }
58             elsif ($token_type == CALL || $token_type == KEY || $token_type == METHOD) {
59 4         5 $token_data = $token->{data};
60 4 50       8 if ($token_data eq $declared_private_function) {
61 4         8 next;
62             }
63 0         0 $called{$token_data} = 1;
64             }
65             }
66 20         54 last;
67             }
68             elsif ($token_type == SEMI_COLON) {
69 1         4 last;
70             }
71             }
72             }
73             }
74             }
75             elsif ($token_type == CALL || $token_type == KEY || $token_type == METHOD) {
76 11         31 $called{$token_data} = 1;
77             }
78             elsif ($token_type == USED_NAME && $token_data eq 'overload') {
79 3         3 my $is_value = 1;
80 3         8 for ($i++; $token = $tokens->[$i]; $i++) {
81 24         13 $token_type = $token->{type};
82 24         21 my $next_token = $tokens->[$i+1];
83 24         19 my $next_token_type = $next_token->{type};
84 24 100       49 if ($token_type == ARROW) {
    100          
85 3 50       6 if ($is_value) {
86 3         6 for ($i++; $token = $tokens->[$i]; $i++) {
87 15         11 $token_type = $token->{type};
88 15 100 66     65 if (
    100 100        
89             $token_type == KEY ||
90             $token_type == STRING ||
91             $token_type == RAW_STRING
92             ) {
93 5         12 $ignores{$token->{data}} = 1;
94             }
95             elsif ($token_type == SEMI_COLON) {
96 3         5 last; # fail safe
97             }
98             }
99             }
100 3         7 $is_value = !$is_value;
101             }
102             elsif ($token_type == SEMI_COLON) {
103 3         7 last;
104             }
105             }
106             }
107             elsif ($token_type == REG_REPLACE || $token_type == REG_MATCH) {
108 3         10 for ($i++; $token = $tokens->[$i]; $i++) {
109 19         19 $token_type = $token->{type};
110 19 100 100     64 if ($token_type == REG_REPLACE_TO || $token_type == REG_EXP) {
    100          
111 3   33     14 $lexer ||= Compiler::Lexer->new($file);
112 3         230 my $replace_to_tokens = $lexer->tokenize($token->{data});
113              
114 3         12 for (my $i = 0; $token = $replace_to_tokens->[$i]; $i++) {
115 20         17 my $token_type = $token->{type};
116 20 100 66     93 if ($token_type == CALL || $token_type == KEY || $token_type == METHOD) {
      66        
117 3         7 $called{$token->{data}} = 1;
118             }
119             }
120             }
121             elsif ($token_type == SEMI_COLON) {
122 3         10 last; # fail safe
123             }
124             }
125             }
126             }
127              
128 23         43 for my $private_function (@private_functions) {
129 20         31 my $private_function_name = $private_function->{data};
130 20 50       45 if ($ignores{$private_function_name}) {
131 0         0 next;
132             }
133              
134 20 100       40 unless ($called{$private_function_name}) {
135             push @violations, {
136             filename => $file,
137             line => $private_function->{line},
138 8         61 description => sprintf(DESC, $private_function_name),
139             explanation => EXPL,
140             policy => __PACKAGE__,
141             };
142             }
143             }
144              
145 23         119 return \@violations;
146             }
147              
148             1;
149