File Coverage

blib/lib/Perl/Lint/Policy/InputOutput/ProhibitTwoArgOpen.pm
Criterion Covered Total %
statement 62 63 98.4
branch 27 30 90.0
condition 36 42 85.7
subroutine 7 7 100.0
pod 0 1 0.0
total 132 143 92.3


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::InputOutput::ProhibitTwoArgOpen;
2 133     133   69398 use strict;
  133         192  
  133         3087  
3 133     133   433 use warnings;
  133         165  
  133         2382  
4 133     133   834 use Perl::Lint::Constants::Type;
  133         161  
  133         59331  
5 133     133   963 use Perl::Lint::Constants::Kind;
  133         222  
  133         6433  
6 133     133   546 use parent "Perl::Lint::Policy";
  133         175  
  133         571  
7              
8             use constant {
9 133         61768 DESC => 'Two-argument "open" used',
10             EXPL => [207],
11 133     133   6482 };
  133         176  
12              
13             sub evaluate {
14 7     7 0 12 my ($class, $file, $tokens, $src, $args) = @_;
15              
16 7         7 my @violations;
17 7         21 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
18 125         83 my $token_type = $token->{type};
19 125         93 my $token_data = $token->{data};
20              
21 125 100 100     394 if ($token_type == USE_DECL) {
    100          
22             # Skip when `use (<=5.005)`
23 2         4 $i++;
24 2         3 my $token = $tokens->[$i];
25 2         2 my $token_type = $token->{type};
26 2         3 my $token_data = $token->{data};
27 2 50       5 if ($token_type == DOUBLE) {
28 2         3 $token_data =~ s/_//g;
29 2 100       11 if ($token_data <= 5.005) {
30 1         5 return [];
31             }
32             }
33             }
34             elsif ($token_type == BUILTIN_FUNC && $token_data eq 'open') {
35 55         71 $i++;
36 55         79 my $token = $tokens->[$i];
37 55         39 my $token_type = $token->{type};
38              
39 55 100       59 if ($token_type == LEFT_PAREN) {
40 31         27 my $left_paren_num = 1;
41 31         18 my @args;
42 31         48 for ($i++; my $token = $tokens->[$i]; $i++) {
43 177         135 my $token_type = $token->{type};
44 177         101 my $token_kind = $token->{kind};
45              
46 177 50 100     899 if ($token_type == LEFT_PAREN) {
    100 100        
    100 100        
      100        
47 0         0 $left_paren_num++;
48             }
49             elsif ($token_type == RIGHT_PAREN) {
50 31 50       48 last if --$left_paren_num <= 0;
51             }
52             elsif (
53             $token_type != COMMA &&
54             $token_type != REG_DOUBLE_QUOTE &&
55             $token_type != REG_QUOTE &&
56             $token_type != REG_DELIM &&
57             $token_kind != KIND_DECL
58             ) {
59 83         164 push @args, $token->{data};
60             }
61             }
62 31 100       73 if (scalar @args < 3) {
63 16         12 my $second = $args[1];
64 16 100 66     94 if (
      33        
65             $second &&
66             (
67             $second eq '-|' || $second eq '|-' ||
68             $second =~ /STD(?:OUT|ERR|IN)\Z/
69             )
70             ) {
71 4         10 next;
72             }
73              
74             push @violations, {
75             filename => $file,
76             line => $token->{line},
77 12         56 description => DESC,
78             explanation => EXPL,
79             policy => __PACKAGE__,
80             };
81             }
82             }
83             else {
84 24         18 my @args;
85 24         35 for (; my $token = $tokens->[$i]; $i++) {
86 139         91 my $token_type = $token->{type};
87 139         84 my $token_kind = $token->{kind};
88 139 100 100     800 if ($token_kind == KIND_STMT_END || $token_kind == KIND_OP) {
    100 100        
      100        
      100        
      100        
89 24         16 last;
90             }
91             elsif (
92             $token_type != COMMA &&
93             $token_type != REG_DOUBLE_QUOTE &&
94             $token_type != REG_QUOTE &&
95             $token_type != REG_DELIM &&
96             $token_kind != KIND_DECL
97             ) {
98 55         123 push @args, $token->{data};
99             }
100             }
101 24 100       46 if (scalar @args < 3) {
102 17         16 my $second = $args[1];
103 17 100 66     83 if (
      33        
104             $second &&
105             (
106             $second eq '-|' || $second eq '|-' ||
107             $second =~ /STD(?:OUT|ERR|IN)\Z/
108             )
109             ) {
110 5         11 next;
111             }
112             push @violations, {
113             filename => $file,
114             line => $token->{line},
115 12         60 description => DESC,
116             explanation => EXPL,
117             policy => __PACKAGE__,
118             };
119             }
120             }
121             }
122             }
123              
124 6         23 return \@violations;
125             }
126              
127             1;
128