File Coverage

blib/lib/Perl/Lint/Policy/NamingConventions/ProhibitAmbiguousNames.pm
Criterion Covered Total %
statement 62 62 100.0
branch 27 28 96.4
condition 27 30 90.0
subroutine 8 8 100.0
pod 0 1 0.0
total 124 129 96.1


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::NamingConventions::ProhibitAmbiguousNames;
2 133     133   73716 use strict;
  133         200  
  133         3354  
3 133     133   430 use warnings;
  133         161  
  133         3016  
4 133     133   822 use String::CamelCase qw/wordsplit/;
  133         523  
  133         4935  
5 133     133   812 use Perl::Lint::Constants::Type;
  133         162  
  133         62500  
6 133     133   585 use parent "Perl::Lint::Policy";
  133         167  
  133         611  
7              
8 133     133   7504 use constant DEFAULT_FORBIDDEN_WORDS => [qw/abstract bases close contract last left no record right second set/];
  133         176  
  133         7546  
9              
10             use constant {
11 133         53105 DESC => 'The variable names that are not to be allowed',
12             EXPL => [48],
13 133     133   462 };
  133         172  
14              
15             sub evaluate {
16 10     10 0 23 my ($class, $file, $tokens, $src, $args) = @_;
17              
18 10         17 my @forbidden_words = @{+DEFAULT_FORBIDDEN_WORDS};
  10         49  
19 10 100       38 if (defined(my $forbiddens = $args->{prohibit_ambiguous_names}->{forbid})) {
20 3         12 @forbidden_words = split / /, $forbiddens;
21             }
22              
23 10         13 my @violations;
24 10         16 my $token_num = scalar @$tokens;
25 10         36 for (my $i = 0; $i < $token_num; $i++) {
26 91         74 my $token = $tokens->[$i];
27 91         111 my $token_type = $token->{type};
28              
29 91 100 100     245 if ($token_type == FOR_STATEMENT || $token_type == FOREACH_STATEMENT) {
30 2         3 my $next_token_type = $tokens->[++$i]->{type};
31 2 50 33     6 $i++ if $next_token_type == VAR_DECL || $next_token_type == OUR_DECL;
32 2         2 $i++;
33 2         4 next;
34             }
35              
36 89         52 my @word_blocks;
37 89 100 100     316 if ($token_type == VAR_DECL || $token_type == OUR_DECL || $token_type == LOCAL_DECL) {
    100 100        
38 29         25 my $left_paren_num = 0;
39 29         53 for ($i++; $i < $token_num; $i++) {
40 73         283 my $token = $tokens->[$i];
41 73         58 my $token_type = $token->{type};
42              
43 73 100 66     567 if (
    100 100        
    100 100        
    100 100        
    100 100        
    100          
44             $token_type == VAR ||
45             $token_type == LOCAL_VAR ||
46             $token_type == LOCAL_ARRAY_VAR ||
47             $token_type == LOCAL_HASH_VAR ||
48             $token_type == GLOBAL_VAR
49             ) {
50 28         84 push @word_blocks, [wordsplit(substr $token->{data}, 1)];
51             }
52             elsif ($token_type == NAMESPACE_RESOLVER || $token_type == GLOB) {
53 4         6 next;
54             }
55             elsif ($token_type == NAMESPACE) {
56 4         11 push @word_blocks, [$tokens->[$i]->{data}];
57             }
58             elsif ($token_type == LEFT_PAREN) {
59 3         6 $left_paren_num++;
60             }
61             elsif ($token_type == RIGHT_PAREN) {
62 3         5 $left_paren_num--;
63             }
64             elsif ($left_paren_num <= 0) {
65 29         34 last;
66             }
67             }
68             }
69             elsif ($token_type == FUNCTION_DECL) {
70 3         7 for ($i++; $i < $token_num; $i++) {
71 8         8 my $token = $tokens->[$i];
72 8         7 my $token_type = $token->{type};
73              
74 8 100 100     27 if ($token_type == FUNCTION || $token_type == NAMESPACE) {
    100          
75 4         11 push @word_blocks, [$token->{data}];
76             }
77             elsif ($token_type == LEFT_BRACE) {
78 3         3 last;
79             }
80             }
81             }
82              
83 89         131 for my $word_block (@word_blocks) {
84 36         34 for my $word (@$word_block) {
85 37 100       41 if (grep {$_ eq $word} @forbidden_words) {
  329         332  
86             push @violations, {
87             filename => $file,
88             line => $token->{line},
89 26         86 description => DESC,
90             explanation => EXPL,
91             policy => __PACKAGE__,
92             };
93 26         57 last;
94             }
95             }
96             }
97             }
98              
99 10         44 return \@violations;
100             }
101              
102             1;
103