File Coverage

blib/lib/Module/CheckDep/Version.pm
Criterion Covered Total %
statement 67 74 90.5
branch 23 24 95.8
condition 9 9 100.0
subroutine 7 9 77.7
pod 1 1 100.0
total 107 117 91.4


line stmt bran cond sub pod time code
1             package Module::CheckDep::Version;
2              
3 2     2   17300 use 5.006;
  2         11  
4 2     2   16 use strict;
  2         6  
  2         50  
5 2     2   12 use warnings;
  2         16  
  2         61  
6 2     2   1175 use version;
  2         4475  
  2         14  
7              
8             our $VERSION = '0.08';
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(check_deps);
13              
14 2     2   1463 use MetaCPAN::Client;
  2         905599  
  2         1385  
15              
16             my $mc = MetaCPAN::Client->new;
17              
18             sub check_deps {
19 8     8 1 10643 my ($author, %args) = @_;
20              
21 8 100       74 die "check_deps() requires an \"AUTHOR\" param\n" if ! $author;
22              
23 7         34 my $module = $args{module};
24 7         29 my $all = $args{all};
25 7         33 my $custom_handler = $args{handler};
26 7         28 my $return = $args{return};
27 7 100       42 my $ignore_any = defined $args{ignore_any} ? $args{ignore_any} : 1;
28            
29 7         38 my $author_modules = _author_modules($author);
30              
31 7         1886176 my %needs_attention;
32              
33 7         24 for my $dist (keys %{ $author_modules }){
  7         114  
34 273 100 100     1737 next if $module && ($module ne $dist);
35              
36 159         1454 $dist =~ s/::/-/g;
37              
38 159         1418 my $release = $mc->release($dist);
39 159         71742608 my $deps = $release->{data}{dependency};
40              
41 159         826 for my $dep (@$deps){
42 974         3176 my $dep_mod = $dep->{module};
43 974         2439 my $dep_ver = $dep->{version};
44              
45 974 100       4364 next if $dep_mod eq 'perl';
46            
47 843 100 100     7516 if ($ignore_any && $dep_ver == 0){
48 555         3714 next;
49             }
50              
51 288 100       1781 $dep_ver .= '.00' if $dep_ver !~ /\./;
52              
53 288 100 100     2276 next if ! $all && ! $author_modules->{$dep_mod};
54              
55 236         578 my $cur_ver;
56              
57 236 100       924 if ($author_modules->{$dep_mod}){
58 205         598 $cur_ver = $author_modules->{$dep_mod};
59             }
60             else {
61 31         97 my $dep_mod_normalized = $dep_mod;
62 31         178 $dep_mod_normalized =~ s/::/-/g;
63 31         94 my $dep_dist;
64              
65 31         96 my $dist_found_ok = eval {
66 31         189 $dep_dist = $mc->release($dep_mod_normalized);
67 28         13016192 1;
68             };
69              
70 31 100       1215994 next if ! $dist_found_ok;
71 28         1232 $cur_ver = $dep_dist->{data}{version};
72             }
73              
74 233         2408 $dep_ver = version->parse($dep_ver);
75 233         1667 $cur_ver = version->parse($cur_ver);
76              
77 233 100       2315 if ($dep_ver != $cur_ver){
78 137         923 $needs_attention{$dist}{$dep_mod}{cur_ver} = $cur_ver;
79 137         1416 $needs_attention{$dist}{$dep_mod}{dep_ver} = $dep_ver;
80             }
81             }
82             }
83              
84 7 100       118 if (defined $custom_handler){
85 1         11 $custom_handler->(\%needs_attention);
86             }
87             else {
88 6 50       34 _display(\%needs_attention) if ! $return;
89             }
90              
91 7         72902 return \%needs_attention;
92             }
93             sub _author_modules {
94 7     7   104 my ($author) = @_;
95              
96 7         77 my $query = {
97             all => [
98             { author => $author },
99             { status => 'latest' },
100             ],
101             };
102              
103 7         47 my $limit = {
104             '_source' => [
105             qw(distribution version)
106             ]
107             };
108              
109 7         55 my $releases = $mc->release($query, $limit);
110              
111 7         2257809 my %rel_info;
112              
113 7         55 while (my $rel = $releases->next){
114 273         2377625 my $dist = $rel->distribution;
115 273         6038 $dist =~ s/-/::/g;
116 273         7244 $rel_info{$dist} = $rel->version;
117             }
118              
119 7         374 return \%rel_info;
120             }
121             sub _display {
122 0     0     my $dists = shift;
123              
124 0           for my $dist (keys %$dists){
125 0           print "$dist:\n";
126 0           for (keys %{ $dists->{$dist} }){
  0            
127 0           print "\t$_:\n" .
128             "\t\t$dists->{$dist}{$_}{dep_ver} -> " .
129             "$dists->{$dist}{$_}{cur_ver}\n";
130             }
131 0           print "\n";
132             }
133             }
134       0     sub __placeholder {} # vim folds
135              
136             1;
137             __END__