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