1package Perl::Lint::Policy::Subroutines::ProtectPrivateSubs; 2use strict; 3use warnings; 4use Perl::Lint::Constants::Type; 5use parent "Perl::Lint::Policy"; 6 7use constant { 8 DESC => 'Private subroutine/method used', 9 EXPL => 'Use published APIs', 10}; 11 12sub evaluate { 13 my ($class, $file, $tokens, $src, $args) = @_; 14 15 my @allows = (); 16 for my $allow (split(/ /, $args->{protect_private_subs}->{allow} || '')) { 17 my @name_spaces = split /::/, $allow; 18 my $method_name = pop @name_spaces; 19 push @allows, +{ 20 package_name => join('::', @name_spaces), 21 method_name => $method_name, 22 }; 23 } 24 my $private_name_regex = $args->{protect_private_subs}->{private_name_regex} || ''; 25 26 my @violations; 27 my $module_name = ''; 28 TOP: for (my $i = 0; my $token = $tokens->[$i]; $i++) { 29 my $token_type = $token->{type}; 30 my $token_data = $token->{data}; 31 32 if ($token_type == POINTER || $token_type == NAMESPACE_RESOLVER) { 33 my $delimiter = $token_data; 34 35 $token = $tokens->[++$i]; 36 $token_data = $token->{data}; 37 my $next_token = $tokens->[$i+1]; 38 my $next_token_type = $next_token->{type}; 39 if ( 40 substr($token_data, 0, 1) eq '_' && 41 $next_token_type != POINTER && 42 $next_token_type != NAMESPACE_RESOLVER 43 ) { 44 for my $allow (@allows) { 45 if ( 46 $allow->{package_name} eq $module_name && 47 $allow->{method_name} eq $token_data 48 ) { 49 next TOP; 50 } 51 } 52 53 if ($private_name_regex && $token_data =~ /$private_name_regex/) { 54 next; 55 } 56 57 push @violations, { 58 filename => $file, 59 line => $token->{line}, 60 description => DESC, 61 explanation => EXPL, 62 policy => __PACKAGE__, 63 }; 64 $module_name = ''; 65 } 66 else { 67 $module_name .= $delimiter . $token_data; 68 } 69 } 70 elsif ( 71 $token_type == USE_DECL || 72 $token_type == REQUIRE_DECL || 73 $token_type == PACKAGE 74 ) { 75 for ($i++; $token = $tokens->[$i]; $i++) { 76 $token_type = $token->{type}; 77 if ($token_type == SEMI_COLON) { 78 last; 79 } 80 } 81 } 82 elsif ( 83 ($token_type == SPECIFIC_KEYWORD && $token_data eq '__PACKAGE__') || 84 ($token_type == BUILTIN_FUNC && $token_data eq 'shift') || 85 ($token_type == NAMESPACE && $token_data eq 'POSIX') 86 ) { 87 $i++; # skip target func 88 } 89 elsif ($token_type == NAMESPACE) { 90 $module_name .= $token_data; 91 } 92 elsif ( 93 ( 94 $token_type == VAR || 95 $token_type == GLOBAL_VAR || 96 $token_type == LOCAL_VAR 97 ) && ($token_data eq '$pkg' || $token_data eq '$self') 98 ) { 99 $i++; 100 my $next_token = $tokens->[$i+1]; 101 if ($next_token->{type} == NAMESPACE && $next_token->{data} eq 'SUPER') { 102 $i += 2; 103 } 104 } 105 elsif ($token_type == SEMI_COLON) { 106 $module_name = ''; 107 } 108 } 109 110 return \@violations; 111} 112 1131; 114 115