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   71563 use strict;
  2         9  
  2         50  
4 2     2   8 use warnings;
  2         4  
  2         50  
5 2     2   9 use Exporter 5.57 'import';
  2         40  
  2         64  
6 2     2   891 use Module::CPANfile;
  2         28060  
  2         57  
7 2     2   934 use Perl::PrereqScanner::NotQuiteLite::App;
  2         60458  
  2         70  
8 2     2   565 use Test::More;
  2         59547  
  2         38  
9              
10             our $VERSION = '0.08';
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 279 my %args = @_;
28              
29 1   50     9 my $cpanfile = delete $args{cpanfile} || 'cpanfile';
30 1 50       17 plan skip_all => "$cpanfile is not found" if !-f $cpanfile;
31              
32 1         7 my $declared = _load_cpanfile($cpanfile);
33              
34 1         16 my $scanner = Perl::PrereqScanner::NotQuiteLite::App->new(
35             parsers => [':installed'],
36             exclude_core => 1,
37             %args,
38             print => 0,
39             );
40              
41 1         95 my $prereqs = $scanner->run;
42              
43 1         1365610 my $index = $scanner->index;
44 1         6 my %uri_cache;
45 1         3 for my $phase (sort $prereqs->phases) {
46 4         67 for my $type (sort $prereqs->types_in($phase)) {
47 12         1643 my $req = $prereqs->requirements_for($phase, $type);
48 12         516 my $declared_req = $declared->merged_requirements($Phases{$phase}, $Types{$type});
49              
50 12         6283 my %uri_map;
51 12 50       38 if ($index) {
52 12         33 for my $module ($declared_req->required_modules) {
53 48 50       147 next if $module eq 'perl';
54 48   66     118 my $uri = $uri_cache{$module} ||= do {
55 8         44 my $res = $index->search_packages({ package => $module });
56 8 50       606794 $res ? $res->{uri} : undef;
57             };
58 48 50       173 $uri_map{$uri} = $module if $uri;
59             }
60             }
61              
62 12         52 for my $module (sort $req->required_modules) {
63 7         1717 my $required_version = $req->requirements_for_module($module);
64 7         426 my $declared_version = $declared_req->requirements_for_module($module);
65 7 100 66     247 if ($required_version and $required_version =~ /^[0-9._]+$/) {
    100          
66 2   33     14 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         24 pass "$module ($phase $type) is declared";
72             } else {
73 2         7 my $uri;
74 2 50       8 if ($index) {
75 2   33     10 $uri = $uri_cache{$module} ||= do {
76 2         21 my $res = $index->search_packages({ package => $module });
77 2 50       79337 $res ? $res->{uri} : undef;
78             };
79             }
80 2 50 33     47 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         8 my $data = Module::CPANfile->load($file);
90 1         57 my $prereqs = $data->prereqs;
91 1         1199 for my $feature ($data->features) {
92 0         0 $prereqs = $prereqs->with_merged_prereqs($feature->prereqs);
93             }
94 1         18 $prereqs;
95             }
96              
97             1;
98              
99             __END__