File Coverage

lib/Acme/CPANAuthors.pm
Criterion Covered Total %
statement 66 91 72.5
branch 19 44 43.1
condition 3 3 100.0
subroutine 13 16 81.2
pod 10 10 100.0
total 111 164 67.6


line stmt bran cond sub pod time code
1             package Acme::CPANAuthors;
2              
3 7     7   68846 use strict;
  7         14  
  7         236  
4 7     7   29 use warnings;
  7         7  
  7         189  
5 7     7   32 use Carp;
  7         9  
  7         544  
6 7     7   2533 use Acme::CPANAuthors::Utils qw( cpan_authors cpan_packages );
  7         10  
  7         7075  
7              
8             our $VERSION = '0.25';
9              
10             sub new {
11 2     2 1 23 my ($class, @categories) = @_;
12              
13 2 50       6 @categories = _list_categories() unless @categories;
14              
15 2         4 my %authors;
16 2         4 foreach my $category ( @categories ) {
17 2         27 %authors = ( %authors, _get_authors_of($category) );
18             }
19              
20             bless {
21 2         12 categories => \@categories,
22             authors => \%authors,
23             }, $class;
24             }
25              
26             sub count {
27 2     2 1 10 my $self = shift;
28              
29 2         2 return scalar keys %{ $self->{authors} };
  2         15  
30             }
31              
32             sub id {
33 4     4 1 1213 my ($self, $id) = @_;
34              
35 4 100       11 unless ( $id ) {
36 2         3 my @ids = sort keys %{ $self->{authors} };
  2         11  
37 2         8 return @ids;
38             }
39             else {
40 2 50       12 return $self->{authors}{$id} ? 1 : 0;
41             }
42             }
43              
44             sub name {
45 5     5 1 1401 my ($self, $id) = @_;
46              
47 5 100       15 unless ( $id ) {
48 2         3 return sort values %{ $self->{authors} };
  2         11  
49             }
50             else {
51 3         20 return $self->{authors}{$id};
52             }
53             }
54              
55             sub categories {
56 2     2 1 516 my $self = shift;
57 2         4 return @{$self->{categories}};
  2         7  
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 0     0 1 0 my ($self, $id, %options) = @_;
92              
93 0 0       0 return unless $id;
94              
95 0 0       0 eval {require Gravatar::URL; 1}
  0         0  
  0         0  
96             or warn($@), return;
97 0 0       0 my $author = cpan_authors->author($id) or return;
98              
99 0         0 my $default = delete $options{default};
100 0 0       0 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 15 my ($self, $id) = @_;
115              
116 1 50       4 return unless $id;
117              
118 1         589 require Acme::CPANAuthors::Utils::Kwalitee;
119 1         20 return Acme::CPANAuthors::Utils::Kwalitee->fetch($id);
120             }
121              
122             sub look_for {
123 5     5 1 2073 my ($self, $id_or_name) = @_;
124              
125 5 50       14 return unless defined $id_or_name;
126 5 100       13 unless (ref $id_or_name eq 'Regexp') {
127 4         55 $id_or_name = qr/$id_or_name/i;
128             }
129              
130 5         6 my @found;
131 5 50       13 my @categories = ref $self ? @{ $self->{categories} } : ();
  0         0  
132 5 50       18 @categories = _list_categories() unless @categories;
133 5         11 foreach my $category ( @categories ) {
134 10         20 my %authors = _get_authors_of($category);
135 10         25 while ( my ($id, $name) = each %authors ) {
136 10 100 100     80 if ($id =~ /$id_or_name/ or $name =~ /$id_or_name/) {
137 5         29 push @found, {
138             id => $id,
139             name => $name,
140             category => $category,
141             };
142             }
143             }
144             }
145 5         18 return @found;
146             }
147              
148             sub _list_categories {
149 5     5   490 require Module::Find;
150 25         51 return grep { $_ !~ /^(?:Register|Utils|Not|Search|Factory)$/ }
  25         8914  
151 5         1148 map { s/^Acme::CPANAuthors:://; $_ }
  25         28  
152             Module::Find::findsubmod( 'Acme::CPANAuthors' );
153             }
154              
155             sub _get_authors_of {
156 12     12   14 my $category = shift;
157              
158 12         15 $category =~ s/^Acme::CPANAuthors:://;
159              
160 12 50       30 return if $category =~ /^(?:Register|Utils|Search)$/;
161              
162 12         20 my $package = "Acme::CPANAuthors\::$category";
163 12 100       79 unless ($package->can('authors')) {
164 3         167 eval "require $package";
165 3 50       31 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 3 50       43 return unless $package->can('authors');
171             }
172 12         36 $package->authors;
173             }
174              
175             1;
176              
177             __END__