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