File Coverage

blib/lib/Module/CheckDep/Version.pm
Criterion Covered Total %
statement 74 74 100.0
branch 23 24 95.8
condition 9 9 100.0
subroutine 8 9 88.8
pod 1 1 100.0
total 115 117 98.2


line stmt bran cond sub pod time code
1             package Module::CheckDep::Version;
2              
3 2     2   54632 use 5.006;
  2         11  
4 2     2   10 use strict;
  2         4  
  2         34  
5 2     2   8 use warnings;
  2         2  
  2         64  
6 2     2   773 use version;
  2         3049  
  2         9  
7              
8             our $VERSION = '0.09';
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(check_deps);
13              
14 2     2   977 use MetaCPAN::Client;
  2         572433  
  2         1184  
15              
16             my $mc = MetaCPAN::Client->new(debug => 1);
17              
18             sub check_deps {
19 9     9 1 6037 my ($author, %args) = @_;
20              
21 9 100       38 die "check_deps() requires an \"AUTHOR\" param\n" if ! $author;
22              
23 8         20 my $module = $args{module};
24 8         19 my $all = $args{all};
25 8         19 my $custom_handler = $args{handler};
26 8         19 my $return = $args{return};
27 8 100       33 my $ignore_any = defined $args{ignore_any} ? $args{ignore_any} : 1;
28            
29 8         27 my $author_modules = _author_modules($author);
30              
31 8         1844806 my %needs_attention;
32              
33 8         19 for my $dist (keys %{ $author_modules }){
  8         103  
34 336 100 100     1125 next if $module && ($module ne $dist);
35              
36 172         989 $dist =~ s/::/-/g;
37              
38 172         998 my $release = $mc->release($dist);
39 172         46901433 my $deps = $release->{data}{dependency};
40              
41 172         640 for my $dep (@$deps){
42 1038         1693 my $dep_mod = $dep->{module};
43 1038         1614 my $dep_ver = $dep->{version};
44              
45 1038 100       2638 next if $dep_mod eq 'perl';
46            
47 894 100 100     3409 if ($ignore_any && $dep_ver == 0){
48 584         2724 next;
49             }
50              
51 310 100       1010 $dep_ver .= '.00' if $dep_ver !~ /\./;
52              
53 310 100 100     1187 next if ! $all && ! $author_modules->{$dep_mod};
54              
55 247         291 my $cur_ver;
56              
57 247 100       521 if ($author_modules->{$dep_mod}){
58 212         425 $cur_ver = $author_modules->{$dep_mod};
59             }
60             else {
61 35         64 my $dep_mod_normalized = $dep_mod;
62 35         141 $dep_mod_normalized =~ s/::/-/g;
63 35         71 my $dep_dist;
64              
65 35         72 my $dist_found_ok = eval {
66 35         158 $dep_dist = $mc->release($dep_mod_normalized);
67 31         9551472 1;
68             };
69              
70 35 100       1025594 next if ! $dist_found_ok;
71 31         1049 $cur_ver = $dep_dist->{data}{version};
72             }
73              
74 243         1549 $dep_ver = version->parse($dep_ver);
75 243         1054 $cur_ver = version->parse($cur_ver);
76              
77 243 100       1329 if ($dep_ver != $cur_ver){
78 157         615 $needs_attention{$dist}{$dep_mod}{cur_ver} = $cur_ver;
79 157         837 $needs_attention{$dist}{$dep_mod}{dep_ver} = $dep_ver;
80             }
81             }
82             }
83              
84 8 100       68 if (defined $custom_handler){
85 1         7 $custom_handler->(\%needs_attention);
86             }
87             else {
88 7 50       24 _display(\%needs_attention) if ! $return;
89             }
90              
91 8         44884 return \%needs_attention;
92             }
93             sub _author_modules {
94 8     8   18 my ($author) = @_;
95              
96 8         47 my $query = {
97             all => [
98             { author => $author },
99             { status => 'latest' },
100             ],
101             };
102              
103 8         30 my $limit = {
104             '_source' => [
105             qw(distribution version)
106             ]
107             };
108              
109 8         33 my $releases = $mc->release($query, $limit);
110              
111 8         2497437 my %rel_info;
112              
113 8         41 while (my $rel = $releases->next){
114 336         1952094 my $dist = $rel->distribution;
115 336         3696 $dist =~ s/-/::/g;
116 336         4317 $rel_info{$dist} = $rel->version;
117             }
118              
119 8         298 return \%rel_info;
120             }
121             sub _display {
122 1     1   794 my $dists = shift;
123              
124 1         4 for my $dist (keys %$dists){
125 1         5 print "$dist:\n";
126 1         2 for (keys %{ $dists->{$dist} }){
  1         4  
127 1         10 print "\t$_:\n" .
128             "\t\t$dists->{$dist}{$_}{dep_ver} -> " .
129             "$dists->{$dist}{$_}{cur_ver}\n";
130             }
131 1         3 print "\n";
132             }
133             }
134       0     sub __placeholder {} # vim folds
135              
136             1;
137             __END__