File Coverage

blib/lib/App/perlvars.pm
Criterion Covered Total %
statement 67 69 97.1
branch 17 22 77.2
condition 1 3 33.3
subroutine 10 10 100.0
pod 1 2 50.0
total 96 106 90.5


line stmt bran cond sub pod time code
1             package App::perlvars;
2              
3 15     15   46397 use Moo;
  15         169392  
  15         94  
4 15     15   43189 use autodie;
  15         324558  
  15         80  
5              
6             our $VERSION = '0.000006';
7              
8 15     15   145504 use Path::Tiny qw( path );
  15         315005  
  15         1536  
9 15     15   11674 use PPI::Document ();
  15         3158635  
  15         661  
10 15     15   9323 use Test::Vars import => [qw( test_vars )];
  15         1778119  
  15         260  
11              
12             has ignore_file => (
13             is => 'ro',
14             predicate => '_has_ignore_file',
15             );
16              
17             has _ignore_for_package => (
18             is => 'ro',
19             init_arg => undef,
20             lazy => 1,
21             builder => '_build_ignore_for_package',
22             );
23              
24             sub BUILD {
25 18     18 0 1812731 my $self = shift;
26              
27             # We need to read the file before we start checking anything so we can die
28             # if it contains bad lines and not have it look like a failure in a
29             # particular file we're tidying.
30 18         526 $self->_ignore_for_package;
31              
32 18         111 return;
33             }
34              
35             sub validate_file {
36 20     20 1 53 my $self = shift;
37 20         177 my $file = path(shift);
38 20 100       1761 unless ( $file->exists ) {
39 2         244 return ( 1, "$file could not be found" );
40             }
41 18 100       1166 if ( $file->is_dir ) {
42 1         13 return ( 1, "$file is a dir" );
43             }
44              
45 17         386 my $doc = PPI::Document->new("$file");
46 17 50       491535 return ( 1, "$file could not be parsed as Perl" ) unless $doc;
47              
48 17 100       214 my $package_stmt = $doc->find_first('PPI::Statement::Package')
49             or return ( 0, "$file contains no package" );
50              
51             my ( $exit_code, @msgs ) = test_vars(
52             "$file",
53             \&_result_handler,
54 16 100       4870 %{ $self->_ignore_for_package->{ $package_stmt->namespace } || {} },
  16         666  
55             );
56              
57 9         618 return $exit_code, undef, @msgs;
58             }
59              
60             sub _build_ignore_for_package {
61 18     18   374 my $self = shift;
62              
63 18 100       177 return {} unless $self->_has_ignore_file;
64              
65 5         15 my %vars;
66             my %regexes;
67              
68 5         80 my $file = path( $self->ignore_file );
69 5         441 my @lines = $file->lines( { chomp => 1 } );
70 5         1819 for my $line (@lines) {
71 20 50       85 next unless $line =~ /\S/;
72              
73 20         101 my ( $package, $ignore ) = split( /\s*=\s*/, $line );
74 20 50 33     100 unless ( defined $package && defined $ignore ) {
75 0         0 die 'Invalid line in ' . $self->ignore_file . ": $line\n";
76             }
77              
78 20 100       58 if ( $ignore =~ m{^qr} ) {
79 5         12 local $@ = undef;
80             ## no critic (BuiltinFunctions::ProhibitStringyEval)
81 5         771 $ignore = eval $ignore;
82             ## use critic
83 5 50       45 die $@ if $@;
84              
85 5         12 push @{ $regexes{$package} }, $ignore;
  5         33  
86             }
87             else {
88 15         25 push @{ $vars{$package} }, $ignore;
  15         55  
89             }
90             }
91              
92 5         16 my %ignore;
93 5         20 for my $package ( keys %regexes ) {
94 5         15 my @re = @{ $regexes{$package} };
  5         20  
95             $ignore{$package}{ignore_if} = sub {
96 2     2   3175 my $check = shift;
97 2         57 for my $re (@re) {
98 2 50       110 return 1 if $check =~ /$re/;
99             }
100 0         0 return 0;
101 5         49 };
102             }
103              
104 5         17 for my $package ( keys %vars ) {
105 5         12 $ignore{$package}{ignore_vars}{$_} = 1 for @{ $vars{$package} };
  5         48  
106             }
107              
108 5         73 return \%ignore;
109             }
110              
111             sub _result_handler {
112 9     9   3489073 shift;
113 9         134 my $exit_code = shift;
114 9         81 my $results = shift;
115              
116 9         200 my @errors = map { $_->[1] } grep { $_->[0] eq 'diag' } @{$results};
  12         71  
  21         170  
  9         127  
117 9         769 return $exit_code, @errors;
118             }
119              
120             1;
121              
122             =pod
123              
124             =encoding UTF-8
125              
126             =head1 NAME
127              
128             App::perlvars - CLI tool to detect unused variables in Perl modules
129              
130             =head1 VERSION
131              
132             version 0.000006
133              
134             =head1 DESCRIPTION
135              
136             You probably don't want to use this class directly. See L<perlvars> for
137             documentation on how to use the command line interface.
138              
139             =head2 ignore_file
140              
141             The path to a file containing a list of variables to ignore on a per-package
142             basis. The pattern is C<Module::Name = $variable> or C<Module::Name = qr/some
143             regex/>. For example:
144              
145             Local::Unused = $unused
146             Local::Unused = $one
147             Local::Unused = $two
148             Local::Unused = qr/^\$.*hree$/
149              
150             =head2 validate_file
151              
152             Path to a file which will be validated. Returns an exit code, an error message
153             and a list of unused variables.
154              
155             =head1 AUTHOR
156              
157             Olaf Alders <olaf@wundercounter.com>
158              
159             =head1 COPYRIGHT AND LICENSE
160              
161             This software is copyright (c) 2022 by MaxMind, Inc.
162              
163             This is free software; you can redistribute it and/or modify it under
164             the same terms as the Perl 5 programming language system itself.
165              
166             =cut
167              
168             __END__
169              
170             # ABSTRACT: CLI tool to detect unused variables in Perl modules
171              
172