File Coverage

blib/lib/CPAN/Dashboard.pm
Criterion Covered Total %
statement 39 90 43.3
branch 0 14 0.0
condition 0 16 0.0
subroutine 13 14 92.8
pod n/a
total 52 134 38.8


.*?!mgs) {
line stmt bran cond sub pod time code
1             package CPAN::Dashboard;
2             $CPAN::Dashboard::VERSION = '0.02';
3 1     1   438 use 5.010;
  1         2  
  1         33  
4 1     1   448 use Moo;
  1         10917  
  1         4  
5 1     1   1551 use JSON qw(decode_json);
  1         2  
  1         6  
6 1     1   177 use Carp;
  1         1  
  1         53  
7 1     1   457 use PAUSE::Packages;
  1         79461  
  1         34  
8 1     1   545 use PAUSE::Permissions;
  1         18631  
  1         33  
9 1     1   7 use HTTP::Tiny;
  1         1  
  1         14  
10 1     1   3 use JSON;
  1         1  
  1         9  
11 1     1   689 use CPAN::ReverseDependencies;
  1         47145  
  1         31  
12 1     1   594 use CPAN::Testers::WWW::Reports::Query::AJAX;
  1         167815  
  1         43  
13              
14 1     1   556 use CPAN::Dashboard::Distribution;
  1         3  
  1         39  
15 1     1   574 use CPAN::Dashboard::Distribution::Kwalitee;
  1         17  
  1         28  
16 1     1   341 use CPAN::Dashboard::Distribution::CPANTesters;
  1         2  
  1         727  
17              
18             has 'author' => ( is => 'ro' );
19             has 'distribution_names' => ( is => 'ro' );
20             has 'distributions' => ( is => 'lazy' );
21              
22             sub _build_distributions
23             {
24 0     0     my $self = shift;
25 0           my @dist_names;
26 0           my $iterator = PAUSE::Packages->new()->release_iterator(well_formed => 1);
27 0           my $ua = HTTP::Tiny->new();
28 0           my %distmap;
29 0           my ($url, $response, $dist);
30 0           my %owner;
31              
32 0           while (my $release = $iterator->next_release) {
33 0           my $distinfo = $release->distinfo;
34 0           next unless ($self->author && $distinfo->cpanid eq $self->author)
35             || ( $self->distribution_names
36 0 0 0       && grep { $distinfo->dist eq $_ } @{ $self->distribution_names });
  0   0        
      0        
37 0           $dist = CPAN::Dashboard::Distribution->new(
38             name => $distinfo->dist,
39             release_path => $release->path,
40             version => $distinfo->version,
41             is_developer => $distinfo->maturity eq 'developer',
42             distinfo => $distinfo,
43             modules => $release->modules,
44             );
45 0           $distmap{ $distinfo->dist } = $dist;
46              
47             # by setting this, we identify all modules associated with this dashboard
48 0 0         if (defined($release->modules)) {
49 0           $owner{$_->name} = undef for @{ $release->modules};
  0            
50             }
51             }
52              
53             # get and set counts of bugs and reverse dependencies
54 0           my $revua = CPAN::ReverseDependencies->new();
55 0           foreach my $distname (keys %distmap) {
56 0           $dist = $distmap{$distname};
57 0           $url = sprintf('https://api.metacpan.org/distribution/%s', $distname);
58 0           $response = $ua->get($url);
59              
60 0 0         if (!$response->{success}) {
61 0           warn "Failed to get bug count for dist '$distname'\n";
62             }
63             else {
64 0           my $bug_data = decode_json($response->{content});
65 0   0       $dist->bug_count($bug_data->{bugs}->{active} // 0);
66             }
67              
68             #
69             # Count of reverse dependencies
70             # TODO: changes this to a list of dist names?
71             #
72 0           my @deps = $revua->get_reverse_dependencies($distname);
73 0           $dist->rev_deps_count(int(@deps));
74              
75             #
76             # CPAN Testers stats
77             # TODO: possibly just put the ::AJAX instance, rather than our own class
78             #
79 0           my $testers = CPAN::Testers::WWW::Reports::Query::AJAX->new(dist => $distname);
80 0 0         if (!defined($testers)) {
81 0           warn "Failed to get CPAN Testers results for dist '$distname'\n";
82             }
83             else {
84 0           $dist->cpan_testers(CPAN::Dashboard::Distribution::CPANTesters->new(
85             passes => $testers->pass,
86             fails => $testers->fail,
87             na => $testers->na,
88             unknowns => $testers->unknown,
89             ));
90             }
91              
92             #
93             # Kwalitee
94             # TODO: get the individual kwalitee fields
95             #
96 0           $url = sprintf('http://cpants.cpanauthors.org/dist/%s', $distname);
97 0           $response = $ua->get($url);
98              
99 0 0 0       if ($response->{success}
100             && $response->{content} =~ m!
Kwalitee(.*?)
Core Kwalitee(.*?)
101 0           $dist->kwalitee(CPAN::Dashboard::Distribution::Kwalitee->new(
102             kwalitee => $1,
103             core_kwalitee => $2,
104             ));
105             }
106             else {
107 0           warn "Failed to get Kwalitee results for dist '$distname'\n";
108             }
109              
110             }
111              
112             # First we get the owner for every module we're interested in
113 0           $iterator = PAUSE::Permissions->new()->module_iterator();
114 0           while (my $module = $iterator->next_module) {
115 0 0         next unless exists($owner{$module->name});
116 0 0         $owner{$module->name} = $module->owner if defined($module->owner);
117             }
118              
119 0           foreach my $distname (keys %distmap) {
120 0           my %seen;
121 0           $dist = $distmap{$distname};
122 0           foreach my $module (@{ $dist->modules }) {
  0            
123 0   0       $seen{ $owner{$module->name} // '__undef' } = 1;
124             }
125 0           print STDERR "OWNER $distname: ", join(', ', keys %seen), "\n";
126 0           $dist->owner( [keys %seen] );
127             }
128              
129 0           return [sort { $a->rating <=> $b->rating } values %distmap];
  0            
130             }
131              
132             1;
133              
134             =head1 NAME
135              
136             CPAN::Dashboard - generate a dashboard of information about a selection of CPAN dists
137              
138             =head1 SYNOPSIS
139              
140             use CPAN::Dashboard;
141              
142             my $dashboard = CPAN::Dashboard->new(author => 'NEILB');
143             foreach my $dist (@{ $dashboard->distributions }) {
144             ...
145             }
146              
147             =head1 DESCRIPTION
148              
149             CPAN::Dashboard constructs a list of I objects,
150             which can then be used to construct a CPAN dashboard.
151             You either specify a CPAN author, in which case all the author's
152             current dists are used,
153             or you pass a list of distribution names.
154              
155             =head1 REPOSITORY
156              
157             L
158              
159             =head1 AUTHOR
160              
161             Neil Bowers Eneilb@cpan.orgE
162              
163             =head1 COPYRIGHT AND LICENSE
164              
165             This software is copyright (c) 2014 by Neil Bowers .
166              
167             This is free software; you can redistribute it and/or modify it under
168             the same terms as the Perl 5 programming language system itself.
169