File Coverage

blib/lib/Perl/Lint/Policy/Objects/IndirectSyntax.pm
Criterion Covered Total %
statement 35 35 100.0
branch 5 6 83.3
condition 13 15 86.6
subroutine 8 8 100.0
pod 0 1 0.0
total 61 65 93.8


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::Objects::IndirectSyntax;
2 134     134   68417 use strict;
  134         178  
  134         3149  
3 134     134   403 use warnings;
  134         150  
  134         3318  
4 134     134   394 use List::Util 1.38 qw/any/;
  134         3710  
  134         6200  
5 134     134   938 use Perl::Lint::Constants::Type;
  134         149  
  134         57686  
6 134     134   543 use parent "Perl::Lint::Policy";
  134         165  
  134         551  
7              
8             use constant {
9 134         30604 DESC => 'Subroutine "%s" called using indirect syntax',
10             EXPL => [349],
11 134     134   6629 };
  134         157  
12              
13             sub evaluate {
14 7     7 0 16 my ($class, $file, $tokens, $src, $args) = @_;
15              
16 7         16 my @forbidden = ('new');
17 7         18 my $forbid_arg = $args->{indirect_syntax}->{forbid};
18 7 100 66     29 if ($forbid_arg && ref $forbid_arg eq 'ARRAY') {
19 1         1 push @forbidden, @{$forbid_arg};
  1         3  
20             }
21              
22 7         9 my @violations;
23 7         13 my $token_num = scalar @$tokens;
24 7         22 for (my $i = 0; $i < $token_num; $i++) {
25 262         202 my $token = $tokens->[$i];
26 262         232 my $token_data = $token->{data};
27 262 100 100 83   683 if ($token->{type} == KEY && any { $token_data eq $_ } @forbidden) {
  83         223  
28 22         40 my $token_type = $tokens->[++$i]->{type};
29 22 50 100     135 if ($token_type == KEY ||
      100        
      66        
30             $token_type == GLOBAL_VAR ||
31             $token_type == VAR ||
32             $token_type == LEFT_BRACE
33             ) {
34             push @violations, {
35             filename => $file,
36             line => $token->{line},
37 22         789 description => sprintf(DESC, $token_data),
38             explanation => sprintf(EXPL, $token_data),
39             policy => __PACKAGE__,
40             };
41             }
42             }
43             }
44              
45 7         31 return \@violations;
46             }
47              
48             1;
49