File Coverage

lib/CPANPLUS/Module/Author.pm
Criterion Covered Total %
statement 52 55 94.5
branch 9 16 56.2
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 77 87 88.5


line stmt bran cond sub pod time code
1             package CPANPLUS::Module::Author;
2              
3 15     15   222 use strict;
  15         209  
  15         290  
4              
5 15     15   1049 use CPANPLUS::Error;
  15         244  
  15         270  
6 15     15   286 use Params::Check qw[check];
  15         147  
  15         338  
7 15     15   284 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  15         139  
  15         393  
8              
9             local $Params::Check::VERBOSE = 1;
10              
11             =pod
12            
13             =head1 NAME
14            
15             CPANPLUS::Module::Author
16            
17             =head1 SYNOPSIS
18            
19             my $author = CPANPLUS::Module::Author->new(
20             author => 'Jack Ashton',
21             cpanid => 'JACKASH',
22             _id => INTERNALS_OBJECT_ID,
23             );
24            
25             $author->cpanid;
26             $author->author;
27             $author->email;
28            
29             @dists = $author->distributions;
30             @mods = $author->modules;
31            
32             @accessors = CPANPLUS::Module::Author->accessors;
33            
34             =head1 DESCRIPTION
35            
36             C<CPANPLUS::Module::Author> creates objects from the information in the
37             source files. These can then be used to query on.
38            
39             These objects should only be created internally. For C<fake> objects,
40             there's the C<CPANPLUS::Module::Author::Fake> class.
41            
42             =head1 ACCESSORS
43            
44             An objects of this class has the following accessors:
45            
46             =over 4
47            
48             =item author
49            
50             Name of the author.
51            
52             =item cpanid
53            
54             The CPAN id of the author.
55            
56             =item email
57            
58             The email address of the author, which defaults to '' if not provided.
59            
60             =item parent
61            
62             The C<CPANPLUS::Internals::Object> that spawned this module object.
63            
64             =back
65            
66             =cut
67              
68             my $tmpl = {
69                 author => { required => 1 }, # full name of the author
70                 cpanid => { required => 1 }, # cpan id
71                 email => { default => '' }, # email address of the author
72                 _id => { required => 1 }, # id of the Internals object that spawned us
73             };
74              
75             ### autogenerate accessors ###
76             for my $key ( keys %$tmpl ) {
77 15     15   258     no strict 'refs';
  15         142  
  15         288  
78                 *{__PACKAGE__."::$key"} = sub {
79 155     155   2813         my $self = shift;
80 155 50       1695         $self->{$key} = $_[0] if @_;
81 155         3774         return $self->{$key};
82                 }
83             }
84              
85             sub parent {
86 10     10 1 117     my $self = shift;
87 10         717     my $obj = CPANPLUS::Internals->_retrieve_id( $self->_id );
88              
89 10         255     return $obj;
90             }
91              
92             =pod
93            
94             =head1 METHODS
95            
96             =head2 $auth = CPANPLUS::Module::Author->new( author => AUTHOR_NAME, cpanid => CPAN_ID, _id => INTERNALS_ID [, email => AUTHOR_EMAIL] )
97            
98             This method returns a C<CPANPLUS::Module::Author> object, based on the given
99             parameters.
100            
101             Returns false on failure.
102            
103             =cut
104              
105             sub new {
106 202     202 1 2297     my $class = shift;
107 202         3383     my %hash = @_;
108              
109             ### don't check the template for sanity
110             ### -- we know it's good and saves a lot of performance
111 202         5805     local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
112              
113 202 50       2697     my $object = check( $tmpl, \%hash ) or return;
114              
115 202         8174     return bless $object, $class;
116             }
117              
118             =pod
119            
120             =head2 @mod_objs = $auth->modules()
121            
122             Return a list of module objects this author has released.
123            
124             =cut
125              
126             sub modules {
127 9     9 1 294     my $self = shift;
128 9         572     my $cb = $self->parent;
129              
130 9         1219     my $aref = $cb->_search_module_tree(
131                                 type => 'author',
132                                 allow => [$self],
133                             );
134 9 50       362     return @$aref if $aref;
135 0         0     return;
136             }
137              
138             =pod
139            
140             =head2 @dists = $auth->distributions()
141            
142             Returns a list of module objects representing all the distributions
143             this author has released.
144            
145             =cut
146              
147             sub distributions {
148 2     2 1 21     my $self = shift;
149 2         21     my %hash = @_;
150              
151 2         19     local $Params::Check::ALLOW_UNKNOWN = 1;
152 2         20     local $Params::Check::NO_DUPLICATES = 1;
153              
154 2         16     my $mod;
155 2         28     my $tmpl = {
156                     module => { default => '', store => \$mod },
157                 };
158              
159 2 50       29     my $args = check( $tmpl, \%hash ) or return;
160              
161             ### if we didn't get a module object passed, we'll find one ourselves ###
162 2 100       24     unless( $mod ) {
163 1         204         my @list = $self->modules;
164 1 50       57         if( @list ) {
165 1         64             $mod = $list[0];
166                     } else {
167 0         0             error( loc( "This author has released no modules" ) );
168 0         0             return;
169                     }
170                 }
171              
172 2         82     my $file = $mod->checksums( %hash );
173 2 50       257     my $href = $mod->_parse_checksums_file( file => $file ) or return;
174              
175 2         173     my @rv;
176 2         113     for my $dist ( keys %$href ) {
177 4         144         my $clone = $mod->clone;
178              
179 4         91         $clone->package( $dist );
180 4         158         $clone->module( $clone->package_name );
181 4         75         $clone->version( $clone->package_version );
182              
183             ### .meta files are now also in the checksums file,
184             ### which means we have to filter out things that dont
185             ### match our regex
186 4 50       71         push @rv, $clone if $clone->package_extension;
187                 }
188              
189 2         267     return @rv;
190             }
191              
192              
193             =pod
194            
195             =head1 CLASS METHODS
196            
197             =head2 accessors ()
198            
199             Returns a list of all accessor methods to the object
200            
201             =cut
202              
203 32     32 1 797 sub accessors { return keys %$tmpl };
204              
205             1;
206              
207             # Local variables:
208             # c-indentation-style: bsd
209             # c-basic-offset: 4
210             # indent-tabs-mode: nil
211             # End:
212             # vim: expandtab shiftwidth=4:
213