File Coverage

lib/Acme/CPANAuthors.pm
Criterion Covered Total %
statement 74 91 81.3
branch 23 44 52.2
condition 3 3 100.0
subroutine 14 16 87.5
pod 10 10 100.0
total 124 164 75.6


line stmt bran cond sub pod time code
1             package Acme::CPANAuthors;
2              
3 7     7   100572 use strict;
  7         16  
  7         196  
4 7     7   36 use warnings;
  7         15  
  7         209  
5 7     7   43 use Carp;
  7         11  
  7         649  
6 7     7   3546 use Acme::CPANAuthors::Utils qw( cpan_authors cpan_packages );
  7         16  
  7         9004  
7              
8             our $VERSION = '0.26';
9              
10             sub new {
11 3     3 1 633 my ($class, @categories) = @_;
12              
13 3 50       16 @categories = _list_categories() unless @categories;
14              
15 3         8 my %authors;
16 3         10 foreach my $category ( @categories ) {
17 3         39 %authors = ( %authors, _get_authors_of($category) );
18             }
19              
20             bless {
21 3         21 categories => \@categories,
22             authors => \%authors,
23             }, $class;
24             }
25              
26             sub count {
27 2     2 1 15 my $self = shift;
28              
29 2         4 return scalar keys %{ $self->{authors} };
  2         18  
30             }
31              
32             sub id {
33 4     4 1 1389 my ($self, $id) = @_;
34              
35 4 100       14 unless ( $id ) {
36 2         4 my @ids = sort keys %{ $self->{authors} };
  2         13  
37 2         9 return @ids;
38             }
39             else {
40 2 50       14 return $self->{authors}{$id} ? 1 : 0;
41             }
42             }
43              
44             sub name {
45 5     5 1 2261 my ($self, $id) = @_;
46              
47 5 100       18 unless ( $id ) {
48 2         3 return sort values %{ $self->{authors} };
  2         12  
49             }
50             else {
51 3         28 return $self->{authors}{$id};
52             }
53             }
54              
55             sub categories {
56 2     2 1 512 my $self = shift;
57 2         4 return @{$self->{categories}};
  2         10  
58             }
59              
60             sub distributions {
61 0     0 1 0 my ($self, $id) = @_;
62              
63 0 0       0 return unless $id;
64              
65 0         0 my @packages;
66 0         0 foreach my $package ( cpan_packages->distributions ) {
67 0 0       0 if ( $package->cpanid eq $id ) {
68 0         0 push @packages, $package;
69             }
70             }
71              
72 0         0 return @packages;
73             }
74              
75             sub latest_distributions {
76 0     0 1 0 my ($self, $id) = @_;
77              
78 0 0       0 return unless $id;
79              
80 0         0 my @packages;
81 0         0 foreach my $package ( cpan_packages->latest_distributions ) {
82 0 0       0 if ( $package->cpanid eq $id ) {
83 0         0 push @packages, $package;
84             }
85             }
86              
87 0         0 return @packages;
88             }
89              
90             sub avatar_url {
91 1     1 1 8 my ($self, $id, %options) = @_;
92              
93 1 50       4 return unless $id;
94              
95 1 50       1 eval {require Gravatar::URL; 1}
  1         5  
  1         4  
96             or warn($@), return;
97 1 50       7 my $author = cpan_authors->author($id) or return;
98              
99 1         3 my $default = delete $options{default};
100 1 50       6 return Gravatar::URL::gravatar_url(
101             email => $author->email,
102             %options,
103             default => Gravatar::URL::gravatar_url(
104             # Fall back to the CPAN address, as used by metacpan, which will in
105             # turn fall back to a generated image.
106             email => $id . '@cpan.org',
107             %options,
108             $default ? ( default => $default ) : (),
109             ),
110             );
111             }
112              
113             sub kwalitee {
114 1     1 1 14 my ($self, $id) = @_;
115              
116 1 50       4 return unless $id;
117              
118 1         703 require Acme::CPANAuthors::Utils::Kwalitee;
119 1         13 return Acme::CPANAuthors::Utils::Kwalitee->fetch($id);
120             }
121              
122             sub look_for {
123 5     5 1 3206 my ($self, $id_or_name) = @_;
124              
125 5 50       21 return unless defined $id_or_name;
126 5 100       17 unless (ref $id_or_name eq 'Regexp') {
127 4         57 $id_or_name = qr/$id_or_name/i;
128             }
129              
130 5         8 my @found;
131 5 50       15 my @categories = ref $self ? @{ $self->{categories} } : ();
  0         0  
132 5 50       25 @categories = _list_categories() unless @categories;
133 5         2020 foreach my $category ( @categories ) {
134 10         29 my %authors = _get_authors_of($category);
135 10         44 while ( my ($id, $name) = each %authors ) {
136 10 100 100     122 if ($id =~ /$id_or_name/ or $name =~ /$id_or_name/) {
137 5         47 push @found, {
138             id => $id,
139             name => $name,
140             category => $category,
141             };
142             }
143             }
144             }
145 5         34 return @found;
146             }
147              
148             sub _list_categories {
149 5     5   1621 require Module::Find;
150 25         86 return grep { $_ !~ /^(?:Register|Utils|Not|Search|Factory)$/ }
151 5         1766 map { s/^Acme::CPANAuthors:://; $_ }
  25         16496  
  25         52  
152             Module::Find::findsubmod( 'Acme::CPANAuthors' );
153             }
154              
155             sub _get_authors_of {
156 13     13   114 my $category = shift;
157              
158 13         23 $category =~ s/^Acme::CPANAuthors:://;
159              
160 13 50       62 return if $category =~ /^(?:Register|Utils|Search)$/;
161              
162 13         33 my $package = "Acme::CPANAuthors\::$category";
163 13 100       158 unless ($package->can('authors')) {
164 4         331 eval "require $package";
165 4 50       66 if ( $@ ) {
166 0         0 carp "$category CPAN Authors are not registered yet: $@";
167 0         0 return;
168             }
169             # some may actually lack 'authors' interface
170 4 50       67 return unless $package->can('authors');
171             }
172 13         66 $package->authors;
173             }
174              
175             1;
176              
177             __END__