lib/CPANPLUS/Backend.pm

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