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