File Coverage

lib/App/cpanm/meta/checker.pm
Criterion Covered Total %
statement 30 94 31.9
branch 0 12 0.0
condition n/a
subroutine 10 26 38.4
pod 9 9 100.0
total 49 141 34.7


line stmt bran cond sub pod time code
1 1     1   7650 use 5.008; # utf8
  1         5  
  1         86  
2 1     1   7 use strict;
  1         3  
  1         46  
3 1     1   17 use warnings;
  1         2  
  1         42  
4 1     1   1305 use utf8;
  1         12  
  1         6  
5              
6             package App::cpanm::meta::checker;
7             $App::cpanm::meta::checker::VERSION = '0.001001';
8             # ABSTRACT: Verify and sanity check your installation verses cpanm meta files
9              
10             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
11              
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76              
77              
78              
79              
80              
81              
82              
83 1     1   10397 use Moo 1.000008 ('has');
  1         49436  
  1         9  
84 1     1   33258 use Path::Tiny qw( path );
  1         34978  
  1         99  
85 1     1   822 use App::cpanm::meta::checker::State;
  1         4  
  1         49  
86 1     1   8 use Config qw(%Config);
  1         2  
  1         44  
87 1     1   6 use Carp qw(croak);
  1         2  
  1         67  
88 1     1   1659 use Getopt::Long;
  1         12941  
  1         7  
89              
90              
91              
92              
93              
94             has 'search_dirs' => (
95             is => 'ro',
96             lazy => 1,
97             builder => sub {
98 0     0     my @paths;
99 0           push @paths, path( $Config{sitelibexp} )->child( $Config{archname} )->child('.meta');
100 0           return \@paths;
101             },
102             );
103              
104              
105              
106              
107              
108              
109              
110              
111              
112             sub all_search_dirs {
113 0     0 1   my ($self) = @_;
114 0           return @{ $self->search_dirs };
  0            
115             }
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126              
127              
128              
129              
130             sub all_search_dir_child {
131 0     0 1   my ( $self, @childpath ) = @_;
132 0           my @answers = grep { -e $_ }
  0            
133 0           map { path($_)->child(@childpath) } @{ $self->search_dirs };
  0            
134 0 0         return @answers unless $self->sorted;
135 0           return @{ [ sort @answers ] };
  0            
136             }
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147              
148              
149              
150              
151              
152              
153             sub all_search_dir_children {
154 0     0 1   my ($self) = @_;
155 0           my @answers = map { path($_)->children } @{ $self->search_dirs };
  0            
  0            
156 0 0         return @answers unless $self->sorted;
157 0           return @{ [ sort @answers ] };
  0            
158             }
159              
160              
161              
162              
163              
164              
165              
166              
167              
168              
169              
170              
171              
172              
173             has 'tests' => (
174             is => ro =>,
175             lazy => 1,
176             builder => sub {
177             return [
178 0     0     'list_empty', 'list_duplicates', 'check_runtime_requires',
179             'check_runtime_recommends', 'check_runtime_suggests', 'check_runtime_conflicts',
180             ];
181             },
182             );
183              
184              
185              
186              
187              
188              
189              
190              
191              
192              
193              
194              
195              
196              
197              
198             has 'sorted' => (
199             is => ro =>,
200             lazy => 1,
201 0     0     builder => sub { return; },
202             );
203              
204              
205              
206              
207              
208              
209              
210              
211              
212              
213              
214              
215              
216             has 'mode' => (
217             is => ro =>,
218             lazy => 1,
219 0     0     builder => sub { return 'all' },
220             );
221              
222              
223              
224              
225              
226              
227              
228              
229              
230             sub check_path {
231 0     0 1   my ( $self, $path ) = @_;
232 0           my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
233 0           return $state->check_path($path);
234             }
235              
236              
237              
238              
239              
240              
241              
242              
243              
244             sub check_release {
245 0     0 1   my ( $self, $releasename ) = @_;
246 0           my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
247 0           for my $dir ( $self->all_search_dir_child($releasename) ) {
248 0           $state->check_path($dir);
249             }
250 0           return;
251             }
252              
253              
254              
255              
256              
257              
258              
259              
260              
261              
262              
263             sub check_distname {
264 0     0 1   my ( $self, $distname ) = @_;
265 0           my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
266              
267             ## no critic (Compatibility::PerlMinimumVersionAndWhy)
268             # _Pulp__5010_qr_m_propagate_properly
269 0           my $distname_re = qr{
270             \A
271             \Q$distname\E
272             -
273             [^-]+
274             (?:TRIAL)?
275             \z
276             }msx;
277              
278 0           for my $dir ( grep { path($_)->basename =~ $distname_re } $self->all_search_dir_children ) {
  0            
279 0           $state->check_path($dir);
280             }
281 0           return;
282             }
283              
284              
285              
286              
287              
288              
289              
290              
291              
292             sub check_all {
293 0     0 1   my ($self) = @_;
294              
295 0           my $state = App::cpanm::meta::checker::State->new( tests => $self->tests );
296 0           for my $dir ( $self->all_search_dir_children ) {
297 0           $state->check_path($dir);
298             }
299 0           return;
300             }
301              
302              
303              
304              
305              
306              
307              
308              
309              
310             sub run_command {
311 0     0 1   my ($self) = @_;
312 0 0         return $self->check_all if 'all' eq $self->mode;
313 0           return;
314             }
315              
316              
317              
318              
319              
320              
321              
322              
323              
324              
325              
326              
327              
328              
329              
330              
331              
332              
333              
334              
335              
336              
337              
338              
339              
340              
341              
342              
343              
344              
345              
346              
347              
348             sub new_from_command {
349 0     0 1   my ( $class, %defaults ) = @_;
350              
351 0           my $config = {};
352 0           my $verbose;
353              
354 0           Getopt::Long::Configure( 'auto_version', 'auto_help' );
355              
356             Getopt::Long::GetOptions(
357             's|sort!' => \$config->{sorted},
358 0     0     'A|all!' => sub { $config->{mode} = 'all' },
359             'verbose!' => sub {
360 0     0     $verbose = $_[0];
361             },
362             'test=s' => sub {
363 0 0   0     if ( not App::cpanm::meta::checker::State->can( 'x_test_' . $_[1] ) ) {
364 0           croak("No such test $_[1]");
365             }
366 0           push @{ $config->{tests} }, $_[1];
  0            
367             },
368 0 0         ) or croak(Getopt::Long::HelpMessage);
369              
370 0           my $app_obj = $class->new( +{ %defaults, %{$config} } );
  0            
371 0 0         if ($verbose) {
372 0           unshift @{ $app_obj->tests }, 'list';
  0            
373             }
374 0           return $app_obj;
375             }
376             1;
377              
378             __END__