File Coverage

blib/lib/Code/TidyAll/Plugin/Test/Vars.pm
Criterion Covered Total %
statement 48 77 62.3
branch 7 22 31.8
condition 0 3 0.0
subroutine 11 12 91.6
pod 1 2 50.0
total 67 116 57.7


line stmt bran cond sub pod time code
1             package Code::TidyAll::Plugin::Test::Vars;
2              
3 3     3   28566 use strict;
  3         3  
  3         72  
4 3     3   9 use warnings;
  3         3  
  3         60  
5 3     3   1428 use autodie;
  3         29847  
  3         15  
6              
7             our $VERSION = '0.03';
8              
9 3     3   13071 use Test::Vars 0.008;
  3         39774  
  3         24  
10 3     3   447 use Path::Class qw( dir );
  3         3  
  3         123  
11 3     3   1443 use PPI::Document;
  3         252021  
  3         108  
12              
13 3     3   18 use Moo;
  3         6  
  3         30  
14              
15             extends 'Code::TidyAll::Plugin';
16              
17             has ignore_file => (
18             is => 'ro',
19             predicate => '_has_ignore_file',
20             );
21              
22             has _ignore_for_package => (
23             is => 'ro',
24             init_arg => undef,
25             lazy => 1,
26             builder => '_build_ignore_for_package',
27             );
28              
29             sub BUILD {
30 5     5 0 20294 my $self = shift;
31              
32             # We need to read the file before we start checking anything so we can die
33             # if it contains bad lines and not have it look like a failure in a
34             # particular file we're tidying.
35 5         44 $self->_ignore_for_package;
36              
37 5         66 return;
38             }
39              
40             sub validate_source {
41 5     5 1 16811 my $self = shift;
42 5         11 my $source = shift;
43              
44 5         52 my $doc = PPI::Document->new( \$source );
45              
46             # Test::Vars only works with Perl code in a package anyway.
47 5 50       15494 my $package_stmt = $doc->find_first('PPI::Statement::Package')
48             or return;
49 5 50       940 my $package = $package_stmt->namespace
50             or return;
51              
52 5         142 my @path = split /::/, $package;
53 5         10 $path[-1] .= '.pm';
54              
55             ## no critic (Subroutines::ProtectPrivateSubs)
56 5         47 my $file = dir( $self->tidyall->_tempdir )->file( 'lib', @path );
57             ## use critic
58             ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
59 5         3629 $file->parent->mkpath( 0, 0755 );
60             ## use critic
61 5         649 $file->spew($source);
62              
63             return test_vars(
64             $file,
65             \&_result_handler,
66 5 50       1157 %{ $self->_ignore_for_package->{$package} || {} },
  5         119  
67             );
68             }
69              
70             sub _build_ignore_for_package {
71 5     5   929 my $self = shift;
72              
73 5 50       34 return {} unless $self->_has_ignore_file;
74              
75 0         0 my %vars;
76             my %regexes;
77              
78 0         0 open my $fh, '<', $self->ignore_file;
79 0         0 while (<$fh>) {
80 0 0       0 next unless /\S/;
81              
82 0         0 chomp;
83 0         0 my ( $package, $ignore ) = split /\s*=\s*/;
84 0 0 0     0 unless ( defined $package && defined $ignore ) {
85 0         0 die 'Invalid line in ' . $self->ignore_file . ": $_\n";
86             }
87              
88 0 0       0 if ( $ignore =~ m{^qr} ) {
89 0         0 local $@ = undef;
90             ## no critic (BuiltinFunctions::ProhibitStringyEval)
91 0         0 $ignore = eval $ignore;
92             ## use critic
93 0 0       0 die $@ if $@;
94              
95 0         0 push @{ $regexes{$package} }, $ignore;
  0         0  
96             }
97             else {
98 0         0 push @{ $vars{$package} }, $ignore;
  0         0  
99             }
100             }
101              
102 0         0 my %ignore;
103 0         0 for my $package ( keys %regexes ) {
104 0         0 my @re = @{ $regexes{$package} };
  0         0  
105             $ignore{$package}{ignore_if} = sub {
106 0     0   0 for my $re (@re) {
107 0 0       0 return 1 if $_ =~ /$re/;
108             }
109 0         0 return 0;
110 0         0 };
111             }
112              
113 0         0 for my $package ( keys %vars ) {
114 0         0 $ignore{$package}{ignore_vars}{$_} = 1 for @{ $vars{$package} };
  0         0  
115             }
116              
117 0         0 return \%ignore;
118             }
119              
120             sub _result_handler {
121 3     3   652946 shift;
122 3         23 my $exit_code = shift;
123 3         6 my $results = shift;
124              
125 3 100       197 return unless $exit_code;
126              
127 1         10 my @errors = map { $_->[1] } grep { $_->[0] eq 'diag' } @{$results};
  1         8  
  2         11  
  1         10  
128 1 50       9 die join q{}, map { " $_\n" } @errors if @errors;
  1         73  
129              
130 0           return;
131             }
132              
133             1;
134              
135             # ABSTRACT: Provides Test::Vars plugin for Code::TidyAll
136              
137             __END__