File Coverage

blib/lib/Perl/Lint/Policy/ValuesAndExpressions/RequireUpperCaseHeredocTerminator.pm
Criterion Covered Total %
statement 28 28 100.0
branch 6 6 100.0
condition 8 9 88.8
subroutine 6 6 100.0
pod 0 1 0.0
total 48 50 96.0


line stmt bran cond sub pod time code
1             package Perl::Lint::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator;
2 134     134   69889 use strict;
  134         173  
  134         3016  
3 134     134   470 use warnings;
  134         150  
  134         2454  
4 134     134   787 use Perl::Lint::Constants::Type;
  134         152  
  134         61981  
5 134     134   578 use parent "Perl::Lint::Policy";
  134         152  
  134         553  
6              
7             use constant {
8 134         26021 DESC => 'Heredoc terminator must be quoted',
9             EXPL => [64],
10 134     134   6726 };
  134         161  
11              
12             sub evaluate {
13 10     10 0 14 my ($class, $file, $tokens, $args) = @_;
14              
15 10         9 my @violations;
16 10         28 for (my $i = 0; my $token = $tokens->[$i]; $i++) {
17 104         67 my $token_type = $token->{type};
18              
19             # XXX workaround
20             # Compiler::Lexer cannot recognize heredoc tag as bare word and lowercase
21             # https://github.com/goccy/p5-Compiler-Lexer/issues/37
22             #
23             # e.g.
24             # <
25 104         67 my $is_before_left_shift = 0;
26 104 100       114 if ($token_type == LEFT_SHIFT) {
27 8         9 $token = $tokens->[++$i];
28 8         9 $token_type = $token->{type};
29 8         5 $is_before_left_shift = 1;
30             }
31              
32 104 100 100     397 if (
      100        
      66        
33             $token_type == HERE_DOCUMENT_TAG ||
34             $token_type == HERE_DOCUMENT_RAW_TAG ||
35             ($is_before_left_shift && $token_type == KEY)
36             ) {
37 7 100       22 if ($token->{data} =~ /[a-z]/) {
38             push @violations, {
39             filename => $file,
40             line => $token->{line},
41 4         20 description => DESC,
42             explanation => EXPL,
43             policy => __PACKAGE__,
44             };
45             }
46             }
47             }
48              
49 10         28 return \@violations;
50             }
51              
52             1;
53