File Coverage

lib/CPANPLUS/Module/Author.pm
Criterion Covered Total %
statement 59 62 95.1
branch 10 16 62.5
condition n/a
subroutine 13 13 100.0
pod 5 5 100.0
total 87 96 90.6


line stmt bran cond sub pod time code
1             package CPANPLUS::Module::Author;
2              
3 20     20   142 use strict;
  20         45  
  20         1080  
4              
5 20     20   132 use CPANPLUS::Error;
  20         45  
  20         1398  
6 20     20   163 use CPANPLUS::Internals::Constants;
  20         51  
  20         7181  
7 20     20   188 use Params::Check qw[check];
  20         45  
  20         1033  
8 20     20   141 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  20         46  
  20         164  
9 20     20   5263 use vars qw[$VERSION];
  20         46  
  20         2185  
10             $VERSION = "0.9914";
11              
12             local $Params::Check::VERBOSE = 1;
13              
14             =pod
15              
16             =head1 NAME
17              
18             CPANPLUS::Module::Author - CPAN author object for CPANPLUS
19              
20             =head1 SYNOPSIS
21              
22             my $author = CPANPLUS::Module::Author->new(
23             author => 'Jack Ashton',
24             cpanid => 'JACKASH',
25             _id => INTERNALS_OBJECT_ID,
26             );
27              
28             $author->cpanid;
29             $author->author;
30             $author->email;
31              
32             @dists = $author->distributions;
33             @mods = $author->modules;
34              
35             @accessors = CPANPLUS::Module::Author->accessors;
36              
37             =head1 DESCRIPTION
38              
39             C creates objects from the information in the
40             source files. These can then be used to query on.
41              
42             These objects should only be created internally. For C objects,
43             there's the C class.
44              
45             =head1 ACCESSORS
46              
47             An objects of this class has the following accessors:
48              
49             =over 4
50              
51             =item author
52              
53             Name of the author.
54              
55             =item cpanid
56              
57             The CPAN id of the author.
58              
59             =item email
60              
61             The email address of the author, which defaults to '' if not provided.
62              
63             =item parent
64              
65             The C that spawned this module object.
66              
67             =back
68              
69             =cut
70              
71             my $tmpl = {
72             author => { required => 1 }, # full name of the author
73             cpanid => { required => 1 }, # cpan id
74             email => { default => '' }, # email address of the author
75             _id => { required => 1 }, # id of the Internals object that spawned us
76             };
77              
78             ### autogenerate accessors ###
79             for my $key ( keys %$tmpl ) {
80 20     20   148 no strict 'refs';
  20         66  
  20         13091  
81             *{__PACKAGE__."::$key"} = sub {
82 193     193   2187 my $self = shift;
83 193 50       475 $self->{$key} = $_[0] if @_;
84 193         1034 return $self->{$key};
85             }
86             }
87              
88             sub parent {
89 6     6 1 24 my $self = shift;
90 6         44 my $obj = CPANPLUS::Internals->_retrieve_id( $self->_id );
91              
92 6         36 return $obj;
93             }
94              
95             =pod
96              
97             =head1 METHODS
98              
99             =head2 $auth = CPANPLUS::Module::Author->new( author => AUTHOR_NAME, cpanid => CPAN_ID, _id => INTERNALS_ID [, email => AUTHOR_EMAIL] )
100              
101             This method returns a C object, based on the given
102             parameters.
103              
104             Returns false on failure.
105              
106             =cut
107              
108             sub new {
109 224     224 1 713 my $class = shift;
110 224         1217 my %hash = @_;
111              
112             ### don't check the template for sanity
113             ### -- we know it's good and saves a lot of performance
114 224         857 local $Params::Check::SANITY_CHECK_TEMPLATE = 0;
115              
116 224 50       1679 my $object = check( $tmpl, \%hash ) or return;
117              
118 224         32056 return bless $object, $class;
119             }
120              
121             =pod
122              
123             =head2 @mod_objs = $auth->modules()
124              
125             Return a list of module objects this author has released.
126              
127             =cut
128              
129             sub modules {
130 5     5 1 19 my $self = shift;
131 5         80 my $cb = $self->parent;
132              
133 5         57 my $aref = $cb->_search_module_tree(
134             type => 'author',
135             ### XXX, depending on backend, this is either an object
136             ### or the cpanid string. Don't know an elegant way to
137             ### solve this right now, so passing both
138             allow => [$self, $self->cpanid],
139             );
140 5 50       54 return @$aref if $aref;
141 0         0 return;
142             }
143              
144             =pod
145              
146             =head2 @dists = $auth->distributions()
147              
148             Returns a list of module objects representing all the distributions
149             this author has released.
150              
151             =cut
152              
153             sub distributions {
154 2     2 1 696 my $self = shift;
155 2         13 my %hash = @_;
156              
157 2         12 local $Params::Check::ALLOW_UNKNOWN = 1;
158 2         17 local $Params::Check::NO_DUPLICATES = 1;
159              
160 2         10 my $mod;
161 2         19 my $tmpl = {
162             module => { default => '', store => \$mod },
163             };
164              
165 2 50       20 my $args = check( $tmpl, \%hash ) or return;
166              
167             ### if we didn't get a module object passed, we'll find one ourselves ###
168 2 100       138 unless( $mod ) {
169 1         8 my @list = $self->modules;
170 1 50       5 if( @list ) {
171 1         12 $mod = $list[0];
172             } else {
173 0         0 error( loc( "This author has released no modules" ) );
174 0         0 return;
175             }
176             }
177              
178 2         28 my $file = $mod->checksums( %hash );
179 2 50       215 my $href = $mod->_parse_checksums_file( file => $file ) or return;
180              
181 2         8 my @rv;
182 2         21 for my $name ( keys %$href ) {
183              
184             ### shortcut asap, so we avoid extra ops. On big checksums files
185             ### the call to clone() takes up a lot of time.
186             ### .meta files are now also in the checksums file,
187             ### which means we have to filter out things that don't
188             ### match our regex
189 8 100       51 next if $mod->package_extension( $name ) eq META_EXT;
190              
191             ### used to do this wiht ->clone. However, that calls ->dslip,
192             ### (which is wrong anyway, as we're doing a different module),
193             ### which in turn calls ->contains, which scans the entire
194             ### module tree using _search_module_tree, which uses P::C
195             ### and is therefor VERY VERY slow.
196             ### so let's do this the direct way for speed ups.
197             my $dist = CPANPLUS::Module::Fake->new(
198 6         29 module => do { my $m = $mod->package_name( $name );
199 6         33 $m =~ s/-/::/g; $m;
  6         24  
200             },
201             version => $mod->package_version( $name ),
202             package => $name,
203             path => $mod->path, # same author after all
204             author => $mod->author, # same author after all
205 6         13 mtime => $href->{$name}->{'mtime'}, # release date
206             );
207              
208 6         19 push @rv, $dist;
209             }
210              
211 2         24 return @rv;
212             }
213              
214              
215             =pod
216              
217             =head1 CLASS METHODS
218              
219             =head2 accessors ()
220              
221             Returns a list of all accessor methods to the object
222              
223             =cut
224              
225 166     166 1 1470 sub accessors { return keys %$tmpl };
226              
227             1;
228              
229             # Local variables:
230             # c-indentation-style: bsd
231             # c-basic-offset: 4
232             # indent-tabs-mode: nil
233             # End:
234             # vim: expandtab shiftwidth=4: