File Coverage

lib/Test/CPANfile.pm
Criterion Covered Total %
statement 55 56 98.2
branch 12 20 60.0
condition 11 24 45.8
subroutine 8 8 100.0
pod 1 1 100.0
total 87 109 79.8


line stmt bran cond sub pod time code
1             package Test::CPANfile;
2              
3 2     2   81177 use strict;
  2         10  
  2         56  
4 2     2   14 use warnings;
  2         3  
  2         59  
5 2     2   13 use Exporter 5.57 'import';
  2         52  
  2         71  
6 2     2   987 use Module::CPANfile;
  2         32992  
  2         69  
7 2     2   1100 use Perl::PrereqScanner::NotQuiteLite::App;
  2         69101  
  2         83  
8 2     2   653 use Test::More;
  2         63259  
  2         21  
9              
10             our $VERSION = '0.07';
11             our @EXPORT = qw/cpanfile_has_all_used_modules/;
12              
13             my %Phases = (
14             develop => [qw/runtime build test configure develop/],
15             runtime => [qw/runtime/],
16             build => [qw/runtime build/],
17             test => [qw/runtime build test/],
18             configure => [qw/configure/],
19             );
20             my %Types = (
21             requires => [qw/requires/],
22             recommends => [qw/requires recommends/],
23             suggests => [qw/requires recommends suggests/],
24             );
25              
26             sub cpanfile_has_all_used_modules {
27 1     1 1 325 my %args = @_;
28              
29 1   50     8 my $cpanfile = delete $args{cpanfile} || 'cpanfile';
30 1 50       20 plan skip_all => "$cpanfile is not found" if !-f $cpanfile;
31              
32 1         8 my $declared = _load_cpanfile($cpanfile);
33              
34 1         14 my $scanner = Perl::PrereqScanner::NotQuiteLite::App->new(
35             parsers => [':installed'],
36             exclude_core => 1,
37             %args,
38             print => 0,
39             );
40              
41 1         98 my $prereqs = $scanner->run;
42              
43 1         1149170 my $index = $scanner->index;
44 1         6 my %uri_cache;
45 1         4 for my $phase (sort $prereqs->phases) {
46 3         64 for my $type (sort $prereqs->types_in($phase)) {
47 9         1812 my $req = $prereqs->requirements_for($phase, $type);
48 9         490 my $declared_req = $declared->merged_requirements($Phases{$phase}, $Types{$type});
49              
50 9         5323 my %uri_map;
51 9 50       37 if ($index) {
52 9         26 for my $module ($declared_req->required_modules) {
53 36 50       137 next if $module eq 'perl';
54 36   66     112 my $uri = $uri_cache{$module} ||= do {
55 8         44 my $res = $index->search_packages({ package => $module });
56 8 50       202397 $res ? $res->{uri} : undef;
57             };
58 36 50       161 $uri_map{$uri} = $module if $uri;
59             }
60             }
61              
62 9         43 for my $module (sort $req->required_modules) {
63 7         1948 my $required_version = $req->requirements_for_module($module);
64 7         399 my $declared_version = $declared_req->requirements_for_module($module);
65 7 100 66     269 if ($required_version and $required_version =~ /^[0-9._]+$/) {
    100          
66 2   33     15 ok((defined $declared_version and $req->accepts_module($module, $required_version)),
      50        
      50        
67             sprintf "$module %s ($phase $type) is declared and satisfies minimum version (%s)",
68             $required_version || 0, $declared_version || 0
69             );
70             } elsif (defined $declared_version) {
71 3         28 pass "$module ($phase $type) is declared";
72             } else {
73 2         4 my $uri;
74 2 50       9 if ($index) {
75 2   33     11 $uri = $uri_cache{$module} ||= do {
76 2         22 my $res = $index->search_packages({ package => $module });
77 2 50       50059 $res ? $res->{uri} : undef;
78             };
79             }
80 2 50 33     44 ok($uri && $uri_map{$uri}, "$module ($phase $type) is declared" . ($uri && $uri_map{$uri} ? " (as $uri_map{$uri})" : ""));
      33        
81             }
82             }
83             }
84             }
85             }
86              
87             sub _load_cpanfile {
88 1     1   3 my $file = shift;
89 1         7 my $data = Module::CPANfile->load($file);
90 1         73 my $prereqs = $data->prereqs;
91 1         1508 for my $feature ($data->features) {
92 0         0 $prereqs = $prereqs->with_merged_prereqs($feature->prereqs);
93             }
94 1         20 $prereqs;
95             }
96              
97             1;
98              
99             __END__