Commit | Line | Data |
---|---|---|
6aaee015 RGS |
1 | package CPANPLUS::Backend; |
2 | ||
3 | use strict; | |
4 | ||
5 | ||
6 | use CPANPLUS::Error; | |
7 | use CPANPLUS::Configure; | |
8 | use CPANPLUS::Internals; | |
9 | use CPANPLUS::Internals::Constants; | |
10 | use CPANPLUS::Module; | |
11 | use CPANPLUS::Module::Author; | |
12 | use CPANPLUS::Backend::RV; | |
13 | ||
14 | use FileHandle; | |
15 | use File::Spec (); | |
16 | use File::Spec::Unix (); | |
a3de5d0b | 17 | use File::Basename (); |
6aaee015 RGS |
18 | use Params::Check qw[check]; |
19 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; | |
20 | ||
21 | $Params::Check::VERBOSE = 1; | |
22 | ||
23 | use vars qw[@ISA $VERSION]; | |
24 | ||
25 | @ISA = qw[CPANPLUS::Internals]; | |
26 | $VERSION = $CPANPLUS::Internals::VERSION; | |
27 | ||
28 | ### mark that we're running under CPANPLUS to spawned processes | |
29 | $ENV{'PERL5_CPANPLUS_IS_RUNNING'} = $$; | |
30 | ||
31 | ### XXX version.pm MAY format this version, if it's in use... :( | |
32 | ### so for consistency, just call ->VERSION ourselves as well. | |
33 | $ENV{'PERL5_CPANPLUS_IS_VERSION'} = __PACKAGE__->VERSION; | |
34 | ||
35 | =pod | |
36 | ||
37 | =head1 NAME | |
38 | ||
39 | CPANPLUS::Backend | |
40 | ||
41 | =head1 SYNOPSIS | |
42 | ||
5bc5f6dc | 43 | my $cb = CPANPLUS::Backend->new; |
6aaee015 RGS |
44 | my $conf = $cb->configure_object; |
45 | ||
46 | my $author = $cb->author_tree('KANE'); | |
47 | my $mod = $cb->module_tree('Some::Module'); | |
48 | my $mod = $cb->parse_module( module => 'Some::Module' ); | |
49 | ||
50 | my @objs = $cb->search( type => TYPE, | |
51 | allow => [...] ); | |
52 | ||
53 | $cb->flush('all'); | |
54 | $cb->reload_indices; | |
55 | $cb->local_mirror; | |
56 | ||
57 | ||
58 | =head1 DESCRIPTION | |
59 | ||
60 | This module provides the programmer's interface to the C<CPANPLUS> | |
61 | libraries. | |
62 | ||
63 | =head1 ENVIRONMENT | |
64 | ||
65 | When C<CPANPLUS::Backend> is loaded, which is necessary for just | |
66 | about every <CPANPLUS> operation, the environment variable | |
67 | C<PERL5_CPANPLUS_IS_RUNNING> is set to the current process id. | |
68 | ||
69 | Additionally, the environment variable C<PERL5_CPANPLUS_IS_VERSION> | |
70 | will be set to the version of C<CPANPLUS::Backend>. | |
71 | ||
72 | This information might be useful somehow to spawned processes. | |
73 | ||
74 | =head1 METHODS | |
75 | ||
76 | =head2 $cb = CPANPLUS::Backend->new( [CONFIGURE_OBJ] ) | |
77 | ||
78 | This method returns a new C<CPANPLUS::Backend> object. | |
79 | This also initialises the config corresponding to this object. | |
80 | You have two choices in this: | |
81 | ||
82 | =over 4 | |
83 | ||
84 | =item Provide a valid C<CPANPLUS::Configure> object | |
85 | ||
86 | This will be used verbatim. | |
87 | ||
88 | =item No arguments | |
89 | ||
90 | Your default config will be loaded and used. | |
91 | ||
92 | =back | |
93 | ||
94 | New will return a C<CPANPLUS::Backend> object on success and die on | |
95 | failure. | |
96 | ||
97 | =cut | |
98 | ||
99 | sub new { | |
100 | my $class = shift; | |
101 | my $conf; | |
102 | ||
103 | if( $_[0] && IS_CONFOBJ->( conf => $_[0] ) ) { | |
104 | $conf = shift; | |
105 | } else { | |
106 | $conf = CPANPLUS::Configure->new() or return; | |
107 | } | |
108 | ||
109 | my $self = $class->SUPER::_init( _conf => $conf ); | |
110 | ||
111 | return $self; | |
112 | } | |
113 | ||
114 | =pod | |
115 | ||
116 | =head2 $href = $cb->module_tree( [@modules_names_list] ) | |
117 | ||
118 | Returns a reference to the CPANPLUS module tree. | |
119 | ||
120 | If you give it any arguments, they will be treated as module names | |
121 | and C<module_tree> will try to look up these module names and | |
122 | return the corresponding module objects instead. | |
123 | ||
124 | See L<CPANPLUS::Module> for the operations you can perform on a | |
125 | module object. | |
126 | ||
127 | =cut | |
128 | ||
129 | sub module_tree { | |
130 | my $self = shift; | |
131 | my $modtree = $self->_module_tree; | |
132 | ||
133 | if( @_ ) { | |
134 | my @rv; | |
135 | for my $name ( grep { defined } @_) { | |
5879cbe1 RGS |
136 | |
137 | ### From John Malmberg: This is failing on VMS | |
138 | ### because ODS-2 does not retain the case of | |
139 | ### filenames that are created. | |
140 | ### The problem is the filename is being converted | |
141 | ### to a module name and then looked up in the | |
142 | ### %$modtree hash. | |
143 | ### | |
144 | ### As a fix, we do a search on VMS instead -- | |
145 | ### more cpu cycles, but it gets around the case | |
146 | ### problem --kane | |
147 | my ($modobj) = do { | |
148 | ON_VMS | |
149 | ? $self->search( | |
150 | type => 'module', | |
151 | allow => [qr/^$name$/i], | |
152 | ) | |
153 | : $modtree->{$name} | |
154 | }; | |
155 | ||
156 | push @rv, $modobj || ''; | |
6aaee015 RGS |
157 | } |
158 | return @rv == 1 ? $rv[0] : @rv; | |
159 | } else { | |
160 | return $modtree; | |
161 | } | |
162 | } | |
163 | ||
164 | =pod | |
165 | ||
166 | =head2 $href = $cb->author_tree( [@author_names_list] ) | |
167 | ||
168 | Returns a reference to the CPANPLUS author tree. | |
169 | ||
170 | If you give it any arguments, they will be treated as author names | |
171 | and C<author_tree> will try to look up these author names and | |
172 | return the corresponding author objects instead. | |
173 | ||
174 | See L<CPANPLUS::Module::Author> for the operations you can perform on | |
175 | an author object. | |
176 | ||
177 | =cut | |
178 | ||
179 | sub author_tree { | |
180 | my $self = shift; | |
181 | my $authtree = $self->_author_tree; | |
182 | ||
183 | if( @_ ) { | |
184 | my @rv; | |
185 | for my $name (@_) { | |
186 | push @rv, $authtree->{$name} || ''; | |
187 | } | |
188 | return @rv == 1 ? $rv[0] : @rv; | |
189 | } else { | |
190 | return $authtree; | |
191 | } | |
192 | } | |
193 | ||
194 | =pod | |
195 | ||
5bc5f6dc | 196 | =head2 $conf = $cb->configure_object; |
6aaee015 RGS |
197 | |
198 | Returns a copy of the C<CPANPLUS::Configure> object. | |
199 | ||
200 | See L<CPANPLUS::Configure> for operations you can perform on a | |
201 | configure object. | |
202 | ||
203 | =cut | |
204 | ||
205 | sub configure_object { return shift->_conf() }; | |
206 | ||
207 | =head2 $su = $cb->selfupdate_object; | |
208 | ||
209 | Returns a copy of the C<CPANPLUS::Selfupdate> object. | |
210 | ||
211 | See the L<CPANPLUS::Selfupdate> manpage for the operations | |
212 | you can perform on the selfupdate object. | |
213 | ||
214 | =cut | |
215 | ||
216 | sub selfupdate_object { return shift->_selfupdate() }; | |
217 | ||
218 | =pod | |
219 | ||
220 | =head2 @mods = $cb->search( type => TYPE, allow => AREF, [data => AREF, verbose => BOOL] ) | |
221 | ||
222 | C<search> enables you to search for either module or author objects, | |
223 | based on their data. The C<type> you can specify is any of the | |
224 | accessors specified in C<CPANPLUS::Module::Author> or | |
225 | C<CPANPLUS::Module>. C<search> will determine by the C<type> you | |
226 | specified whether to search by author object or module object. | |
227 | ||
228 | You have to specify an array reference of regular expressions or | |
229 | strings to match against. The rules used for this array ref are the | |
230 | same as in C<Params::Check>, so read that manpage for details. | |
231 | ||
232 | The search is an C<or> search, meaning that if C<any> of the criteria | |
233 | match, the search is considered to be successful. | |
234 | ||
235 | You can specify the result of a previous search as C<data> to limit | |
236 | the new search to these module or author objects, rather than the | |
237 | entire module or author tree. This is how you do C<and> searches. | |
238 | ||
239 | Returns a list of module or author objects on success and false | |
240 | on failure. | |
241 | ||
242 | See L<CPANPLUS::Module> for the operations you can perform on a | |
243 | module object. | |
244 | See L<CPANPLUS::Module::Author> for the operations you can perform on | |
245 | an author object. | |
246 | ||
247 | =cut | |
248 | ||
249 | sub search { | |
250 | my $self = shift; | |
251 | my $conf = $self->configure_object; | |
252 | my %hash = @_; | |
253 | ||
5879cbe1 RGS |
254 | my ($type); |
255 | my $args = do { | |
256 | local $Params::Check::NO_DUPLICATES = 0; | |
257 | local $Params::Check::ALLOW_UNKNOWN = 1; | |
6aaee015 | 258 | |
5879cbe1 RGS |
259 | my $tmpl = { |
260 | type => { required => 1, allow => [CPANPLUS::Module->accessors(), | |
261 | CPANPLUS::Module::Author->accessors()], store => \$type }, | |
262 | allow => { required => 1, default => [ ], strict_type => 1 }, | |
263 | }; | |
6aaee015 | 264 | |
5879cbe1 RGS |
265 | check( $tmpl, \%hash ) |
266 | } or return; | |
6aaee015 RGS |
267 | |
268 | ### figure out whether it was an author or a module search | |
269 | ### when ambiguous, it'll be an author search. | |
270 | my $aref; | |
271 | if( grep { $type eq $_ } CPANPLUS::Module::Author->accessors() ) { | |
272 | $aref = $self->_search_author_tree( %$args ); | |
273 | } else { | |
274 | $aref = $self->_search_module_tree( %$args ); | |
275 | } | |
276 | ||
277 | return @$aref if $aref; | |
278 | return; | |
279 | } | |
280 | ||
281 | =pod | |
282 | ||
283 | =head2 $backend_rv = $cb->fetch( modules => \@mods ) | |
284 | ||
285 | Fetches a list of modules. C<@mods> can be a list of distribution | |
286 | names, module names or module objects--basically anything that | |
287 | L<parse_module> can understand. | |
288 | ||
289 | See the equivalent method in C<CPANPLUS::Module> for details on | |
290 | other options you can pass. | |
291 | ||
292 | Since this is a multi-module method call, the return value is | |
293 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
294 | that module's documentation on how to interpret the return value. | |
295 | ||
296 | =head2 $backend_rv = $cb->extract( modules => \@mods ) | |
297 | ||
298 | Extracts a list of modules. C<@mods> can be a list of distribution | |
299 | names, module names or module objects--basically anything that | |
300 | L<parse_module> can understand. | |
301 | ||
302 | See the equivalent method in C<CPANPLUS::Module> for details on | |
303 | other options you can pass. | |
304 | ||
305 | Since this is a multi-module method call, the return value is | |
306 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
307 | that module's documentation on how to interpret the return value. | |
308 | ||
309 | =head2 $backend_rv = $cb->install( modules => \@mods ) | |
310 | ||
311 | Installs a list of modules. C<@mods> can be a list of distribution | |
312 | names, module names or module objects--basically anything that | |
313 | L<parse_module> can understand. | |
314 | ||
315 | See the equivalent method in C<CPANPLUS::Module> for details on | |
316 | other options you can pass. | |
317 | ||
318 | Since this is a multi-module method call, the return value is | |
319 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
320 | that module's documentation on how to interpret the return value. | |
321 | ||
322 | =head2 $backend_rv = $cb->readme( modules => \@mods ) | |
323 | ||
324 | Fetches the readme for a list of modules. C<@mods> can be a list of | |
325 | distribution names, module names or module objects--basically | |
326 | anything that L<parse_module> can understand. | |
327 | ||
328 | See the equivalent method in C<CPANPLUS::Module> for details on | |
329 | other options you can pass. | |
330 | ||
331 | Since this is a multi-module method call, the return value is | |
332 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
333 | that module's documentation on how to interpret the return value. | |
334 | ||
335 | =head2 $backend_rv = $cb->files( modules => \@mods ) | |
336 | ||
337 | Returns a list of files used by these modules if they are installed. | |
338 | C<@mods> can be a list of distribution names, module names or module | |
339 | objects--basically anything that L<parse_module> can understand. | |
340 | ||
341 | See the equivalent method in C<CPANPLUS::Module> for details on | |
342 | other options you can pass. | |
343 | ||
344 | Since this is a multi-module method call, the return value is | |
345 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
346 | that module's documentation on how to interpret the return value. | |
347 | ||
348 | =head2 $backend_rv = $cb->distributions( modules => \@mods ) | |
349 | ||
350 | Returns a list of module objects representing all releases for this | |
351 | module on success. | |
352 | C<@mods> can be a list of distribution names, module names or module | |
353 | objects, basically anything that L<parse_module> can understand. | |
354 | ||
355 | See the equivalent method in C<CPANPLUS::Module> for details on | |
356 | other options you can pass. | |
357 | ||
358 | Since this is a multi-module method call, the return value is | |
359 | implemented as a C<CPANPLUS::Backend::RV> object. Please consult | |
360 | that module's documentation on how to interpret the return value. | |
361 | ||
362 | =cut | |
363 | ||
364 | ### XXX add direcotry_tree, packlist etc? or maybe remove files? ### | |
365 | for my $func (qw[fetch extract install readme files distributions]) { | |
366 | no strict 'refs'; | |
367 | ||
368 | *$func = sub { | |
369 | my $self = shift; | |
370 | my $conf = $self->configure_object; | |
371 | my %hash = @_; | |
372 | ||
6aaee015 | 373 | my ($mods); |
4443dd53 JB |
374 | my $args = do { |
375 | local $Params::Check::NO_DUPLICATES = 1; | |
376 | local $Params::Check::ALLOW_UNKNOWN = 1; | |
377 | ||
378 | my $tmpl = { | |
379 | modules => { default => [], strict_type => 1, | |
380 | required => 1, store => \$mods }, | |
381 | }; | |
6aaee015 | 382 | |
4443dd53 JB |
383 | check( $tmpl, \%hash ); |
384 | } or return; | |
6aaee015 RGS |
385 | |
386 | ### make them all into module objects ### | |
4443dd53 | 387 | my %mods = map { $_ => $self->parse_module(module => $_) || '' } @$mods; |
6aaee015 RGS |
388 | |
389 | my $flag; my $href; | |
390 | while( my($name,$obj) = each %mods ) { | |
391 | $href->{$name} = IS_MODOBJ->( mod => $obj ) | |
392 | ? $obj->$func( %$args ) | |
393 | : undef; | |
394 | ||
395 | $flag++ unless $href->{$name}; | |
396 | } | |
397 | ||
398 | return CPANPLUS::Backend::RV->new( | |
399 | function => $func, | |
400 | ok => !$flag, | |
401 | rv => $href, | |
402 | args => \%hash, | |
403 | ); | |
404 | } | |
405 | } | |
406 | ||
407 | =pod | |
408 | ||
a0995fd4 | 409 | =head2 $mod_obj = $cb->parse_module( module => $modname|$distname|$modobj|URI|PATH ) |
6aaee015 RGS |
410 | |
411 | C<parse_module> tries to find a C<CPANPLUS::Module> object that | |
412 | matches your query. Here's a list of examples you could give to | |
413 | C<parse_module>; | |
414 | ||
415 | =over 4 | |
416 | ||
417 | =item Text::Bastardize | |
418 | ||
419 | =item Text-Bastardize | |
420 | ||
421 | =item Text-Bastardize-1.06 | |
422 | ||
423 | =item AYRNIEU/Text-Bastardize | |
424 | ||
425 | =item AYRNIEU/Text-Bastardize-1.06 | |
426 | ||
427 | =item AYRNIEU/Text-Bastardize-1.06.tar.gz | |
428 | ||
429 | =item http://example.com/Text-Bastardize-1.06.tar.gz | |
430 | ||
431 | =item file:///tmp/Text-Bastardize-1.06.tar.gz | |
432 | ||
a0995fd4 JB |
433 | =item /tmp/Text-Bastardize-1.06 |
434 | ||
435 | =item ./Text-Bastardize-1.06 | |
436 | ||
437 | =item . | |
438 | ||
6aaee015 RGS |
439 | =back |
440 | ||
441 | These items would all come up with a C<CPANPLUS::Module> object for | |
442 | C<Text::Bastardize>. The ones marked explicitly as being version 1.06 | |
443 | would give back a C<CPANPLUS::Module> object of that version. | |
444 | Even if the version on CPAN is currently higher. | |
445 | ||
a0995fd4 JB |
446 | The last three are examples of PATH resolution. In the first, we supply |
447 | an absolute path to the unwrapped distribution. In the second the | |
448 | distribution is relative to the current working directory. | |
449 | In the third, we will use the current working directory. | |
450 | ||
6aaee015 RGS |
451 | If C<parse_module> is unable to actually find the module you are looking |
452 | for in its module tree, but you supplied it with an author, module | |
453 | and version part in a distribution name or URI, it will create a fake | |
454 | C<CPANPLUS::Module> object for you, that you can use just like the | |
455 | real thing. | |
456 | ||
457 | See L<CPANPLUS::Module> for the operations you can perform on a | |
458 | module object. | |
459 | ||
460 | If even this fancy guessing doesn't enable C<parse_module> to create | |
461 | a fake module object for you to use, it will warn about an error and | |
462 | return false. | |
463 | ||
464 | =cut | |
465 | ||
466 | sub parse_module { | |
467 | my $self = shift; | |
468 | my $conf = $self->configure_object; | |
469 | my %hash = @_; | |
470 | ||
471 | my $mod; | |
472 | my $tmpl = { | |
473 | module => { required => 1, store => \$mod }, | |
474 | }; | |
475 | ||
476 | my $args = check( $tmpl, \%hash ) or return; | |
477 | ||
478 | return $mod if IS_MODOBJ->( module => $mod ); | |
479 | ||
480 | ### ok, so it's not a module object, but a ref nonetheless? | |
481 | ### what are you smoking? | |
482 | if( ref $mod ) { | |
483 | error(loc("Can not parse module string from reference '%1'", $mod )); | |
484 | return; | |
485 | } | |
486 | ||
487 | ### check only for allowed characters in a module name | |
488 | unless( $mod =~ /[^\w:]/ ) { | |
489 | ||
490 | ### perhaps we can find it in the module tree? | |
491 | my $maybe = $self->module_tree($mod); | |
492 | return $maybe if IS_MODOBJ->( module => $maybe ); | |
493 | } | |
494 | ||
a0995fd4 JB |
495 | ### Special case arbitary file paths such as '.' etc. |
496 | if (-d File::Spec->rel2abs($mod) ) { | |
497 | my $dir = File::Spec->rel2abs($mod); | |
498 | my $parent = File::Spec->rel2abs( File::Spec->catdir( $dir, '..' ) ); | |
499 | ||
a3de5d0b JB |
500 | ### fix paths on VMS |
501 | if (ON_VMS) { | |
502 | $dir = VMS::Filespec::unixify($dir); | |
503 | $parent = VMS::Filespec::unixify($parent); | |
504 | } | |
505 | ||
a0995fd4 JB |
506 | my $dist = $mod = File::Basename::basename($dir); |
507 | $dist .= '-0' unless $dist =~ /\-[0-9._]+$/; | |
508 | $dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/; | |
509 | ||
510 | my $modobj = CPANPLUS::Module::Fake->new( | |
511 | module => $mod, | |
512 | version => 0, | |
513 | package => $dist, | |
514 | path => $parent, | |
515 | author => CPANPLUS::Module::Author::Fake->new | |
516 | ); | |
517 | ||
518 | ### better guess for the version | |
519 | $modobj->version( $modobj->package_version ) | |
520 | if defined $modobj->package_version; | |
521 | ||
522 | ### better guess at module name, if possible | |
523 | if ( my $pkgname = $modobj->package_name ) { | |
524 | $pkgname =~ s/-/::/g; | |
525 | ||
526 | ### no sense replacing it unless we changed something | |
527 | $modobj->module( $pkgname ) | |
528 | if ($pkgname ne $modobj->package_name) || $pkgname !~ /-/; | |
529 | } | |
530 | ||
531 | $modobj->status->fetch( $parent ); | |
532 | $modobj->status->extract( $dir ); | |
533 | $modobj->get_installer_type; | |
534 | return $modobj; | |
535 | } | |
536 | ||
6aaee015 RGS |
537 | ### ok, so it looks like a distribution then? |
538 | my @parts = split '/', $mod; | |
539 | my $dist = pop @parts; | |
540 | ||
541 | ### ah, it's a URL | |
542 | if( $mod =~ m|\w+://.+| ) { | |
543 | my $modobj = CPANPLUS::Module::Fake->new( | |
544 | module => $dist, | |
545 | version => 0, | |
546 | package => $dist, | |
547 | path => File::Spec::Unix->catdir( | |
548 | $conf->_get_mirror('base'), | |
549 | UNKNOWN_DL_LOCATION ), | |
550 | author => CPANPLUS::Module::Author::Fake->new | |
551 | ); | |
552 | ||
553 | ### set the fetch_from accessor so we know to by pass the | |
554 | ### usual mirrors | |
555 | $modobj->status->_fetch_from( $mod ); | |
556 | ||
5bc5f6dc RGS |
557 | ### better guess for the version |
558 | $modobj->version( $modobj->package_version ) | |
559 | if defined $modobj->package_version; | |
560 | ||
561 | ### better guess at module name, if possible | |
562 | if ( my $pkgname = $modobj->package_name ) { | |
563 | $pkgname =~ s/-/::/g; | |
564 | ||
565 | ### no sense replacing it unless we changed something | |
566 | $modobj->module( $pkgname ) | |
567 | if ($pkgname ne $modobj->package_name) || $pkgname !~ /-/; | |
568 | } | |
569 | ||
6aaee015 RGS |
570 | return $modobj; |
571 | } | |
572 | ||
573 | ### perhaps we can find it's a third party module? | |
574 | { my $modobj = CPANPLUS::Module::Fake->new( | |
575 | module => $mod, | |
576 | version => 0, | |
577 | package => $dist, | |
578 | path => File::Spec::Unix->catdir( | |
579 | $conf->_get_mirror('base'), | |
580 | UNKNOWN_DL_LOCATION ), | |
581 | author => CPANPLUS::Module::Author::Fake->new | |
582 | ); | |
583 | if( $modobj->is_third_party ) { | |
584 | my $info = $modobj->third_party_information; | |
585 | ||
586 | $modobj->author->author( $info->{author} ); | |
587 | $modobj->author->email( $info->{author_url} ); | |
588 | $modobj->description( $info->{url} ); | |
589 | ||
590 | return $modobj; | |
591 | } | |
592 | } | |
593 | ||
594 | unless( $dist ) { | |
595 | error( loc("%1 is not a proper distribution name!", $mod) ); | |
596 | return; | |
597 | } | |
598 | ||
599 | ### there's wonky uris out there, like this: | |
600 | ### E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091 | |
601 | ### compensate for that | |
602 | my $author; | |
603 | ### you probably have an A/AB/ABC/....../Dist.tgz type uri | |
604 | if( (defined $parts[0] and length $parts[0] == 1) and | |
605 | (defined $parts[1] and length $parts[1] == 2) and | |
606 | $parts[2] =~ /^$parts[0]/i and $parts[2] =~ /^$parts[1]/i | |
607 | ) { | |
608 | splice @parts, 0, 2; # remove the first 2 entries from the list | |
609 | $author = shift @parts; # this is the actual author name then | |
610 | ||
611 | ### we''ll assume a ABC/..../Dist.tgz | |
612 | } else { | |
613 | $author = shift @parts || ''; | |
614 | } | |
4443dd53 JB |
615 | |
616 | my($pkg, $version, $ext, $full) = | |
6aaee015 RGS |
617 | $self->_split_package_string( package => $dist ); |
618 | ||
619 | ### translate a distribution into a module name ### | |
620 | my $guess = $pkg; | |
621 | $guess =~ s/-/::/g if $guess; | |
622 | ||
623 | my $maybe = $self->module_tree( $guess ); | |
624 | if( IS_MODOBJ->( module => $maybe ) ) { | |
625 | ||
626 | ### maybe you asked for a package instead | |
627 | if ( $maybe->package eq $mod ) { | |
628 | return $maybe; | |
629 | ||
630 | ### perhaps an outdated version instead? | |
631 | } elsif ( $version ) { | |
632 | my $auth_obj; my $path; | |
633 | ||
634 | ### did you give us an author part? ### | |
635 | if( $author ) { | |
636 | $auth_obj = CPANPLUS::Module::Author::Fake->new( | |
637 | _id => $maybe->_id, | |
638 | cpanid => uc $author, | |
639 | author => uc $author, | |
640 | ); | |
641 | $path = File::Spec::Unix->catdir( | |
642 | $conf->_get_mirror('base'), | |
643 | substr(uc $author, 0, 1), | |
644 | substr(uc $author, 0, 2), | |
645 | uc $author, | |
646 | @parts, #possible sub dirs | |
647 | ); | |
648 | } else { | |
649 | $auth_obj = $maybe->author; | |
650 | $path = $maybe->path; | |
651 | } | |
652 | ||
653 | if( $maybe->package_name eq $pkg ) { | |
654 | ||
655 | my $modobj = CPANPLUS::Module::Fake->new( | |
656 | module => $maybe->module, | |
657 | version => $version, | |
4443dd53 JB |
658 | ### no extension? use the extension the original package |
659 | ### had instead | |
660 | package => do { $ext | |
661 | ? $full | |
662 | : $full .'.'. $maybe->package_extension | |
663 | }, | |
6aaee015 RGS |
664 | path => $path, |
665 | author => $auth_obj, | |
666 | _id => $maybe->_id | |
667 | ); | |
668 | return $modobj; | |
669 | ||
670 | ### you asked for a specific version? | |
671 | ### assume our $maybe is the one you wanted, | |
672 | ### and fix up the version.. | |
673 | } else { | |
674 | ||
675 | my $modobj = $maybe->clone; | |
676 | $modobj->version( $version ); | |
677 | $modobj->package( | |
678 | $maybe->package_name .'-'. | |
679 | $version .'.'. | |
680 | $maybe->package_extension | |
681 | ); | |
682 | ||
683 | ### you wanted a specific author, but it's not the one | |
684 | ### from the module tree? we'll fix it up | |
685 | if( $author and $author ne $modobj->author->cpanid ) { | |
686 | $modobj->author( $auth_obj ); | |
687 | $modobj->path( $path ); | |
688 | } | |
689 | ||
690 | return $modobj; | |
691 | } | |
692 | ||
693 | ### you didn't care about a version, so just return the object then | |
694 | } elsif ( !$version ) { | |
695 | return $maybe; | |
696 | } | |
697 | ||
698 | ### ok, so we can't find it, and it's not an outdated dist either | |
699 | ### perhaps we can fake one based on the author name and so on | |
700 | } elsif ( $author and $version ) { | |
701 | ||
702 | ### be extra friendly and pad the .tar.gz suffix where needed | |
703 | ### it's just a guess of course, but most dists are .tar.gz | |
704 | $dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/; | |
705 | ||
706 | ### XXX duplication from above for generating author obj + path... | |
707 | my $modobj = CPANPLUS::Module::Fake->new( | |
708 | module => $guess, | |
709 | version => $version, | |
710 | package => $dist, | |
711 | author => CPANPLUS::Module::Author::Fake->new( | |
712 | author => uc $author, | |
713 | cpanid => uc $author, | |
714 | _id => $self->_id, | |
715 | ), | |
716 | path => File::Spec::Unix->catdir( | |
717 | $conf->_get_mirror('base'), | |
718 | substr(uc $author, 0, 1), | |
719 | substr(uc $author, 0, 2), | |
720 | uc $author, | |
721 | @parts, #possible subdirs | |
722 | ), | |
723 | _id => $self->_id, | |
724 | ); | |
725 | ||
726 | return $modobj; | |
727 | ||
728 | ### face it, we have /no/ idea what he or she wants... | |
729 | ### let's start putting the blame somewhere | |
730 | } else { | |
731 | ||
732 | unless( $author ) { | |
733 | error( loc( "'%1' does not contain an author part", $mod ) ); | |
734 | } | |
735 | ||
736 | error( loc( "Cannot find '%1' in the module tree", $mod ) ); | |
737 | } | |
738 | ||
739 | return; | |
740 | } | |
741 | ||
742 | =pod | |
743 | ||
744 | =head2 $bool = $cb->reload_indices( [update_source => BOOL, verbose => BOOL] ); | |
745 | ||
746 | This method reloads the source files. | |
747 | ||
748 | If C<update_source> is set to true, this will fetch new source files | |
749 | from your CPAN mirror. Otherwise, C<reload_indices> will do its | |
750 | usual cache checking and only update them if they are out of date. | |
751 | ||
752 | By default, C<update_source> will be false. | |
753 | ||
754 | The verbose setting defaults to what you have specified in your | |
755 | config file. | |
756 | ||
757 | Returns true on success and false on failure. | |
758 | ||
759 | =cut | |
760 | ||
761 | sub reload_indices { | |
762 | my $self = shift; | |
763 | my %hash = @_; | |
764 | my $conf = $self->configure_object; | |
765 | ||
766 | my $tmpl = { | |
767 | update_source => { default => 0, allow => [qr/^\d$/] }, | |
768 | verbose => { default => $conf->get_conf('verbose') }, | |
769 | }; | |
770 | ||
771 | my $args = check( $tmpl, \%hash ) or return; | |
772 | ||
773 | ### make a call to the internal _module_tree, so it triggers cache | |
774 | ### file age | |
775 | my $uptodate = $self->_check_trees( %$args ); | |
776 | ||
777 | ||
778 | return 1 if $self->_build_trees( | |
779 | uptodate => $uptodate, | |
780 | use_stored => 0, | |
781 | verbose => $conf->get_conf('verbose'), | |
782 | ); | |
783 | ||
784 | error( loc( "Error rebuilding source trees!" ) ); | |
785 | ||
786 | return; | |
787 | } | |
788 | ||
789 | =pod | |
790 | ||
791 | =head2 $bool = $cb->flush(CACHE_NAME) | |
792 | ||
793 | This method allows flushing of caches. | |
794 | There are several things which can be flushed: | |
795 | ||
796 | =over 4 | |
797 | ||
798 | =item * C<methods> | |
799 | ||
800 | The return status of methods which have been attempted, such as | |
801 | different ways of fetching files. It is recommended that automatic | |
802 | flushing be used instead. | |
803 | ||
804 | =item * C<hosts> | |
805 | ||
806 | The return status of URIs which have been attempted, such as | |
807 | different hosts of fetching files. It is recommended that automatic | |
808 | flushing be used instead. | |
809 | ||
810 | =item * C<modules> | |
811 | ||
812 | Information about modules such as prerequisites and whether | |
813 | installation succeeded, failed, or was not attempted. | |
814 | ||
815 | =item * C<lib> | |
816 | ||
817 | This resets PERL5LIB, which is changed to ensure that while installing | |
818 | modules they are in our @INC. | |
819 | ||
820 | =item * C<load> | |
821 | ||
822 | This resets the cache of modules we've attempted to load, but failed. | |
823 | This enables you to load them again after a failed load, if they | |
824 | somehow have become available. | |
825 | ||
826 | =item * C<all> | |
827 | ||
828 | Flush all of the aforementioned caches. | |
829 | ||
830 | =back | |
831 | ||
832 | Returns true on success and false on failure. | |
833 | ||
834 | =cut | |
835 | ||
836 | sub flush { | |
837 | my $self = shift; | |
838 | my $type = shift or return; | |
839 | ||
840 | my $cache = { | |
841 | methods => [ qw( methods load ) ], | |
842 | hosts => [ qw( hosts ) ], | |
843 | modules => [ qw( modules lib) ], | |
844 | lib => [ qw( lib ) ], | |
845 | load => [ qw( load ) ], | |
846 | all => [ qw( hosts lib modules methods load ) ], | |
847 | }; | |
848 | ||
849 | my $aref = $cache->{$type} | |
850 | or ( | |
851 | error( loc("No such cache '%1'", $type) ), | |
852 | return | |
853 | ); | |
854 | ||
855 | return $self->_flush( list => $aref ); | |
856 | } | |
857 | ||
858 | =pod | |
859 | ||
860 | =head2 @mods = $cb->installed() | |
861 | ||
862 | Returns a list of module objects of all your installed modules. | |
863 | If an error occurs, it will return false. | |
864 | ||
865 | See L<CPANPLUS::Module> for the operations you can perform on a | |
866 | module object. | |
867 | ||
868 | =cut | |
869 | ||
870 | sub installed { | |
871 | my $self = shift; | |
872 | my $aref = $self->_all_installed; | |
873 | ||
874 | return @$aref if $aref; | |
875 | return; | |
876 | } | |
877 | ||
878 | =pod | |
879 | ||
880 | =head2 $bool = $cb->local_mirror([path => '/dir/to/save/to', index_files => BOOL, force => BOOL, verbose => BOOL] ) | |
881 | ||
882 | Creates a local mirror of CPAN, of only the most recent sources in a | |
883 | location you specify. If you set this location equal to a custom host | |
884 | in your C<CPANPLUS::Config> you can use your local mirror to install | |
885 | from. | |
886 | ||
887 | It takes the following arguments: | |
888 | ||
889 | =over 4 | |
890 | ||
891 | =item path | |
892 | ||
893 | The location where to create the local mirror. | |
894 | ||
895 | =item index_files | |
896 | ||
5bc5f6dc RGS |
897 | Enable/disable fetching of index files. You can disable fetching of the |
898 | index files if you don't plan to use the local mirror as your primary | |
899 | site, or if you'd like up-to-date index files be fetched from elsewhere. | |
6aaee015 RGS |
900 | |
901 | Defaults to true. | |
902 | ||
903 | =item force | |
904 | ||
905 | Forces refetching of packages, even if they are there already. | |
906 | ||
907 | Defaults to whatever setting you have in your C<CPANPLUS::Config>. | |
908 | ||
909 | =item verbose | |
910 | ||
911 | Prints more messages about what its doing. | |
912 | ||
913 | Defaults to whatever setting you have in your C<CPANPLUS::Config>. | |
914 | ||
915 | =back | |
916 | ||
917 | Returns true on success and false on error. | |
918 | ||
919 | =cut | |
920 | ||
921 | sub local_mirror { | |
922 | my $self = shift; | |
923 | my $conf = $self->configure_object; | |
924 | my %hash = @_; | |
925 | ||
926 | my($path, $index, $force, $verbose); | |
927 | my $tmpl = { | |
928 | path => { default => $conf->get_conf('base'), | |
929 | store => \$path }, | |
930 | index_files => { default => 1, store => \$index }, | |
931 | force => { default => $conf->get_conf('force'), | |
932 | store => \$force }, | |
933 | verbose => { default => $conf->get_conf('verbose'), | |
934 | store => \$verbose }, | |
935 | }; | |
936 | ||
937 | check( $tmpl, \%hash ) or return; | |
938 | ||
939 | unless( -d $path ) { | |
940 | $self->_mkdir( dir => $path ) | |
941 | or( error( loc( "Could not create '%1', giving up", $path ) ), | |
942 | return | |
943 | ); | |
944 | } elsif ( ! -w _ ) { | |
945 | error( loc( "Could not write to '%1', giving up", $path ) ); | |
946 | return; | |
947 | } | |
948 | ||
949 | my $flag; | |
950 | AUTHOR: { | |
951 | for my $auth ( sort { $a->cpanid cmp $b->cpanid } | |
952 | values %{$self->author_tree} | |
953 | ) { | |
954 | ||
955 | MODULE: { | |
956 | my $i; | |
957 | for my $mod ( $auth->modules ) { | |
958 | my $fetchdir = File::Spec->catdir( $path, $mod->path ); | |
959 | ||
960 | my %opts = ( | |
961 | verbose => $verbose, | |
962 | force => $force, | |
963 | fetchdir => $fetchdir, | |
964 | ); | |
965 | ||
966 | ### only do this the for the first module ### | |
967 | unless( $i++ ) { | |
968 | $mod->_get_checksums_file( | |
969 | %opts | |
970 | ) or ( | |
971 | error( loc( "Could not fetch %1 file, " . | |
972 | "skipping author '%2'", | |
973 | CHECKSUMS, $auth->cpanid ) ), | |
974 | $flag++, next AUTHOR | |
975 | ); | |
976 | } | |
977 | ||
978 | $mod->fetch( %opts ) | |
979 | or( error( loc( "Could not fetch '%1'", $mod->module ) ), | |
980 | $flag++, next MODULE | |
981 | ); | |
982 | } } | |
983 | } } | |
984 | ||
985 | if( $index ) { | |
986 | for my $name (qw[auth dslip mod]) { | |
987 | $self->_update_source( | |
988 | name => $name, | |
989 | verbose => $verbose, | |
990 | path => $path, | |
991 | ) or ( $flag++, next ); | |
992 | } | |
993 | } | |
994 | ||
995 | return !$flag; | |
996 | } | |
997 | ||
998 | =pod | |
999 | ||
1000 | =head2 $file = $cb->autobundle([path => OUTPUT_PATH, force => BOOL, verbose => BOOL]) | |
1001 | ||
1002 | Writes out a snapshot of your current installation in C<CPAN> bundle | |
1003 | style. This can then be used to install the same modules for a | |
4443dd53 JB |
1004 | different or on a different machine by issuing the following commands: |
1005 | ||
1006 | ### using the default shell: | |
1007 | CPAN Terminal> i file://path/to/Snapshot_XXYY.pm | |
1008 | ||
1009 | ### using the API | |
1010 | $modobj = $cb->parse_module( module => 'file://path/to/Snapshot_XXYY.pm' ); | |
1011 | $modobj->install; | |
6aaee015 RGS |
1012 | |
1013 | It will, by default, write to an 'autobundle' directory under your | |
1014 | cpanplus homedirectory, but you can override that by supplying a | |
1015 | C<path> argument. | |
1016 | ||
1017 | It will return the location of the output file on success and false on | |
1018 | failure. | |
1019 | ||
1020 | =cut | |
1021 | ||
1022 | sub autobundle { | |
1023 | my $self = shift; | |
1024 | my $conf = $self->configure_object; | |
1025 | my %hash = @_; | |
1026 | ||
1027 | my($path,$force,$verbose); | |
1028 | my $tmpl = { | |
1029 | force => { default => $conf->get_conf('force'), store => \$force }, | |
1030 | verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, | |
1031 | path => { default => File::Spec->catdir( | |
1032 | $conf->get_conf('base'), | |
1033 | $self->_perl_version( perl => $^X ), | |
1034 | $conf->_get_build('distdir'), | |
1035 | $conf->_get_build('autobundle') ), | |
1036 | store => \$path }, | |
1037 | }; | |
1038 | ||
1039 | check($tmpl, \%hash) or return; | |
1040 | ||
1041 | unless( -d $path ) { | |
1042 | $self->_mkdir( dir => $path ) | |
1043 | or( error(loc("Could not create directory '%1'", $path ) ), | |
1044 | return | |
1045 | ); | |
1046 | } | |
1047 | ||
1048 | my $name; my $file; | |
1049 | { ### default filename for the bundle ### | |
1050 | my($year,$month,$day) = (localtime)[5,4,3]; | |
1051 | $year += 1900; $month++; | |
1052 | ||
1053 | my $ext = 0; | |
1054 | ||
1055 | my $prefix = $conf->_get_build('autobundle_prefix'); | |
1056 | my $format = "${prefix}_%04d_%02d_%02d_%02d"; | |
1057 | ||
1058 | BLOCK: { | |
1059 | $name = sprintf( $format, $year, $month, $day, $ext); | |
1060 | ||
1061 | $file = File::Spec->catfile( $path, $name . '.pm' ); | |
1062 | ||
1063 | -f $file ? ++$ext && redo BLOCK : last BLOCK; | |
1064 | } | |
1065 | } | |
1066 | my $fh; | |
1067 | unless( $fh = FileHandle->new( ">$file" ) ) { | |
1068 | error( loc( "Could not open '%1' for writing: %2", $file, $! ) ); | |
1069 | return; | |
1070 | } | |
5bc5f6dc RGS |
1071 | |
1072 | ### make sure we load the module tree *before* doing this, as it | |
1073 | ### starts to chdir all over the place | |
1074 | $self->module_tree; | |
6aaee015 RGS |
1075 | |
1076 | my $string = join "\n\n", | |
1077 | map { | |
1078 | join ' ', | |
1079 | $_->module, | |
1080 | ($_->installed_version(verbose => 0) || 'undef') | |
1081 | } sort { | |
1082 | $a->module cmp $b->module | |
1083 | } $self->installed; | |
1084 | ||
1085 | my $now = scalar localtime; | |
1086 | my $head = '=head1'; | |
1087 | my $pkg = __PACKAGE__; | |
1088 | my $version = $self->VERSION; | |
1089 | my $perl_v = join '', `$^X -V`; | |
1090 | ||
1091 | print $fh <<EOF; | |
4443dd53 | 1092 | package $name; |
6aaee015 RGS |
1093 | |
1094 | \$VERSION = '0.01'; | |
1095 | ||
1096 | 1; | |
1097 | ||
1098 | __END__ | |
1099 | ||
1100 | $head NAME | |
1101 | ||
1102 | $name - Snapshot of your installation at $now | |
1103 | ||
1104 | $head SYNOPSIS | |
1105 | ||
8bc57f96 DM |
1106 | To install the modules from this snapshot, run: |
1107 | ||
1108 | cpanp -i file://full/path/to/${name}.pm | |
6aaee015 RGS |
1109 | |
1110 | $head CONTENTS | |
1111 | ||
1112 | $string | |
1113 | ||
1114 | $head CONFIGURATION | |
1115 | ||
1116 | $perl_v | |
1117 | ||
1118 | $head AUTHOR | |
1119 | ||
1120 | This bundle has been generated autotomatically by | |
1121 | $pkg $version | |
1122 | ||
1123 | EOF | |
1124 | ||
1125 | close $fh; | |
1126 | ||
1127 | return $file; | |
1128 | } | |
1129 | ||
4443dd53 JB |
1130 | =head2 $bool = $cb->save_state |
1131 | ||
1132 | Explicit command to save memory state to disk. This can be used to save | |
1133 | information to disk about where a module was extracted, the result of | |
1134 | C<make test>, etc. This will then be re-loaded into memory when a new | |
1135 | session starts. | |
1136 | ||
1137 | The capability of saving state to disk depends on the source engine | |
1138 | being used (See C<CPANPLUS::Config> for the option to choose your | |
1139 | source engine). The default storage engine supports this option. | |
1140 | ||
1141 | Most users will not need this command, but it can handy for automated | |
1142 | systems like setting up CPAN smoke testers. | |
1143 | ||
1144 | The method will return true if it managed to save the state to disk, | |
1145 | or false if it did not. | |
1146 | ||
1147 | =cut | |
1148 | ||
1149 | sub save_state { | |
1150 | my $self = shift; | |
1151 | return $self->_save_state( @_ ); | |
1152 | } | |
1153 | ||
1154 | ||
5bc5f6dc RGS |
1155 | ### XXX these wrappers are not individually tested! only the underlying |
1156 | ### code through source.t and indirectly trought he CustomSource plugin. | |
1157 | =pod | |
1158 | ||
1159 | =head1 CUSTOM MODULE SOURCES | |
1160 | ||
1161 | Besides the sources as provided by the general C<CPAN> mirrors, it's | |
1162 | possible to add your own sources list to your C<CPANPLUS> index. | |
1163 | ||
1164 | The methodology behind this works much like C<Debian's apt-sources>. | |
1165 | ||
1166 | The methods below show you how to make use of this functionality. Also | |
1167 | note that most of these methods are available through the default shell | |
1168 | plugin command C</cs>, making them available as shortcuts through the | |
1169 | shell and via the commandline. | |
1170 | ||
1171 | =head2 %files = $cb->list_custom_sources | |
1172 | ||
1173 | Returns a mapping of registered custom sources and their local indices | |
1174 | as follows: | |
1175 | ||
1176 | /full/path/to/local/index => http://remote/source | |
1177 | ||
1178 | Note that any file starting with an C<#> is being ignored. | |
1179 | ||
1180 | =cut | |
1181 | ||
1182 | sub list_custom_sources { | |
1183 | return shift->__list_custom_module_sources( @_ ); | |
1184 | } | |
1185 | ||
1186 | =head2 $local_index = $cb->add_custom_source( uri => URI, [verbose => BOOL] ); | |
1187 | ||
1188 | Adds an C<URI> to your own sources list and mirrors its index. See the | |
1189 | documentation on C<< $cb->update_custom_source >> on how this is done. | |
1190 | ||
1191 | Returns the full path to the local index on success, or false on failure. | |
1192 | ||
1193 | Note that when adding a new C<URI>, the change to the in-memory tree is | |
1194 | not saved until you rebuild or save the tree to disk again. You can do | |
1195 | this using the C<< $cb->reload_indices >> method. | |
1196 | ||
1197 | =cut | |
1198 | ||
1199 | sub add_custom_source { | |
1200 | return shift->_add_custom_module_source( @_ ); | |
1201 | } | |
1202 | ||
1203 | =head2 $local_index = $cb->remove_custom_source( uri => URI, [verbose => BOOL] ); | |
1204 | ||
1205 | Removes an C<URI> from your own sources list and removes its index. | |
1206 | ||
1207 | To find out what C<URI>s you have as part of your own sources list, use | |
1208 | the C<< $cb->list_custom_sources >> method. | |
1209 | ||
1210 | Returns the full path to the deleted local index file on success, or false | |
1211 | on failure. | |
1212 | ||
1213 | =cut | |
1214 | ||
1215 | ### XXX do clever dispatching based on arg number? | |
1216 | sub remove_custom_source { | |
1217 | return shift->_remove_custom_module_source( @_ ); | |
1218 | } | |
1219 | ||
1220 | =head2 $bool = $cb->update_custom_source( [remote => URI] ); | |
1221 | ||
1222 | Updates the indexes for all your custom sources. It does this by fetching | |
1223 | a file called C<packages.txt> in the root of the custom sources's C<URI>. | |
1224 | If you provide the C<remote> argument, it will only update the index for | |
1225 | that specific C<URI>. | |
1226 | ||
1227 | Here's an example of how custom sources would resolve into index files: | |
1228 | ||
1229 | file:///path/to/sources => file:///path/to/sources/packages.txt | |
1230 | http://example.com/sources => http://example.com/sources/packages.txt | |
1231 | ftp://example.com/sources => ftp://example.com/sources/packages.txt | |
1232 | ||
1233 | The file C<packages.txt> simply holds a list of packages that can be found | |
1234 | under the root of the C<URI>. This file can be automatically generated for | |
1235 | you when the remote source is a C<file:// URI>. For C<http://>, C<ftp://>, | |
1236 | and similar, the administrator of that repository should run the method | |
1237 | C<< $cb->write_custom_source_index >> on the repository to allow remote | |
1238 | users to index it. | |
1239 | ||
1240 | For details, see the C<< $cb->write_custom_source_index >> method below. | |
1241 | ||
1242 | All packages that are added via this mechanism will be attributed to the | |
1243 | author with C<CPANID> C<LOCAL>. You can use this id to search for all | |
1244 | added packages. | |
1245 | ||
1246 | =cut | |
1247 | ||
1248 | sub update_custom_source { | |
1249 | my $self = shift; | |
1250 | ||
1251 | ### if it mentions /remote/, the request is to update a single uri, | |
1252 | ### not all the ones we have, so dispatch appropriately | |
1253 | my $rv = grep( /remote/i, @_) | |
1254 | ? $self->__update_custom_module_source( @_ ) | |
1255 | : $self->__update_custom_module_sources( @_ ); | |
1256 | ||
1257 | return $rv; | |
1258 | } | |
1259 | ||
1260 | =head2 $file = $cb->write_custom_source_index( path => /path/to/package/root, [to => /path/to/index/file, verbose => BOOL] ); | |
1261 | ||
1262 | Writes the index for a custom repository root. Most users will not have to | |
1263 | worry about this, but administrators of a repository will need to make sure | |
1264 | their indexes are up to date. | |
1265 | ||
1266 | The index will be written to a file called C<packages.txt> in your repository | |
1267 | root, which you can specify with the C<path> argument. You can override this | |
1268 | location by specifying the C<to> argument, but in normal operation, that should | |
1269 | not be required. | |
1270 | ||
1271 | Once the index file is written, users can then add the C<URI> pointing to | |
1272 | the repository to their custom list of sources and start using it right away. See the C<< $cb->add_custom_source >> method for user details. | |
1273 | ||
1274 | =cut | |
1275 | ||
1276 | sub write_custom_source_index { | |
1277 | return shift->__write_custom_module_index( @_ ); | |
1278 | } | |
1279 | ||
6aaee015 RGS |
1280 | 1; |
1281 | ||
1282 | =pod | |
1283 | ||
1284 | =head1 BUG REPORTS | |
1285 | ||
1286 | Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>. | |
1287 | ||
1288 | =head1 AUTHOR | |
1289 | ||
1290 | This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. | |
1291 | ||
1292 | =head1 COPYRIGHT | |
1293 | ||
1294 | The CPAN++ interface (of which this module is a part of) is copyright (c) | |
1295 | 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. | |
1296 | ||
1297 | This library is free software; you may redistribute and/or modify it | |
1298 | under the same terms as Perl itself. | |
1299 | ||
1300 | =head1 SEE ALSO | |
1301 | ||
5bc5f6dc RGS |
1302 | L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>, |
1303 | L<CPANPLUS::Selfupdate> | |
6aaee015 RGS |
1304 | |
1305 | =cut | |
1306 | ||
1307 | # Local variables: | |
1308 | # c-indentation-style: bsd | |
1309 | # c-basic-offset: 4 | |
1310 | # indent-tabs-mode: nil | |
1311 | # End: | |
1312 | # vim: expandtab shiftwidth=4: | |
1313 | ||
1314 | __END__ | |
1315 | ||
1316 | todo: | |
1317 | sub dist { # not sure about this one -- probably already done | |
1318 | enough in Module.pm | |
1319 | sub reports { # in Module.pm, wrapper here | |
1320 | ||
1321 |