1 package CPANPLUS::Backend;
7 use CPANPLUS::Configure;
8 use CPANPLUS::Internals;
9 use CPANPLUS::Internals::Constants;
11 use CPANPLUS::Module::Author;
12 use CPANPLUS::Backend::RV;
16 use File::Spec::Unix ();
17 use Params::Check qw[check];
18 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
20 $Params::Check::VERBOSE = 1;
22 use vars qw[@ISA $VERSION];
24 @ISA = qw[CPANPLUS::Internals];
25 $VERSION = $CPANPLUS::Internals::VERSION;
27 ### mark that we're running under CPANPLUS to spawned processes
28 $ENV{'PERL5_CPANPLUS_IS_RUNNING'} = $$;
30 ### XXX version.pm MAY format this version, if it's in use... :(
31 ### so for consistency, just call ->VERSION ourselves as well.
32 $ENV{'PERL5_CPANPLUS_IS_VERSION'} = __PACKAGE__->VERSION;
42 my $cb = CPANPLUS::Backend->new( );
43 my $conf = $cb->configure_object;
45 my $author = $cb->author_tree('KANE');
46 my $mod = $cb->module_tree('Some::Module');
47 my $mod = $cb->parse_module( module => 'Some::Module' );
49 my @objs = $cb->search( type => TYPE,
59 This module provides the programmer's interface to the C<CPANPLUS>
64 When C<CPANPLUS::Backend> is loaded, which is necessary for just
65 about every <CPANPLUS> operation, the environment variable
66 C<PERL5_CPANPLUS_IS_RUNNING> is set to the current process id.
68 Additionally, the environment variable C<PERL5_CPANPLUS_IS_VERSION>
69 will be set to the version of C<CPANPLUS::Backend>.
71 This information might be useful somehow to spawned processes.
75 =head2 $cb = CPANPLUS::Backend->new( [CONFIGURE_OBJ] )
77 This method returns a new C<CPANPLUS::Backend> object.
78 This also initialises the config corresponding to this object.
79 You have two choices in this:
83 =item Provide a valid C<CPANPLUS::Configure> object
85 This will be used verbatim.
89 Your default config will be loaded and used.
93 New will return a C<CPANPLUS::Backend> object on success and die on
102 if( $_[0] && IS_CONFOBJ->( conf => $_[0] ) ) {
105 $conf = CPANPLUS::Configure->new() or return;
108 my $self = $class->SUPER::_init( _conf => $conf );
115 =head2 $href = $cb->module_tree( [@modules_names_list] )
117 Returns a reference to the CPANPLUS module tree.
119 If you give it any arguments, they will be treated as module names
120 and C<module_tree> will try to look up these module names and
121 return the corresponding module objects instead.
123 See L<CPANPLUS::Module> for the operations you can perform on a
130 my $modtree = $self->_module_tree;
134 for my $name ( grep { defined } @_) {
135 push @rv, $modtree->{$name} || '';
137 return @rv == 1 ? $rv[0] : @rv;
145 =head2 $href = $cb->author_tree( [@author_names_list] )
147 Returns a reference to the CPANPLUS author tree.
149 If you give it any arguments, they will be treated as author names
150 and C<author_tree> will try to look up these author names and
151 return the corresponding author objects instead.
153 See L<CPANPLUS::Module::Author> for the operations you can perform on
160 my $authtree = $self->_author_tree;
165 push @rv, $authtree->{$name} || '';
167 return @rv == 1 ? $rv[0] : @rv;
175 =head2 $conf = $cb->configure_object ()
177 Returns a copy of the C<CPANPLUS::Configure> object.
179 See L<CPANPLUS::Configure> for operations you can perform on a
184 sub configure_object { return shift->_conf() };
186 =head2 $su = $cb->selfupdate_object;
188 Returns a copy of the C<CPANPLUS::Selfupdate> object.
190 See the L<CPANPLUS::Selfupdate> manpage for the operations
191 you can perform on the selfupdate object.
195 sub selfupdate_object { return shift->_selfupdate() };
199 =head2 @mods = $cb->search( type => TYPE, allow => AREF, [data => AREF, verbose => BOOL] )
201 C<search> enables you to search for either module or author objects,
202 based on their data. The C<type> you can specify is any of the
203 accessors specified in C<CPANPLUS::Module::Author> or
204 C<CPANPLUS::Module>. C<search> will determine by the C<type> you
205 specified whether to search by author object or module object.
207 You have to specify an array reference of regular expressions or
208 strings to match against. The rules used for this array ref are the
209 same as in C<Params::Check>, so read that manpage for details.
211 The search is an C<or> search, meaning that if C<any> of the criteria
212 match, the search is considered to be successful.
214 You can specify the result of a previous search as C<data> to limit
215 the new search to these module or author objects, rather than the
216 entire module or author tree. This is how you do C<and> searches.
218 Returns a list of module or author objects on success and false
221 See L<CPANPLUS::Module> for the operations you can perform on a
223 See L<CPANPLUS::Module::Author> for the operations you can perform on
230 my $conf = $self->configure_object;
233 local $Params::Check::ALLOW_UNKNOWN = 1;
237 type => { required => 1, allow => [CPANPLUS::Module->accessors(),
238 CPANPLUS::Module::Author->accessors()], store => \$type },
239 allow => { required => 1, default => [ ], strict_type => 1 },
242 my $args = check( $tmpl, \%hash ) or return;
244 ### figure out whether it was an author or a module search
245 ### when ambiguous, it'll be an author search.
247 if( grep { $type eq $_ } CPANPLUS::Module::Author->accessors() ) {
248 $aref = $self->_search_author_tree( %$args );
250 $aref = $self->_search_module_tree( %$args );
253 return @$aref if $aref;
259 =head2 $backend_rv = $cb->fetch( modules => \@mods )
261 Fetches a list of modules. C<@mods> can be a list of distribution
262 names, module names or module objects--basically anything that
263 L<parse_module> can understand.
265 See the equivalent method in C<CPANPLUS::Module> for details on
266 other options you can pass.
268 Since this is a multi-module method call, the return value is
269 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
270 that module's documentation on how to interpret the return value.
272 =head2 $backend_rv = $cb->extract( modules => \@mods )
274 Extracts a list of modules. C<@mods> can be a list of distribution
275 names, module names or module objects--basically anything that
276 L<parse_module> can understand.
278 See the equivalent method in C<CPANPLUS::Module> for details on
279 other options you can pass.
281 Since this is a multi-module method call, the return value is
282 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
283 that module's documentation on how to interpret the return value.
285 =head2 $backend_rv = $cb->install( modules => \@mods )
287 Installs a list of modules. C<@mods> can be a list of distribution
288 names, module names or module objects--basically anything that
289 L<parse_module> can understand.
291 See the equivalent method in C<CPANPLUS::Module> for details on
292 other options you can pass.
294 Since this is a multi-module method call, the return value is
295 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
296 that module's documentation on how to interpret the return value.
298 =head2 $backend_rv = $cb->readme( modules => \@mods )
300 Fetches the readme for a list of modules. C<@mods> can be a list of
301 distribution names, module names or module objects--basically
302 anything that L<parse_module> can understand.
304 See the equivalent method in C<CPANPLUS::Module> for details on
305 other options you can pass.
307 Since this is a multi-module method call, the return value is
308 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
309 that module's documentation on how to interpret the return value.
311 =head2 $backend_rv = $cb->files( modules => \@mods )
313 Returns a list of files used by these modules if they are installed.
314 C<@mods> can be a list of distribution names, module names or module
315 objects--basically anything that L<parse_module> can understand.
317 See the equivalent method in C<CPANPLUS::Module> for details on
318 other options you can pass.
320 Since this is a multi-module method call, the return value is
321 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
322 that module's documentation on how to interpret the return value.
324 =head2 $backend_rv = $cb->distributions( modules => \@mods )
326 Returns a list of module objects representing all releases for this
328 C<@mods> can be a list of distribution names, module names or module
329 objects, basically anything that L<parse_module> can understand.
331 See the equivalent method in C<CPANPLUS::Module> for details on
332 other options you can pass.
334 Since this is a multi-module method call, the return value is
335 implemented as a C<CPANPLUS::Backend::RV> object. Please consult
336 that module's documentation on how to interpret the return value.
340 ### XXX add direcotry_tree, packlist etc? or maybe remove files? ###
341 for my $func (qw[fetch extract install readme files distributions]) {
346 my $conf = $self->configure_object;
349 local $Params::Check::NO_DUPLICATES = 1;
350 local $Params::Check::ALLOW_UNKNOWN = 1;
354 modules => { default => [], strict_type => 1,
355 required => 1, store => \$mods },
358 my $args = check( $tmpl, \%hash ) or return;
360 ### make them all into module objects ###
361 my %mods = map {$_ => $self->parse_module(module => $_) || ''} @$mods;
364 while( my($name,$obj) = each %mods ) {
365 $href->{$name} = IS_MODOBJ->( mod => $obj )
366 ? $obj->$func( %$args )
369 $flag++ unless $href->{$name};
372 return CPANPLUS::Backend::RV->new(
383 =head2 $mod_obj = $cb->parse_module( module => $modname|$distname|$modobj|URI )
385 C<parse_module> tries to find a C<CPANPLUS::Module> object that
386 matches your query. Here's a list of examples you could give to
391 =item Text::Bastardize
393 =item Text-Bastardize
395 =item Text-Bastardize-1.06
397 =item AYRNIEU/Text-Bastardize
399 =item AYRNIEU/Text-Bastardize-1.06
401 =item AYRNIEU/Text-Bastardize-1.06.tar.gz
403 =item http://example.com/Text-Bastardize-1.06.tar.gz
405 =item file:///tmp/Text-Bastardize-1.06.tar.gz
409 These items would all come up with a C<CPANPLUS::Module> object for
410 C<Text::Bastardize>. The ones marked explicitly as being version 1.06
411 would give back a C<CPANPLUS::Module> object of that version.
412 Even if the version on CPAN is currently higher.
414 If C<parse_module> is unable to actually find the module you are looking
415 for in its module tree, but you supplied it with an author, module
416 and version part in a distribution name or URI, it will create a fake
417 C<CPANPLUS::Module> object for you, that you can use just like the
420 See L<CPANPLUS::Module> for the operations you can perform on a
423 If even this fancy guessing doesn't enable C<parse_module> to create
424 a fake module object for you to use, it will warn about an error and
431 my $conf = $self->configure_object;
436 module => { required => 1, store => \$mod },
439 my $args = check( $tmpl, \%hash ) or return;
441 return $mod if IS_MODOBJ->( module => $mod );
443 ### ok, so it's not a module object, but a ref nonetheless?
444 ### what are you smoking?
446 error(loc("Can not parse module string from reference '%1'", $mod ));
450 ### check only for allowed characters in a module name
451 unless( $mod =~ /[^\w:]/ ) {
453 ### perhaps we can find it in the module tree?
454 my $maybe = $self->module_tree($mod);
455 return $maybe if IS_MODOBJ->( module => $maybe );
458 ### ok, so it looks like a distribution then?
459 my @parts = split '/', $mod;
460 my $dist = pop @parts;
463 if( $mod =~ m|\w+://.+| ) {
464 my $modobj = CPANPLUS::Module::Fake->new(
468 path => File::Spec::Unix->catdir(
469 $conf->_get_mirror('base'),
470 UNKNOWN_DL_LOCATION ),
471 author => CPANPLUS::Module::Author::Fake->new
474 ### set the fetch_from accessor so we know to by pass the
476 $modobj->status->_fetch_from( $mod );
481 ### perhaps we can find it's a third party module?
482 { my $modobj = CPANPLUS::Module::Fake->new(
486 path => File::Spec::Unix->catdir(
487 $conf->_get_mirror('base'),
488 UNKNOWN_DL_LOCATION ),
489 author => CPANPLUS::Module::Author::Fake->new
491 if( $modobj->is_third_party ) {
492 my $info = $modobj->third_party_information;
494 $modobj->author->author( $info->{author} );
495 $modobj->author->email( $info->{author_url} );
496 $modobj->description( $info->{url} );
503 error( loc("%1 is not a proper distribution name!", $mod) );
507 ### there's wonky uris out there, like this:
508 ### E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091
509 ### compensate for that
511 ### you probably have an A/AB/ABC/....../Dist.tgz type uri
512 if( (defined $parts[0] and length $parts[0] == 1) and
513 (defined $parts[1] and length $parts[1] == 2) and
514 $parts[2] =~ /^$parts[0]/i and $parts[2] =~ /^$parts[1]/i
516 splice @parts, 0, 2; # remove the first 2 entries from the list
517 $author = shift @parts; # this is the actual author name then
519 ### we''ll assume a ABC/..../Dist.tgz
521 $author = shift @parts || '';
524 my($pkg, $version, $ext) =
525 $self->_split_package_string( package => $dist );
527 ### translate a distribution into a module name ###
529 $guess =~ s/-/::/g if $guess;
531 my $maybe = $self->module_tree( $guess );
532 if( IS_MODOBJ->( module => $maybe ) ) {
534 ### maybe you asked for a package instead
535 if ( $maybe->package eq $mod ) {
538 ### perhaps an outdated version instead?
539 } elsif ( $version ) {
540 my $auth_obj; my $path;
542 ### did you give us an author part? ###
544 $auth_obj = CPANPLUS::Module::Author::Fake->new(
546 cpanid => uc $author,
547 author => uc $author,
549 $path = File::Spec::Unix->catdir(
550 $conf->_get_mirror('base'),
551 substr(uc $author, 0, 1),
552 substr(uc $author, 0, 2),
554 @parts, #possible sub dirs
557 $auth_obj = $maybe->author;
558 $path = $maybe->path;
561 if( $maybe->package_name eq $pkg ) {
563 my $modobj = CPANPLUS::Module::Fake->new(
564 module => $maybe->module,
566 package => $pkg . '-' . $version . '.' .
567 $maybe->package_extension,
574 ### you asked for a specific version?
575 ### assume our $maybe is the one you wanted,
576 ### and fix up the version..
579 my $modobj = $maybe->clone;
580 $modobj->version( $version );
582 $maybe->package_name .'-'.
584 $maybe->package_extension
587 ### you wanted a specific author, but it's not the one
588 ### from the module tree? we'll fix it up
589 if( $author and $author ne $modobj->author->cpanid ) {
590 $modobj->author( $auth_obj );
591 $modobj->path( $path );
597 ### you didn't care about a version, so just return the object then
598 } elsif ( !$version ) {
602 ### ok, so we can't find it, and it's not an outdated dist either
603 ### perhaps we can fake one based on the author name and so on
604 } elsif ( $author and $version ) {
606 ### be extra friendly and pad the .tar.gz suffix where needed
607 ### it's just a guess of course, but most dists are .tar.gz
608 $dist .= '.tar.gz' unless $dist =~ /\.[A-Za-z]+$/;
610 ### XXX duplication from above for generating author obj + path...
611 my $modobj = CPANPLUS::Module::Fake->new(
615 author => CPANPLUS::Module::Author::Fake->new(
616 author => uc $author,
617 cpanid => uc $author,
620 path => File::Spec::Unix->catdir(
621 $conf->_get_mirror('base'),
622 substr(uc $author, 0, 1),
623 substr(uc $author, 0, 2),
625 @parts, #possible subdirs
632 ### face it, we have /no/ idea what he or she wants...
633 ### let's start putting the blame somewhere
637 error( loc( "'%1' does not contain an author part", $mod ) );
640 error( loc( "Cannot find '%1' in the module tree", $mod ) );
648 =head2 $bool = $cb->reload_indices( [update_source => BOOL, verbose => BOOL] );
650 This method reloads the source files.
652 If C<update_source> is set to true, this will fetch new source files
653 from your CPAN mirror. Otherwise, C<reload_indices> will do its
654 usual cache checking and only update them if they are out of date.
656 By default, C<update_source> will be false.
658 The verbose setting defaults to what you have specified in your
661 Returns true on success and false on failure.
668 my $conf = $self->configure_object;
671 update_source => { default => 0, allow => [qr/^\d$/] },
672 verbose => { default => $conf->get_conf('verbose') },
675 my $args = check( $tmpl, \%hash ) or return;
677 ### make a call to the internal _module_tree, so it triggers cache
679 my $uptodate = $self->_check_trees( %$args );
682 return 1 if $self->_build_trees(
683 uptodate => $uptodate,
685 verbose => $conf->get_conf('verbose'),
688 error( loc( "Error rebuilding source trees!" ) );
695 =head2 $bool = $cb->flush(CACHE_NAME)
697 This method allows flushing of caches.
698 There are several things which can be flushed:
704 The return status of methods which have been attempted, such as
705 different ways of fetching files. It is recommended that automatic
706 flushing be used instead.
710 The return status of URIs which have been attempted, such as
711 different hosts of fetching files. It is recommended that automatic
712 flushing be used instead.
716 Information about modules such as prerequisites and whether
717 installation succeeded, failed, or was not attempted.
721 This resets PERL5LIB, which is changed to ensure that while installing
722 modules they are in our @INC.
726 This resets the cache of modules we've attempted to load, but failed.
727 This enables you to load them again after a failed load, if they
728 somehow have become available.
732 Flush all of the aforementioned caches.
736 Returns true on success and false on failure.
742 my $type = shift or return;
745 methods => [ qw( methods load ) ],
746 hosts => [ qw( hosts ) ],
747 modules => [ qw( modules lib) ],
748 lib => [ qw( lib ) ],
749 load => [ qw( load ) ],
750 all => [ qw( hosts lib modules methods load ) ],
753 my $aref = $cache->{$type}
755 error( loc("No such cache '%1'", $type) ),
759 return $self->_flush( list => $aref );
764 =head2 @mods = $cb->installed()
766 Returns a list of module objects of all your installed modules.
767 If an error occurs, it will return false.
769 See L<CPANPLUS::Module> for the operations you can perform on a
776 my $aref = $self->_all_installed;
778 return @$aref if $aref;
784 =head2 $bool = $cb->local_mirror([path => '/dir/to/save/to', index_files => BOOL, force => BOOL, verbose => BOOL] )
786 Creates a local mirror of CPAN, of only the most recent sources in a
787 location you specify. If you set this location equal to a custom host
788 in your C<CPANPLUS::Config> you can use your local mirror to install
791 It takes the following arguments:
797 The location where to create the local mirror.
801 Enable/disable fetching of index files. This is ok if you don't plan
802 to use the local mirror as your primary sites, or if you'd like
803 up-to-date index files be fetched from elsewhere.
809 Forces refetching of packages, even if they are there already.
811 Defaults to whatever setting you have in your C<CPANPLUS::Config>.
815 Prints more messages about what its doing.
817 Defaults to whatever setting you have in your C<CPANPLUS::Config>.
821 Returns true on success and false on error.
827 my $conf = $self->configure_object;
830 my($path, $index, $force, $verbose);
832 path => { default => $conf->get_conf('base'),
834 index_files => { default => 1, store => \$index },
835 force => { default => $conf->get_conf('force'),
837 verbose => { default => $conf->get_conf('verbose'),
838 store => \$verbose },
841 check( $tmpl, \%hash ) or return;
844 $self->_mkdir( dir => $path )
845 or( error( loc( "Could not create '%1', giving up", $path ) ),
849 error( loc( "Could not write to '%1', giving up", $path ) );
855 for my $auth ( sort { $a->cpanid cmp $b->cpanid }
856 values %{$self->author_tree}
861 for my $mod ( $auth->modules ) {
862 my $fetchdir = File::Spec->catdir( $path, $mod->path );
867 fetchdir => $fetchdir,
870 ### only do this the for the first module ###
872 $mod->_get_checksums_file(
875 error( loc( "Could not fetch %1 file, " .
876 "skipping author '%2'",
877 CHECKSUMS, $auth->cpanid ) ),
883 or( error( loc( "Could not fetch '%1'", $mod->module ) ),
890 for my $name (qw[auth dslip mod]) {
891 $self->_update_source(
895 ) or ( $flag++, next );
904 =head2 $file = $cb->autobundle([path => OUTPUT_PATH, force => BOOL, verbose => BOOL])
906 Writes out a snapshot of your current installation in C<CPAN> bundle
907 style. This can then be used to install the same modules for a
908 different or on a different machine.
910 It will, by default, write to an 'autobundle' directory under your
911 cpanplus homedirectory, but you can override that by supplying a
914 It will return the location of the output file on success and false on
921 my $conf = $self->configure_object;
924 my($path,$force,$verbose);
926 force => { default => $conf->get_conf('force'), store => \$force },
927 verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
928 path => { default => File::Spec->catdir(
929 $conf->get_conf('base'),
930 $self->_perl_version( perl => $^X ),
931 $conf->_get_build('distdir'),
932 $conf->_get_build('autobundle') ),
936 check($tmpl, \%hash) or return;
939 $self->_mkdir( dir => $path )
940 or( error(loc("Could not create directory '%1'", $path ) ),
946 { ### default filename for the bundle ###
947 my($year,$month,$day) = (localtime)[5,4,3];
948 $year += 1900; $month++;
952 my $prefix = $conf->_get_build('autobundle_prefix');
953 my $format = "${prefix}_%04d_%02d_%02d_%02d";
956 $name = sprintf( $format, $year, $month, $day, $ext);
958 $file = File::Spec->catfile( $path, $name . '.pm' );
960 -f $file ? ++$ext && redo BLOCK : last BLOCK;
964 unless( $fh = FileHandle->new( ">$file" ) ) {
965 error( loc( "Could not open '%1' for writing: %2", $file, $! ) );
969 my $string = join "\n\n",
973 ($_->installed_version(verbose => 0) || 'undef')
975 $a->module cmp $b->module
978 my $now = scalar localtime;
980 my $pkg = __PACKAGE__;
981 my $version = $self->VERSION;
982 my $perl_v = join '', `$^X -V`;
995 $name - Snapshot of your installation at $now
999 perl -MCPANPLUS -e "install $name"
1011 This bundle has been generated autotomatically by
1027 Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
1031 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1035 The CPAN++ interface (of which this module is a part of) is copyright (c)
1036 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
1038 This library is free software; you may redistribute and/or modify it
1039 under the same terms as Perl itself.
1043 L<CPANPLUS::Configure>, L<CPANPLUS::Module>, L<CPANPLUS::Module::Author>
1048 # c-indentation-style: bsd
1050 # indent-tabs-mode: nil
1052 # vim: expandtab shiftwidth=4:
1057 sub dist { # not sure about this one -- probably already done
1059 sub reports { # in Module.pm, wrapper here