lib/CPAN.pm

   1 package CPAN;
   2 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
   3
   4 $VERSION = '1.2401';
   5
   6 # $Id: CPAN.pm,v 1.139 1997/03/31 22:43:23 k Exp $
   7
   8 # my $version = substr q$Revision: 1.139 $, 10; # only used during development
   9
  10 use Carp ();
  11 use Config ();
  12 use Cwd ();
  13 use DirHandle;
  14 use Exporter ();
  15 use ExtUtils::MakeMaker ();
  16 use File::Basename ();
  17 use File::Copy ();
  18 use File::Find;
  19 use File::Path ();
  20 use FileHandle ();
  21 use Safe ();
  22 use Text::ParseWords ();
  23 use Text::Wrap;
  24
  25 my $getcwd;
  26 $getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
  27 $Cwd = Cwd->$getcwd();
  28
  29 END { $End++; &cleanup; }
  30
  31 %CPAN::DEBUG = qw(
  32                   CPAN              1
  33                   Index             2
  34                   InfoObj           4
  35                   Author            8
  36                   Distribution     16
  37                   Bundle           32
  38                   Module           64
  39                   CacheMgr        128
  40                   Complete        256
  41                   FTP             512
  42                   Shell          1024
  43                   Eval           2048
  44                   Config         4096
  45                  );
  46
  47 $CPAN::DEBUG ||= 0;
  48 $CPAN::Signal ||= 0;
  49
  50 package CPAN;
  51 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
  52 use strict qw(vars);
  53
  54 @CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
  55                                           # MakeMaker, gives us
  56                                           # catfile and catdir
  57
  58 $META ||= new CPAN;                 # In case we reeval ourselves we
  59                                     # need a ||
  60
  61 @EXPORT = qw(
  62              autobundle bundle expand force get
  63              install make readme recompile shell test clean
  64             );
  65
  66
  67
  68 #-> sub CPAN::autobundle ;
  69 sub autobundle;
  70 #-> sub CPAN::bundle ;
  71 sub bundle;
  72 #-> sub CPAN::expand ;
  73 sub expand;
  74 #-> sub CPAN::force ;
  75 sub force;
  76 #-> sub CPAN::install ;
  77 sub install;
  78 #-> sub CPAN::make ;
  79 sub make;
  80 #-> sub CPAN::shell ;
  81 sub shell;
  82 #-> sub CPAN::clean ;
  83 sub clean;
  84 #-> sub CPAN::test ;
  85 sub test;
  86
  87 #-> sub CPAN::AUTOLOAD ;
  88 sub AUTOLOAD {
  89     my($l) = $AUTOLOAD;
  90     $l =~ s/.*:://;
  91     my(%EXPORT);
  92     @EXPORT{@EXPORT} = '';
  93     if (exists $EXPORT{$l}){
  94         CPAN::Shell->$l(@_);
  95     } else {
  96         warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
  97 Nothing Done.
  98 ";
  99         CPAN::Shell->h;
 100     }
 101 }
 102
 103 #-> sub CPAN::all ;
 104 sub all {
 105     my($mgr,$class) = @_;
 106     CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
 107     CPAN::Index->reload;
 108     values %{ $META->{$class} };
 109 }
 110
 111 # Called by shell, not in batch mode. Not clean XXX
 112 #-> sub CPAN::checklock ;
 113 sub checklock {
 114     my($self) = @_;
 115     my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
 116     if (-f $lockfile && -M _ > 0) {
 117         my $fh = FileHandle->new($lockfile);
 118         my $other = <$fh>;
 119         $fh->close;
 120         if (defined $other && $other) {
 121             chomp $other;
 122             return if $$==$other; # should never happen
 123             print qq{There seems to be running another CPAN process }.
 124                 qq{($other). Trying to contact...\n};
 125             if (kill 0, $other) {
 126                 Carp::croak qq{Other job is running.\n}.
 127                     qq{You may want to kill it and delete the lockfile, }.
 128                         qq{maybe. On UNIX try:\n}.
 129                         qq{    kill $other\n}.
 130                             qq{    rm $lockfile\n};
 131             } elsif (-w $lockfile) {
 132                 my($ans) =
 133                     ExtUtils::MakeMaker::prompt
 134                         (qq{Other job not responding. Shall I overwrite }.
 135                          qq{the lockfile? (Y/N)},"y");
 136                 print("Ok, bye\n"), exit unless $ans =~ /^y/i;
 137             } else {
 138                 Carp::croak(
 139                             qq{Lockfile $lockfile not writeable by you. }.
 140                             qq{Cannot proceed.\n}.
 141                             qq{    On UNIX try:\n}.
 142                             qq{    rm $lockfile\n}.
 143                             qq{  and then rerun us.\n}
 144                            );
 145             }
 146         }
 147     }
 148     File::Path::mkpath($CPAN::Config->{cpan_home});
 149     my $fh;
 150     unless ($fh = FileHandle->new(">$lockfile")) {
 151         if ($! =~ /Permission/) {
 152             my $incc = $INC{'CPAN/Config.pm'};
 153             my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
 154             print qq{
 155
 156 Your configuration suggests that CPAN.pm should use a working
 157 directory of
 158     $CPAN::Config->{cpan_home}
 159 Unfortunately we could not create the lock file
 160     $lockfile
 161 due to permission problems.
 162
 163 Please make sure that the configuration variable
 164     \$CPAN::Config->{cpan_home}
 165 points to a directory where you can write a .lock file. You can set
 166 this variable in either
 167     $incc
 168 or
 169     $myincc
 170
 171 };
 172         }
 173         Carp::croak "Could not open >$lockfile: $!";
 174     }
 175     print $fh $$, "\n";
 176     $self->{LOCK} = $lockfile;
 177     $fh->close;
 178     $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
 179     $SIG{'INT'} = sub {
 180         my $s = $Signal == 2 ? "a second" : "another";
 181         &cleanup, die "Got $s SIGINT" if $Signal;
 182         $Signal = 1;
 183     };
 184     $SIG{'__DIE__'} = \&cleanup;
 185     $self->debug("Signal handler set.") if $CPAN::DEBUG;
 186 }
 187
 188 #-> sub CPAN::DESTROY ;
 189 sub DESTROY {
 190     &cleanup; # need an eval?
 191 }
 192
 193 #-> sub CPAN::exists ;
 194 sub exists {
 195     my($mgr,$class,$id) = @_;
 196     CPAN::Index->reload;
 197     ### Carp::croak "exists called without class argument" unless $class;
 198     $id ||= "";
 199     exists $META->{$class}{$id};
 200 }
 201
 202 #-> sub CPAN::hasFTP ;
 203 sub hasFTP {
 204     my($self,$arg) = @_;
 205     if (defined $arg) {
 206         return $self->{'hasFTP'} = $arg;
 207     } elsif (not defined $self->{'hasFTP'}) {
 208         eval {require Net::FTP;};
 209         $self->{'hasFTP'} = $@ ? 0 : 1;
 210     }
 211     return $self->{'hasFTP'};
 212 }
 213
 214 #-> sub CPAN::hasLWP ;
 215 sub hasLWP {
 216     my($self,$arg) = @_;
 217     if (defined $arg) {
 218         return $self->{'hasLWP'} = $arg;
 219     } elsif (not defined $self->{'hasLWP'}) {
 220         eval {require LWP;};
 221         $LWP::VERSION ||= 0;
 222         $self->{'hasLWP'} = $LWP::VERSION >= 4.98;
 223     }
 224     return $self->{'hasLWP'};
 225 }
 226
 227 #-> sub CPAN::hasMD5 ;
 228 sub hasMD5 {
 229     my($self,$arg) = @_;
 230     if (defined $arg) {
 231         $self->{'hasMD5'} = $arg;
 232     } elsif (not defined $self->{'hasMD5'}) {
 233         eval {require MD5;};
 234         if ($@) {
 235             print "MD5 security checks disabled because MD5 not installed.
 236   Please consider installing the MD5 module\n";
 237             $self->{'hasMD5'} = 0;
 238         } else {
 239             $self->{'hasMD5'}++;
 240         }
 241     }
 242     return $self->{'hasMD5'};
 243 }
 244
 245 #-> sub CPAN::hasWAIT ;
 246 sub hasWAIT {
 247     my($self,$arg) = @_;
 248     if (defined $arg) {
 249         $self->{'hasWAIT'} = $arg;
 250     } elsif (not defined $self->{'hasWAIT'}) {
 251         eval {require CPAN::WAIT;};
 252         if ($@) {
 253             $self->{'hasWAIT'} = 0;
 254         } else {
 255             $self->{'hasWAIT'} = 1;
 256         }
 257     }
 258     return $self->{'hasWAIT'};
 259 }
 260
 261 #-> sub CPAN::instance ;
 262 sub instance {
 263     my($mgr,$class,$id) = @_;
 264     ### CPAN::Index->reload; ### not faster: unless time - $CPAN::Index::last_time > 60;
 265     CPAN::Index->reload;
 266     ### Carp::croak "instance called without class argument" unless $class;
 267     $id ||= "";
 268     $META->{$class}{$id} ||= $class->new(ID => $id );
 269 }
 270
 271 #-> sub CPAN::new ;
 272 sub new {
 273     bless {}, shift;
 274 }
 275
 276 #-> sub CPAN::cleanup ;
 277 sub cleanup {
 278     local $SIG{__DIE__} = '';
 279     my $i = 0; my $ineval = 0; my $sub;
 280     while ((undef,undef,undef,$sub) = caller(++$i)) {
 281       $ineval = 1, last if $sub eq '(eval)';
 282     }
 283     return if $ineval && !$End;
 284     return unless defined $META->{'LOCK'};
 285     return unless -f $META->{'LOCK'};
 286     unlink $META->{'LOCK'};
 287     print STDERR "Lockfile removed.\n";
 288 #    my $mess = Carp::longmess(@_);
 289 #    die @_;
 290 }
 291
 292 #-> sub CPAN::shell ;
 293 sub shell {
 294     $Suppress_readline ||= ! -t STDIN;
 295
 296     my $prompt = "cpan> ";
 297     local($^W) = 1;
 298     unless ($Suppress_readline) {
 299         require Term::ReadLine;
 300 #       import Term::ReadLine;
 301         $term = new Term::ReadLine 'CPAN Monitor';
 302         $readline::rl_completion_function =
 303             $readline::rl_completion_function = 'CPAN::Complete::complete';
 304     }
 305
 306     no strict;
 307     $META->checklock();
 308     my $getcwd;
 309     $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
 310     my $cwd = Cwd->$getcwd();
 311     my $rl_avail = $Suppress_readline ? "suppressed" :
 312         ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
 313             "available (get Term::ReadKey and Term::ReadLine::Perl ".
 314             "or get Term::ReadLine::Gnu)";
 315
 316     print qq{
 317 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
 318 Readline support $rl_avail
 319
 320 } unless $CPAN::Config->{'inhibit_startup_message'} ;
 321     while () {
 322         if ($Suppress_readline) {
 323             print $prompt;
 324             last unless defined ($_ = <> );
 325             chomp;
 326         } else {
 327 #            if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
 328 #                my($report,$item);
 329 #                $report = "";
 330 #                for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
 331 #                    $report .= sprintf "%-15s", $item;
 332 #                    $report .= $term->$item() || "";
 333 #                    $report .= "\n";
 334 #                }
 335 #                print $report;
 336 #               CPAN->debug($report);
 337 #           }
 338             last unless defined ($_ = $term->readline($prompt));
 339         }
 340         s/^\s//;
 341         next if /^$/;
 342         $_ = 'h' if $_ eq '?';
 343         if (/^\!/) {
 344             s/^\!//;
 345             my($eval) = $_;
 346             package CPAN::Eval;
 347             use vars qw($import_done);
 348             CPAN->import(':DEFAULT') unless $import_done++;
 349             CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
 350             eval($eval);
 351             warn $@ if $@;
 352         } elsif (/^q(?:uit)?$/i) {
 353             last;
 354         } elsif (/./) {
 355             my(@line);
 356             if ($] < 5.00322) { # parsewords had a bug until recently
 357                 @line = split;
 358             } else {
 359                 eval { @line = Text::ParseWords::shellwords($_) };
 360                 warn($@), next if $@;
 361             }
 362             $CPAN::META->debug("line[".join("|",@line)."]") if $CPAN::DEBUG;
 363             my $command = shift @line;
 364             eval { CPAN::Shell->$command(@line) };
 365             warn $@ if $@;
 366         }
 367     } continue {
 368         &cleanup, die if $Signal;
 369         chdir $cwd;
 370         print "\n";
 371     }
 372 }
 373
 374 package CPAN::CacheMgr;
 375 use vars qw($Du);
 376 @CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
 377 use File::Find;
 378
 379 #-> sub CPAN::CacheMgr::as_string ;
 380 sub as_string {
 381     eval { require Data::Dumper };
 382     if ($@) {
 383         return shift->SUPER::as_string;
 384     } else {
 385         return Data::Dumper::Dumper(shift);
 386     }
 387 }
 388
 389 #-> sub CPAN::CacheMgr::cachesize ;
 390 sub cachesize {
 391     shift->{DU};
 392 }
 393
 394 # sub check {
 395 #     my($self,@dirs) = @_;
 396 #     return unless -d $self->{ID};
 397 #     my $dir;
 398 #     @dirs = $self->dirs unless @dirs;
 399 #     for $dir (@dirs) {
 400 #         $self->disk_usage($dir);
 401 #     }
 402 # }
 403
 404 #-> sub CPAN::CacheMgr::clean_cache ;
 405 #=# sub clean_cache {
 406 #=#     my $self = shift;
 407 #=#     my $dir;
 408 #=#     while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
 409 #=#         $self->force_clean_cache($dir);
 410 #=#     }
 411 #=#     $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
 412 #=# }
 413
 414 #-> sub CPAN::CacheMgr::dir ;
 415 sub dir {
 416     shift->{ID};
 417 }
 418
 419 #-> sub CPAN::CacheMgr::entries ;
 420 sub entries {
 421     my($self,$dir) = @_;
 422     $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
 423     $dir ||= $self->{ID};
 424     my $getcwd;
 425     $getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
 426     my($cwd) = Cwd->$getcwd();
 427     chdir $dir or Carp::croak("Can't chdir to $dir: $!");
 428     my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
 429     my(@entries);
 430     for ($dh->read) {
 431         next if $_ eq "." || $_ eq "..";
 432         if (-f $_) {
 433             push @entries, $CPAN::META->catfile($dir,$_);
 434         } elsif (-d _) {
 435             push @entries, $CPAN::META->catdir($dir,$_);
 436         } else {
 437             print STDERR "Warning: weird direntry in $dir: $_\n";
 438         }
 439     }
 440     chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
 441     sort { -M $b <=> -M $a} @entries;
 442 }
 443
 444 #-> sub CPAN::CacheMgr::disk_usage ;
 445 sub disk_usage {
 446     my($self,$dir) = @_;
 447 #    if (! defined $dir or $dir eq "") {
 448 #       $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
 449 #       return;
 450 #    }
 451     return if $self->{SIZE}{$dir};
 452     local($Du) = 0;
 453     find(
 454          sub {
 455              return if -l $_;
 456              $Du += -s _;
 457          },
 458          $dir
 459         );
 460     $self->{SIZE}{$dir} = $Du/1024/1024;
 461     push @{$self->{FIFO}}, $dir;
 462     $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
 463     $self->{DU} += $Du/1024/1024;
 464     if ($self->{DU} > $self->{'MAX'} ) {
 465         my($toremove) = shift @{$self->{FIFO}};
 466         printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
 467                 $self->{DU}, $self->{'MAX'};
 468         $self->force_clean_cache($toremove);
 469     }
 470     $self->{DU};
 471 }
 472
 473 #-> sub CPAN::CacheMgr::force_clean_cache ;
 474 sub force_clean_cache {
 475     my($self,$dir) = @_;
 476     $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
 477         if $CPAN::DEBUG;
 478     File::Path::rmtree($dir);
 479     $self->{DU} -= $self->{SIZE}{$dir};
 480     delete $self->{SIZE}{$dir};
 481 }
 482
 483 #-> sub CPAN::CacheMgr::new ;
 484 sub new {
 485     my $class = shift;
 486     my $time = time;
 487     my($debug,$t2);
 488     $debug = "";
 489     my $self = {
 490                 ID => $CPAN::Config->{'build_dir'},
 491                 MAX => $CPAN::Config->{'build_cache'},
 492                 DU => 0
 493                };
 494     File::Path::mkpath($self->{ID});
 495     my $dh = DirHandle->new($self->{ID});
 496     bless $self, $class;
 497     $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
 498     my $e;
 499     for $e ($self->entries) {
 500         next if $e eq ".." || $e eq ".";
 501         $self->disk_usage($e);
 502     }
 503     $t2 = time;
 504     $debug .= "timing of CacheMgr->new: ".($t2 - $time);
 505     $time = $t2;
 506     CPAN->debug($debug) if $CPAN::DEBUG;
 507     $self;
 508 }
 509
 510 package CPAN::Debug;
 511
 512 #-> sub CPAN::Debug::debug ;
 513 sub debug {
 514     my($self,$arg) = @_;
 515     my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
 516                                                # Complete, caller(1)
 517                                                # eg readline
 518     ($caller) = caller(0);
 519     $caller =~ s/.*:://;
 520 #    print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
 521 #    print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
 522     if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
 523         if (ref $arg) {
 524             eval { require Data::Dumper };
 525             if ($@) {
 526                 print $arg->as_string;
 527             } else {
 528                 print Data::Dumper::Dumper($arg);
 529             }
 530         } else {
 531             print "Debug($caller:$func,$line,@rest): $arg\n"
 532         }
 533     }
 534 }
 535
 536 package CPAN::Config;
 537 import ExtUtils::MakeMaker 'neatvalue';
 538 use vars qw(%can);
 539
 540 %can = (
 541   'commit' => "Commit changes to disk",
 542   'defaults' => "Reload defaults from disk",
 543   'init'   => "Interactive setting of all options",
 544 );
 545
 546 #-> sub CPAN::Config::edit ;
 547 sub edit {
 548     my($class,@args) = @_;
 549     return unless @args;
 550     CPAN->debug("class[$class]args[".join(" | ",@args)."]");
 551     my($o,$str,$func,$args,$key_exists);
 552     $o = shift @args;
 553     if($can{$o}) {
 554         $class->$o(@args);
 555         return 1;
 556     } else {
 557         if (ref($CPAN::Config->{$o}) eq ARRAY) {
 558             $func = shift @args;
 559             $func ||= "";
 560             # Let's avoid eval, it's easier to comprehend without.
 561             if ($func eq "push") {
 562                 push @{$CPAN::Config->{$o}}, @args;
 563             } elsif ($func eq "pop") {
 564                 pop @{$CPAN::Config->{$o}};
 565             } elsif ($func eq "shift") {
 566                 shift @{$CPAN::Config->{$o}};
 567             } elsif ($func eq "unshift") {
 568                 unshift @{$CPAN::Config->{$o}}, @args;
 569             } elsif ($func eq "splice") {
 570                 splice @{$CPAN::Config->{$o}}, @args;
 571             } elsif (@args) {
 572                 $CPAN::Config->{$o} = [@args];
 573             } else {
 574                 print(
 575                       "  $o  ",
 576                       ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
 577                       "\n"
 578                      );
 579             }
 580         } else {
 581             $CPAN::Config->{$o} = $args[0] if defined $args[0];
 582             print "    $o    ";
 583             print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
 584         }
 585     }
 586 }
 587
 588 #-> sub CPAN::Config::commit ;
 589 sub commit {
 590     my($self,$configpm) = @_;
 591     unless (defined $configpm){
 592         $configpm ||= $INC{"CPAN/MyConfig.pm"};
 593         $configpm ||= $INC{"CPAN/Config.pm"};
 594         $configpm || Carp::confess(qq{
 595 CPAN::Config::commit called without an argument.
 596 Please specify a filename where to save the configuration or try
 597 "o conf init" to have an interactive course through configing.
 598 });
 599     }
 600     my($mode);
 601     if (-f $configpm) {
 602         $mode = (stat $configpm)[2];
 603         if ($mode && ! -w _) {
 604             Carp::confess("$configpm is not writable");
 605         }
 606     }
 607
 608     my $msg = <<EOF unless $configpm =~ /MyConfig/;
 609
 610 # This is CPAN.pm's systemwide configuration file.  This file provides
 611 # defaults for users, and the values can be changed in a per-user configuration
 612 # file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
 613
 614 EOF
 615     $msg ||= "\n";
 616     my($fh) = FileHandle->new;
 617     open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
 618     print $fh qq[$msg\$CPAN::Config = \{\n];
 619     foreach (sort keys %$CPAN::Config) {
 620         $fh->print(
 621                    "  '$_' => ",
 622                    ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
 623                    ",\n"
 624                   );
 625     }
 626
 627     print $fh "};\n1;\n__END__\n";
 628     close $fh;
 629
 630     #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
 631     #chmod $mode, $configpm;
 632 ###why was that so?    $self->defaults;
 633     print "commit: wrote $configpm\n";
 634     1;
 635 }
 636
 637 *default = \&defaults;
 638 #-> sub CPAN::Config::defaults ;
 639 sub defaults {
 640     my($self) = @_;
 641     $self->unload;
 642     $self->load;
 643     1;
 644 }
 645
 646 sub init {
 647     my($self) = @_;
 648     undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
 649                                                       # have the least
 650                                                       # important
 651                                                       # variable
 652                                                       # undefined
 653     $self->load;
 654     1;
 655 }
 656
 657 my $dot_cpan;
 658 #-> sub CPAN::Config::load ;
 659 sub load {
 660     my($self) = shift;
 661     my(@miss);
 662     eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
 663     unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
 664     eval {require CPAN::MyConfig;};     # where you can override system wide settings
 665     return unless @miss = $self->not_loaded;
 666     require CPAN::FirstTime;
 667     my($configpm,$fh,$redo);
 668     $redo ||= "";
 669     if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
 670         $configpm = $INC{"CPAN/Config.pm"};
 671         $redo++;
 672     } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
 673         $configpm = $INC{"CPAN/MyConfig.pm"};
 674         $redo++;
 675     } else {
 676         my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
 677         my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
 678         my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
 679         if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
 680             if (-w $configpmtest) {
 681                 $configpm = $configpmtest;
 682             } elsif (-w $configpmdir) {
 683                 #_#_# following code dumped core on me with 5.003_11, a.k.
 684                 unlink "$configpmtest.bak" if -f "$configpmtest.bak";
 685                 rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
 686                 my $fh = FileHandle->new;
 687                 if ($fh->open(">$configpmtest")) {
 688                     $fh->print("1;\n");
 689                     $configpm = $configpmtest;
 690                 } else {
 691                     # Should never happen
 692                     Carp::confess("Cannot open >$configpmtest");
 693                 }
 694             }
 695         }
 696         unless ($configpm) {
 697             $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
 698             File::Path::mkpath($configpmdir);
 699             $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
 700             if (-w $configpmtest) {
 701                 $configpm = $configpmtest;
 702             } elsif (-w $configpmdir) {
 703                 #_#_# following code dumped core on me with 5.003_11, a.k.
 704                 my $fh = FileHandle->new;
 705                 if ($fh->open(">$configpmtest")) {
 706                     $fh->print("1;\n");
 707                     $configpm = $configpmtest;
 708                 } else {
 709                     # Should never happen
 710                     Carp::confess("Cannot open >$configpmtest");
 711                 }
 712             } else {
 713                 Carp::confess(qq{WARNING: CPAN.pm is unable to }.
 714                               qq{create a configuration file.});
 715             }
 716         }
 717     }
 718     local($") = ", ";
 719     print qq{
 720 We have to reconfigure CPAN.pm due to following uninitialized parameters:
 721
 722 @miss
 723 } if $redo ;
 724     print qq{
 725 $configpm initialized.
 726 };
 727     sleep 2;
 728     CPAN::FirstTime::init($configpm);
 729 }
 730
 731 #-> sub CPAN::Config::not_loaded ;
 732 sub not_loaded {
 733     my(@miss);
 734     for (qw(
 735             cpan_home keep_source_where build_dir build_cache index_expire
 736             gzip tar unzip make pager makepl_arg make_arg make_install_arg
 737             urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
 738            )) {
 739         push @miss, $_ unless defined $CPAN::Config->{$_};
 740     }
 741     return @miss;
 742 }
 743
 744 #-> sub CPAN::Config::unload ;
 745 sub unload {
 746     delete $INC{'CPAN/MyConfig.pm'};
 747     delete $INC{'CPAN/Config.pm'};
 748 }
 749
 750 *h = \&help;
 751 #-> sub CPAN::Config::help ;
 752 sub help {
 753     print <<EOF;
 754 Known options:
 755   defaults  reload default config values from disk
 756   commit    commit session changes to disk
 757   init      go through a dialog to set all parameters
 758
 759 You may edit key values in the follow fashion:
 760
 761   o conf build_cache 15
 762
 763   o conf build_dir "/foo/bar"
 764
 765   o conf urllist shift
 766
 767   o conf urllist unshift ftp://ftp.foo.bar/
 768
 769 EOF
 770     undef; #don't reprint CPAN::Config
 771 }
 772
 773 #-> sub CPAN::Config::complete ;
 774 sub complete {
 775     my($word,$line,$pos) = @_;
 776     $word ||= "";
 777     my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
 778     return grep /^\Q$word\E/, @o_conf;
 779 }
 780
 781 package CPAN::Shell;
 782 use vars qw($AUTOLOAD $redef @ISA);
 783 @CPAN::Shell::ISA = qw(CPAN::Debug);
 784 if ($CPAN::META->hasWAIT) {
 785     unshift @ISA, "CPAN::WAIT";
 786 }
 787 # private function ro re-eval this module (handy during development)
 788 #-> sub CPAN::Shell::AUTOLOAD ;
 789 sub AUTOLOAD {
 790     my($autoload) = $AUTOLOAD;
 791     $autoload =~ s/.*:://;
 792     if ($autoload =~ /^w/) {
 793         if ($CPAN::META->hasWAIT) {
 794             CPAN::WAIT->wh;
 795             return;
 796         } else {
 797             print STDERR qq{
 798 Commands starting with "w" require CPAN::WAIT to be installed.
 799 Please consider installing CPAN::WAIT to use the fulltext index.
 800 Type "install CPAN::WAIT" and restart CPAN.pm.
 801 }
 802         }
 803     } else {
 804         warn "CPAN::Shell doesn't know how to autoload $autoload :-(
 805 Nothing Done.
 806 ";
 807     }
 808     CPAN::Shell->h;
 809 }
 810
 811 #-> sub CPAN::Shell::h ;
 812 sub h {
 813     my($class,$about) = @_;
 814     if (defined $about) {
 815         print "Detailed help not yet implemented\n";
 816     } else {
 817         print q{
 818 command   arguments       description
 819 a         string                  authors
 820 b         or              display bundles
 821 d         /regex/         info    distributions
 822 m         or              about   modules
 823 i         none                    anything of above
 824
 825 r          as             reinstall recommendations
 826 u          above          uninstalled distributions
 827 See manpage for autobundle, recompile, force, look, etc.
 828
 829 make                      make
 830 test      modules,        make test (implies make)
 831 install   dists, bundles, make install (implies test)
 832 clean     "r" or "u"      make clean
 833 readme                    display the README file
 834
 835 reload    index|cpan    load most recent indices/CPAN.pm
 836 h or ?                  display this menu
 837 o         various       set and query options
 838 !         perl-code     eval a perl command
 839 q                       quit the shell subroutine
 840 };
 841     }
 842 }
 843
 844 #-> sub CPAN::Shell::a ;
 845 sub a { print shift->format_result('Author',@_);}
 846 #-> sub CPAN::Shell::b ;
 847 sub b {
 848     my($self,@which) = @_;
 849     CPAN->debug("which[@which]") if $CPAN::DEBUG;
 850     my($incdir,$bdir,$dh);
 851     foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
 852         $bdir = $CPAN::META->catdir($incdir,"Bundle");
 853         if ($dh = DirHandle->new($bdir)) { # may fail
 854             my($entry);
 855             for $entry ($dh->read) {
 856                 next if -d $CPAN::META->catdir($bdir,$entry);
 857                 next unless $entry =~ s/\.pm$//;
 858                 $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
 859             }
 860         }
 861     }
 862     print $self->format_result('Bundle',@which);
 863 }
 864 #-> sub CPAN::Shell::d ;
 865 sub d { print shift->format_result('Distribution',@_);}
 866 #-> sub CPAN::Shell::m ;
 867 sub m { print shift->format_result('Module',@_);}
 868
 869 #-> sub CPAN::Shell::i ;
 870 sub i {
 871     my($self) = shift;
 872     my(@args) = @_;
 873     my(@type,$type,@m);
 874     @type = qw/Author Bundle Distribution Module/;
 875     @args = '/./' unless @args;
 876     my(@result);
 877     for $type (@type) {
 878         push @result, $self->expand($type,@args);
 879     }
 880     my $result =  @result == 1 ?
 881         $result[0]->as_string :
 882             join "", map {$_->as_glimpse} @result;
 883     $result ||= "No objects found of any type for argument @args\n";
 884     print $result;
 885 }
 886
 887 #-> sub CPAN::Shell::o ;
 888 sub o {
 889     my($self,$o_type,@o_what) = @_;
 890     $o_type ||= "";
 891     CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
 892     if ($o_type eq 'conf') {
 893         shift @o_what if @o_what && $o_what[0] eq 'help';
 894         if (!@o_what) {
 895             my($k,$v);
 896             print "CPAN::Config options:\n";
 897             for $k (sort keys %CPAN::Config::can) {
 898                 $v = $CPAN::Config::can{$k};
 899                 printf "    %-18s %s\n", $k, $v;
 900             }
 901             print "\n";
 902             for $k (sort keys %$CPAN::Config) {
 903                 $v = $CPAN::Config->{$k};
 904                 if (ref $v) {
 905                     printf "    %-18s\n", $k;
 906                     print map {"\t$_\n"} @{$v};
 907                 } else {
 908                     printf "    %-18s %s\n", $k, $v;
 909                 }
 910             }
 911             print "\n";
 912         } elsif (!CPAN::Config->edit(@o_what)) {
 913             print qq[Type 'o conf' to view configuration edit options\n\n];
 914         }
 915     } elsif ($o_type eq 'debug') {
 916         my(%valid);
 917         @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
 918         if (@o_what) {
 919             while (@o_what) {
 920                 my($what) = shift @o_what;
 921                 if ( exists $CPAN::DEBUG{$what} ) {
 922                     $CPAN::DEBUG |= $CPAN::DEBUG{$what};
 923                 } elsif ($what =~ /^\d/) {
 924                     $CPAN::DEBUG = $what;
 925                 } elsif (lc $what eq 'all') {
 926                     my($max) = 0;
 927                     for (values %CPAN::DEBUG) {
 928                         $max += $_;
 929                     }
 930                     $CPAN::DEBUG = $max;
 931                 } else {
 932                     my($known) = 0;
 933                     for (keys %CPAN::DEBUG) {
 934                         next unless lc($_) eq lc($what);
 935                         $CPAN::DEBUG |= $CPAN::DEBUG{$_};
 936                         $known = 1;
 937                     }
 938                     print "unknown argument [$what]\n" unless $known;
 939                 }
 940             }
 941         } else {
 942             print "Valid options for debug are ".
 943                 join(", ",sort(keys %CPAN::DEBUG), 'all').
 944                     qq{ or a number. Completion works on the options. }.
 945                         qq{Case is ignored.\n\n};
 946         }
 947         if ($CPAN::DEBUG) {
 948             print "Options set for debugging:\n";
 949             my($k,$v);
 950             for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
 951                 $v = $CPAN::DEBUG{$k};
 952                 printf "    %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
 953             }
 954         } else {
 955             print "Debugging turned off completely.\n";
 956         }
 957     } else {
 958         print qq{
 959 Known options:
 960   conf    set or get configuration variables
 961   debug   set or get debugging options
 962 };
 963     }
 964 }
 965
 966 #-> sub CPAN::Shell::reload ;
 967 sub reload {
 968     my($self,$command,@arg) = @_;
 969     $command ||= "";
 970     $self->debug("self[$self]command[$command]arg[@arg]") if $CPAN::DEBUG;
 971     if ($command =~ /cpan/i) {
 972         CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
 973         my $fh = FileHandle->new($INC{'CPAN.pm'});
 974         local($/);
 975         undef $/;
 976         $redef = 0;
 977         local($SIG{__WARN__})
 978             = sub {
 979                 if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
 980                     ++$redef;
 981                     local($|) = 1;
 982                     print ".";
 983                     return;
 984                 }
 985                 warn @_;
 986             };
 987         eval <$fh>;
 988         warn $@ if $@;
 989         print "\n$redef subroutines redefined\n";
 990     } elsif ($command =~ /index/) {
 991         CPAN::Index->force_reload;
 992     } else {
 993         print qq{cpan     re-evals the CPAN.pm file\n};
 994         print qq{index    re-reads the index files\n};
 995     }
 996 }
 997
 998 #-> sub CPAN::Shell::_binary_extensions ;
 999 sub _binary_extensions {
1000     my($self) = shift @_;
1001     my(@result,$module,%seen,%need,$headerdone);
1002     for $module ($self->expand('Module','/./')) {
1003         my $file  = $module->cpan_file;
1004         next if $file eq "N/A";
1005         next if $file =~ /^Contact Author/;
1006         next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
1007         next unless $module->xs_file;
1008         local($|) = 1;
1009         print ".";
1010         push @result, $module;
1011     }
1012 #    print join " | ", @result;
1013     print "\n";
1014     return @result;
1015 }
1016
1017 #-> sub CPAN::Shell::recompile ;
1018 sub recompile {
1019     my($self) = shift @_;
1020     my($module,@module,$cpan_file,%dist);
1021     @module = $self->_binary_extensions();
1022     for $module (@module){  # we force now and compile later, so we don't do it twice
1023         $cpan_file = $module->cpan_file;
1024         my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1025         $pack->force;
1026         $dist{$cpan_file}++;
1027     }
1028     for $cpan_file (sort keys %dist) {
1029         print "  CPAN: Recompiling $cpan_file\n\n";
1030         my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
1031         $pack->install;
1032         $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
1033                            # stop a package from recompiling,
1034                            # e.g. IO-1.12 when we have perl5.003_10
1035     }
1036 }
1037
1038 #-> sub CPAN::Shell::_u_r_common ;
1039 sub _u_r_common {
1040     my($self) = shift @_;
1041     my($what) = shift @_;
1042     CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
1043     Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
1044     Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
1045     my(@args) = @_;
1046     @args = '/./' unless @args;
1047     my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
1048     $version_zeroes = 0;
1049     my $sprintf = "%-25s %9s %9s  %s\n";
1050     for $module ($self->expand('Module',@args)) {
1051         my $file  = $module->cpan_file;
1052         next unless defined $file; # ??
1053         my($latest) = $module->cpan_version || 0;
1054         my($inst_file) = $module->inst_file;
1055         my($have);
1056         if ($inst_file){
1057             if ($what eq "a") {
1058                 $have = $module->inst_version;
1059             } elsif ($what eq "r") {
1060                 $have = $module->inst_version;
1061                 local($^W) = 0;
1062                 $version_zeroes++ unless $have;
1063                 next if $have >= $latest;
1064             } elsif ($what eq "u") {
1065                 next;
1066             }
1067         } else {
1068             if ($what eq "a") {
1069                 next;
1070             } elsif ($what eq "r") {
1071                 next;
1072             } elsif ($what eq "u") {
1073                 $have = "-";
1074             }
1075         }
1076         return if $CPAN::Signal; # this is sometimes lengthy
1077         $seen{$file} ||= 0;
1078         if ($what eq "a") {
1079             push @result, sprintf "%s %s\n", $module->id, $have;
1080         } elsif ($what eq "r") {
1081             push @result, $module->id;
1082             next if $seen{$file}++;
1083         } elsif ($what eq "u") {
1084             push @result, $module->id;
1085             next if $seen{$file}++;
1086             next if $file =~ /^Contact/;
1087         }
1088         unless ($headerdone++){
1089             print "\n";
1090             printf(
1091                    $sprintf,
1092                    "Package namespace",
1093                    "installed",
1094                    "latest",
1095                    "in CPAN file"
1096                    );
1097         }
1098         $latest = substr($latest,0,8) if length($latest) > 8;
1099         $have = substr($have,0,8) if length($have) > 8;
1100         printf $sprintf, $module->id, $have, $latest, $file;
1101         $need{$module->id}++;
1102     }
1103     unless (%need) {
1104         if ($what eq "u") {
1105             print "No modules found for @args\n";
1106         } elsif ($what eq "r") {
1107             print "All modules are up to date for @args\n";
1108         }
1109     }
1110     if ($what eq "r" && $version_zeroes) {
1111         my $s = $version_zeroes > 1 ? "s have" : " has";
1112         print qq{$version_zeroes installed module$s no version number to compare\n};
1113     }
1114     @result;
1115 }
1116
1117 #-> sub CPAN::Shell::r ;
1118 sub r {
1119     shift->_u_r_common("r",@_);
1120 }
1121
1122 #-> sub CPAN::Shell::u ;
1123 sub u {
1124     shift->_u_r_common("u",@_);
1125 }
1126
1127 #-> sub CPAN::Shell::autobundle ;
1128 sub autobundle {
1129     my($self) = shift;
1130     my(@bundle) = $self->_u_r_common("a",@_);
1131     my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
1132     File::Path::mkpath($todir);
1133     unless (-d $todir) {
1134         print "Couldn't mkdir $todir for some reason\n";
1135         return;
1136     }
1137     my($y,$m,$d) =  (localtime)[5,4,3];
1138     $y+=1900;
1139     $m++;
1140     my($c) = 0;
1141     my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
1142     my($to) = $CPAN::META->catfile($todir,"$me.pm");
1143     while (-f $to) {
1144         $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
1145         $to = $CPAN::META->catfile($todir,"$me.pm");
1146     }
1147     my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
1148     $fh->print(
1149                "package Bundle::$me;\n\n",
1150                "\$VERSION = '0.01';\n\n",
1151                "1;\n\n",
1152                "__END__\n\n",
1153                "=head1 NAME\n\n",
1154                "Bundle::$me - Snapshot of installation on ",
1155                $Config::Config{'myhostname'},
1156                " on ",
1157                scalar(localtime),
1158                "\n\n=head1 SYNOPSIS\n\n",
1159                "perl -MCPAN -e 'install Bundle::$me'\n\n",
1160                "=head1 CONTENTS\n\n",
1161                join("\n", @bundle),
1162                "\n\n=head1 CONFIGURATION\n\n",
1163                Config->myconfig,
1164                "\n\n=head1 AUTHOR\n\n",
1165                "This Bundle has been generated automatically ",
1166                "by the autobundle routine in CPAN.pm.\n",
1167               );
1168     $fh->close;
1169     print "\nWrote bundle file
1170     $to\n\n";
1171 }
1172
1173 #-> sub CPAN::Shell::expand ;
1174 sub expand {
1175     shift;
1176     my($type,@args) = @_;
1177     my($arg,@m);
1178     for $arg (@args) {
1179         my $regex;
1180         if ($arg =~ m|^/(.*)/$|) {
1181             $regex = $1;
1182         }
1183         my $class = "CPAN::$type";
1184         my $obj;
1185         if (defined $regex) {
1186             for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
1187                 push @m, $obj
1188                     if
1189                         $obj->id =~ /$regex/i
1190                             or
1191                         (
1192                          (
1193                           $] < 5.00303 ### provide sort of compatibility with 5.003
1194                           ||
1195                           $obj->can('name')
1196                          )
1197                          &&
1198                          $obj->name  =~ /$regex/i
1199                         );
1200             }
1201         } else {
1202             my($xarg) = $arg;
1203             if ( $type eq 'Bundle' ) {
1204                 $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
1205             }
1206             if ($CPAN::META->exists($class,$xarg)) {
1207                 $obj = $CPAN::META->instance($class,$xarg);
1208             } elsif ($CPAN::META->exists($class,$arg)) {
1209                 $obj = $CPAN::META->instance($class,$arg);
1210             } else {
1211                 next;
1212             }
1213             push @m, $obj;
1214         }
1215     }
1216     return wantarray ? @m : $m[0];
1217 }
1218
1219 #-> sub CPAN::Shell::format_result ;
1220 sub format_result {
1221     my($self) = shift;
1222     my($type,@args) = @_;
1223     @args = '/./' unless @args;
1224     my(@result) = $self->expand($type,@args);
1225     my $result =  @result == 1 ?
1226         $result[0]->as_string :
1227             join "", map {$_->as_glimpse} @result;
1228     $result ||= "No objects of type $type found for argument @args\n";
1229     $result;
1230 }
1231
1232 #-> sub CPAN::Shell::rematein ;
1233 sub rematein {
1234     shift;
1235     my($meth,@some) = @_;
1236     my $pragma = "";
1237     if ($meth eq 'force') {
1238         $pragma = $meth;
1239         $meth = shift @some;
1240     }
1241     CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
1242     my($s,@s);
1243     foreach $s (@some) {
1244         my $obj;
1245         if (ref $s) {
1246             $obj = $s;
1247         } elsif ($s =~ m|/|) { # looks like a file
1248             $obj = $CPAN::META->instance('CPAN::Distribution',$s);
1249         } elsif ($s =~ m|^Bundle::|) {
1250             $obj = $CPAN::META->instance('CPAN::Bundle',$s);
1251         } else {
1252             $obj = $CPAN::META->instance('CPAN::Module',$s)
1253                 if $CPAN::META->exists('CPAN::Module',$s);
1254         }
1255         if (ref $obj) {
1256             CPAN->debug(
1257                         qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
1258                         $obj->as_string.
1259                         qq{\]}
1260                        ) if $CPAN::DEBUG;
1261             $obj->$pragma()
1262                 if
1263                     $pragma
1264                         &&
1265                     ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
1266             $obj->$meth();
1267         } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
1268             $obj = $CPAN::META->instance('CPAN::Author',$s);
1269             print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
1270         } else {
1271             print qq{Warning: Cannot $meth $s, don\'t know what it is.
1272 Try the command
1273
1274     i /$s/
1275
1276 to find objects with similar identifiers.
1277 };
1278         }
1279     }
1280 }
1281
1282 #-> sub CPAN::Shell::force ;
1283 sub force   { shift->rematein('force',@_); }
1284 #-> sub CPAN::Shell::get ;
1285 sub get     { shift->rematein('get',@_); }
1286 #-> sub CPAN::Shell::readme ;
1287 sub readme  { shift->rematein('readme',@_); }
1288 #-> sub CPAN::Shell::make ;
1289 sub make    { shift->rematein('make',@_); }
1290 #-> sub CPAN::Shell::test ;
1291 sub test    { shift->rematein('test',@_); }
1292 #-> sub CPAN::Shell::install ;
1293 sub install { shift->rematein('install',@_); }
1294 #-> sub CPAN::Shell::clean ;
1295 sub clean   { shift->rematein('clean',@_); }
1296 #-> sub CPAN::Shell::look ;
1297 sub look   { shift->rematein('look',@_); }
1298
1299 package CPAN::FTP;
1300 use vars qw($Ua);
1301 @CPAN::FTP::ISA = qw(CPAN::Debug);
1302
1303 #-> sub CPAN::FTP::ftp_get ;
1304 sub ftp_get {
1305     my($class,$host,$dir,$file,$target) = @_;
1306     $class->debug(
1307                        qq[Going to fetch file [$file] from dir [$dir]
1308         on host [$host] as local [$target]\n]
1309                       ) if $CPAN::DEBUG;
1310     my $ftp = Net::FTP->new($host);
1311     return 0 unless defined $ftp;
1312     $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
1313     $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
1314     unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
1315         warn "Couldn't login on $host";
1316         return;
1317     }
1318     # print qq[Going to ->cwd("$dir")\n];
1319     unless ( $ftp->cwd($dir) ){
1320         warn "Couldn't cwd $dir";
1321         return;
1322     }
1323     $ftp->binary;
1324     $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
1325     unless ( $ftp->get($file,$target) ){
1326         warn "Couldn't fetch $file from $host\n";
1327         return;
1328     }
1329     $ftp->quit; # it's ok if this fails
1330     return 1;
1331 }
1332
1333 #-> sub CPAN::FTP::localize ;
1334 sub localize {
1335     my($self,$file,$aslocal,$force) = @_;
1336     $force ||= 0;
1337     Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
1338         unless defined $aslocal;
1339     $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
1340
1341     return $aslocal if -f $aslocal && -r _ && ! $force;
1342     rename $aslocal, "$aslocal.bak" if -f $aslocal;
1343
1344     my($aslocal_dir) = File::Basename::dirname($aslocal);
1345     File::Path::mkpath($aslocal_dir);
1346     print STDERR qq{Warning: You are not allowed to write into }.
1347         qq{directory "$aslocal_dir".
1348     I\'ll continue, but if you face any problems, they may be due
1349     to insufficient permissions.\n} unless -w $aslocal_dir;
1350
1351     # Inheritance is not easier to manage than a few if/else branches
1352     if ($CPAN::META->hasLWP) {
1353         require LWP::UserAgent;
1354         unless ($Ua) {
1355             $Ua = new LWP::UserAgent;
1356             my($var);
1357             $Ua->proxy('ftp',  $var)
1358                 if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
1359             $Ua->proxy('http', $var)
1360                 if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
1361             $Ua->no_proxy($var)
1362                 if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
1363         }
1364     }
1365
1366     # Try the list of urls for each single object. We keep a record
1367     # where we did get a file from
1368     my($i);
1369     for $i (0..$#{$CPAN::Config->{urllist}}) {
1370         my $url = $CPAN::Config->{urllist}[$i];
1371         $url .= "/" unless substr($url,-1) eq "/";
1372         $url .= $file;
1373         $self->debug("localizing[$url]") if $CPAN::DEBUG;
1374         if ($url =~ /^file:/) {
1375             my $l;
1376             if ($CPAN::META->hasLWP) {
1377                 require URI::URL;
1378                 my $u = new URI::URL $url;
1379                 $l = $u->path;
1380             } else { # works only on Unix, is poorly constructed, but
1381                      # hopefully better than nothing.
1382                      # RFC 1738 says fileurl BNF is
1383                      # fileurl = "file://" [ host | "localhost" ] "/" fpath
1384                      # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
1385                 ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
1386                 $l =~ s/^file://;       # assume they meant file://localhost
1387             }
1388             return $l if -f $l && -r _;
1389             # Maybe mirror has compressed it?
1390             if (-f "$l.gz") {
1391                 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
1392                 system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
1393                 return $aslocal if -f $aslocal;
1394             }
1395         }
1396
1397         if ($CPAN::META->hasLWP) {
1398             print "Fetching $url with LWP\n";
1399             my $res = $Ua->mirror($url, $aslocal);
1400             if ($res->is_success) {
1401                 return $aslocal;
1402             }
1403         }
1404         if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1405             # that's the nice and easy way thanks to Graham
1406             my($host,$dir,$getfile) = ($1,$2,$3);
1407             if ($CPAN::META->hasFTP) {
1408                 $dir =~ s|/+|/|g;
1409                 $self->debug("Going to fetch file [$getfile]
1410   from dir [$dir]
1411   on host  [$host]
1412   as local [$aslocal]") if $CPAN::DEBUG;
1413                 CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
1414                 warn "Net::FTP failed for some reason\n";
1415             } else {
1416                 warn qq{
1417   Please, install Net::FTP as soon as possible. Just type
1418     install Net::FTP
1419   Thank you.
1420
1421 }
1422             }
1423         }
1424
1425         # Came back if Net::FTP couldn't establish connection (or failed otherwise)
1426         # Maybe they are behind a firewall, but they gave us
1427         # a socksified (or other) ftp program...
1428
1429         my($funkyftp);
1430         # does ncftp handle http?
1431         for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
1432             next unless defined $funkyftp;
1433             next unless -x $funkyftp;
1434             my($want_compressed);
1435             print(
1436                   qq{
1437 Trying with $funkyftp to get
1438   $url
1439 });
1440             $want_compressed = $aslocal =~ s/\.gz//;
1441             my($source_switch) = "";
1442             $source_switch = "-source" if $funkyftp =~ /\blynx$/;
1443             $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
1444             my($system) = "$funkyftp $source_switch '$url' > $aslocal";
1445             my($wstatus);
1446             if (($wstatus = system($system)) == 0) {
1447                 if ($want_compressed) {
1448                     $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1449                     if (system($system) == 0) {
1450                         rename $aslocal, "$aslocal.gz";
1451                     } else {
1452                         $system = "$CPAN::Config->{'gzip'} $aslocal";
1453                         system($system);
1454                     }
1455                     return "$aslocal.gz";
1456                 } else {
1457                     $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
1458                     if (system($system) == 0) {
1459                         $system = "$CPAN::Config->{'gzip'} -d $aslocal";
1460                         system($system);
1461                     } else {
1462                         # should be fine, eh?
1463                     }
1464                     return $aslocal;
1465                 }
1466             } else {
1467                 my $estatus = $wstatus >> 8;
1468                 print qq{
1469 System call "$system"
1470 returned status $estatus (wstat $wstatus)
1471 };
1472             }
1473         }
1474
1475         if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
1476             my($host,$dir,$getfile) = ($1,$2,$3);
1477             my($netrcfile,$fh);
1478             if (-x $CPAN::Config->{'ftp'}) {
1479                 my $timestamp = 0;
1480                 my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
1481                    $ctime,$blksize,$blocks) = stat($aslocal);
1482                 $timestamp = $mtime ||= 0;
1483
1484                 my($netrc) = CPAN::FTP::netrc->new;
1485                 my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
1486
1487                 my $targetfile = File::Basename::basename($aslocal);
1488                 my(@dialog);
1489                 push(
1490                      @dialog,
1491                      "lcd $aslocal_dir",
1492                      "cd /",
1493                      map("cd $_", split "/", $dir), # RFC 1738
1494                      "bin",
1495                      "get $getfile $targetfile",
1496                      "quit"
1497                     );
1498                 if (! $netrc->netrc) {
1499                     CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
1500                 } elsif ($netrc->hasdefault || $netrc->contains($host)) {
1501                     CPAN->debug(
1502                                 sprint(
1503                                        "hasdef[%d]cont($host)[%d]",
1504                                        $netrc->hasdefault,
1505                                        $netrc->contains($host)
1506                                       )
1507                                ) if $CPAN::DEBUG;
1508                     if ($netrc->protected) {
1509                         print(
1510                               qq{
1511   Trying with external ftp to get
1512     $url
1513   As this requires some features that are not thoroughly tested, we\'re
1514   not sure, that we get it right....
1515
1516 }
1517                              );
1518                         my $fh = FileHandle->new;
1519                         $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
1520                             or die "Couldn't open ftp: $!";
1521                         # pilot is blind now
1522                         CPAN->debug("dialog [".(join "|",@dialog)."]")
1523                             if $CPAN::DEBUG;
1524                         foreach (@dialog) { $fh->print("$_\n") }
1525                         $fh->close;             # Wait for process to complete
1526                         my $wstatus = $?;
1527                         my $estatus = $wstatus >> 8;
1528                         print qq{
1529 Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
1530   returned status $estatus (wstat $wstatus)
1531 } if $wstatus;
1532                         ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1533                          $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1534                         $mtime ||= 0;
1535                         if ($mtime > $timestamp) {
1536                             print "GOT $aslocal\n";
1537                             return $aslocal;
1538                         } else {
1539                             print "Hmm... Still failed!\n";
1540                         }
1541                     } else {
1542                         warn "Your $netrcfile is not correctly protected.\n";
1543                     }
1544                 } else {
1545                     warn "Your ~/.netrc neither contains $host
1546   nor does it have a default entry\n";
1547                 }
1548
1549                 # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
1550                 # login manually to host, using e-mail as password.
1551                 print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
1552                 unshift(
1553                         @dialog,
1554                         "open $host",
1555                         "user anonymous $Config::Config{'cf_email'}"
1556                        );
1557                 CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
1558                 $fh = FileHandle->new;
1559                 $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
1560                     die "Cannot fork: $!\n";
1561                 foreach (@dialog) { $fh->print("$_\n") }
1562                 $fh->close;
1563                 my $wstatus = $?;
1564                 my $estatus = $wstatus >> 8;
1565                 print qq{
1566 Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
1567   returned status $estatus (wstat $wstatus)
1568 } if $wstatus;
1569                 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1570                    $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
1571                 $mtime ||= 0;
1572                 if ($mtime > $timestamp) {
1573                     print "GOT $aslocal\n";
1574                     return $aslocal;
1575                 } else {
1576                     print "Bad luck... Still failed!\n";
1577                 }
1578             }
1579             sleep 2;
1580         }
1581
1582         print "Can't access URL $url.\n\n";
1583         my(@mess,$mess);
1584         push @mess, "LWP" unless CPAN->hasLWP;
1585         push @mess, "Net::FTP" unless CPAN->hasFTP;
1586         my($ext);
1587         for $ext (qw/lynx ncftp ftp/) {
1588             $CPAN::Config->{$ext} ||= "";
1589             push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
1590         }
1591         $mess = qq{Either get }.
1592             join(" or ",@mess).
1593             qq{ or check, if the URL found in your configuration file, }.
1594             $CPAN::Config->{urllist}[$i].
1595             qq{, is valid.};
1596         print Text::Wrap::wrap("","",$mess), "\n";
1597     }
1598     print "Cannot fetch $file\n";
1599     if (-f "$aslocal.bak") {
1600         rename "$aslocal.bak", $aslocal;
1601         print "Trying to get away with old file:\n";
1602         print $self->ls($aslocal);
1603         return $aslocal;
1604     }
1605     return;
1606 }
1607
1608 # find2perl needs modularization, too, all the following is stolen
1609 # from there
1610 sub ls {
1611     my($self,$name) = @_;
1612     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
1613      $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
1614
1615     my($perms,%user,%group);
1616     my $pname = $name;
1617
1618     if (defined $blocks) {
1619         $blocks = int(($blocks + 1) / 2);
1620     }
1621     else {
1622         $blocks = int(($sizemm + 1023) / 1024);
1623     }
1624
1625     if    (-f _) { $perms = '-'; }
1626     elsif (-d _) { $perms = 'd'; }
1627     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
1628     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
1629     elsif (-p _) { $perms = 'p'; }
1630     elsif (-S _) { $perms = 's'; }
1631     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
1632
1633     my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
1634     my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
1635     my $tmpmode = $mode;
1636     my $tmp = $rwx[$tmpmode & 7];
1637     $tmpmode >>= 3;
1638     $tmp = $rwx[$tmpmode & 7] . $tmp;
1639     $tmpmode >>= 3;
1640     $tmp = $rwx[$tmpmode & 7] . $tmp;
1641     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
1642     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
1643     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
1644     $perms .= $tmp;
1645
1646     my $user = $user{$uid} || $uid;   # too lazy to implement lookup
1647     my $group = $group{$gid} || $gid;
1648
1649     my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
1650     my($timeyear);
1651     my($moname) = $moname[$mon];
1652     if (-M _ > 365.25 / 2) {
1653         $timeyear = $year + 1900;
1654     }
1655     else {
1656         $timeyear = sprintf("%02d:%02d", $hour, $min);
1657     }
1658
1659     sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
1660             $ino,
1661                  $blocks,
1662                       $perms,
1663                             $nlink,
1664                                 $user,
1665                                      $group,
1666                                           $sizemm,
1667                                               $moname,
1668                                                  $mday,
1669                                                      $timeyear,
1670                                                          $pname;
1671 }
1672
1673 package CPAN::FTP::netrc;
1674
1675 sub new {
1676     my($class) = @_;
1677     my $file = MM->catfile($ENV{HOME},".netrc");
1678
1679     my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1680        $atime,$mtime,$ctime,$blksize,$blocks)
1681         = stat($file);
1682     $mode ||= 0;
1683     my $protected = 0;
1684
1685     my($fh,@machines,$hasdefault);
1686     $hasdefault = 0;
1687     $fh = FileHandle->new or die "Could not create a filehandle";
1688
1689     if($fh->open($file)){
1690         $protected = ($mode & 077) == 0;
1691         local($/) = "";
1692       NETRC: while (<$fh>) {
1693             my(@tokens) = split " ", $_;
1694           TOKEN: while (@tokens) {
1695                 my($t) = shift @tokens;
1696                 if ($t eq "default"){
1697                     $hasdefault++;
1698                     # warn "saw a default entry before tokens[@tokens]";
1699                     last NETRC;
1700                 }
1701                 last TOKEN if $t eq "macdef";
1702                 if ($t eq "machine") {
1703                     push @machines, shift @tokens;
1704                 }
1705             }
1706         }
1707     } else {
1708         $file = $hasdefault = $protected = "";
1709     }
1710
1711     bless {
1712            'mach' => [@machines],
1713            'netrc' => $file,
1714            'hasdefault' => $hasdefault,
1715            'protected' => $protected,
1716           }, $class;
1717 }
1718
1719 sub hasdefault { shift->{'hasdefault'} }
1720 sub netrc      { shift->{'netrc'}      }
1721 sub protected  { shift->{'protected'}  }
1722 sub contains {
1723     my($self,$mach) = @_;
1724     for ( @{$self->{'mach'}} ) {
1725         return 1 if $_ eq $mach;
1726     }
1727     return 0;
1728 }
1729
1730 package CPAN::Complete;
1731 @CPAN::Complete::ISA = qw(CPAN::Debug);
1732
1733 #-> sub CPAN::Complete::complete ;
1734 sub complete {
1735     my($word,$line,$pos) = @_;
1736     $word ||= "";
1737     $line ||= "";
1738     $pos ||= 0;
1739     CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1740     $line =~ s/^\s*//;
1741     if ($line =~ s/^(force\s*)//) {
1742         $pos -= length($1);
1743     }
1744     my @return;
1745     if ($pos == 0) {
1746         @return = grep(
1747                        /^$word/,
1748                        sort qw(
1749                                ! a b d h i m o q r u autobundle clean
1750                                make test install force reload look
1751                               )
1752                       );
1753     } elsif ( $line !~ /^[\!abdhimorutl]/ ) {
1754         @return = ();
1755     } elsif ($line =~ /^a\s/) {
1756         @return = completex('CPAN::Author',$word);
1757     } elsif ($line =~ /^b\s/) {
1758         @return = completex('CPAN::Bundle',$word);
1759     } elsif ($line =~ /^d\s/) {
1760         @return = completex('CPAN::Distribution',$word);
1761     } elsif ($line =~ /^([mru]|make|clean|test|install|readme|look)\s/ ) {
1762         @return = (completex('CPAN::Module',$word),completex('CPAN::Bundle',$word));
1763     } elsif ($line =~ /^i\s/) {
1764         @return = complete_any($word);
1765     } elsif ($line =~ /^reload\s/) {
1766         @return = complete_reload($word,$line,$pos);
1767     } elsif ($line =~ /^o\s/) {
1768         @return = complete_option($word,$line,$pos);
1769     } else {
1770         @return = ();
1771     }
1772     return @return;
1773 }
1774
1775 #-> sub CPAN::Complete::completex ;
1776 sub completex {
1777     my($class, $word) = @_;
1778     grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
1779 }
1780
1781 #-> sub CPAN::Complete::complete_any ;
1782 sub complete_any {
1783     my($word) = shift;
1784     return (
1785             completex('CPAN::Author',$word),
1786             completex('CPAN::Bundle',$word),
1787             completex('CPAN::Distribution',$word),
1788             completex('CPAN::Module',$word),
1789            );
1790 }
1791
1792 #-> sub CPAN::Complete::complete_reload ;
1793 sub complete_reload {
1794     my($word,$line,$pos) = @_;
1795     $word ||= "";
1796     my(@words) = split " ", $line;
1797     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1798     my(@ok) = qw(cpan index);
1799     return @ok if @words == 1;
1800     return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1801 }
1802
1803 #-> sub CPAN::Complete::complete_option ;
1804 sub complete_option {
1805     my($word,$line,$pos) = @_;
1806     $word ||= "";
1807     my(@words) = split " ", $line;
1808     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
1809     my(@ok) = qw(conf debug);
1810     return @ok if @words == 1;
1811     return grep /^\Q$word\E/, @ok if @words == 2 && $word;
1812     if (0) {
1813     } elsif ($words[1] eq 'index') {
1814         return ();
1815     } elsif ($words[1] eq 'conf') {
1816         return CPAN::Config::complete(@_);
1817     } elsif ($words[1] eq 'debug') {
1818         return sort grep /^\Q$word\E/, sort keys %CPAN::DEBUG, 'all';
1819     }
1820 }
1821
1822 package CPAN::Index;
1823 use vars qw($last_time $date_of_03);
1824 @CPAN::Index::ISA = qw(CPAN::Debug);
1825 $last_time ||= 0;
1826 $date_of_03 ||= 0;
1827
1828 #-> sub CPAN::Index::force_reload ;
1829 sub force_reload {
1830     my($class) = @_;
1831     $CPAN::Index::last_time = 0;
1832     $class->reload(1);
1833 }
1834
1835 #-> sub CPAN::Index::reload ;
1836 sub reload {
1837     my($cl,$force) = @_;
1838     my $time = time;
1839
1840     # XXX check if a newer one is available. (We currently read it from time to time)
1841     for ($CPAN::Config->{index_expire}) {
1842         $_ = 0.001 unless $_ > 0.001;
1843     }
1844     return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
1845     my($debug,$t2);
1846     $last_time = $time;
1847
1848     $cl->read_authindex($cl->reload_x(
1849                                       "authors/01mailrc.txt.gz",
1850                                       "01mailrc.gz",
1851                                       $force));
1852     $t2 = time;
1853     $debug = "timing reading 01[".($t2 - $time)."]";
1854     $time = $t2;
1855     return if $CPAN::Signal; # this is sometimes lengthy
1856     $cl->read_modpacks($cl->reload_x(
1857                                      "modules/02packages.details.txt.gz",
1858                                      "02packag.gz",
1859                                      $force));
1860     $t2 = time;
1861     $debug .= "02[".($t2 - $time)."]";
1862     $time = $t2;
1863     return if $CPAN::Signal; # this is sometimes lengthy
1864     $cl->read_modlist($cl->reload_x(
1865                                     "modules/03modlist.data.gz",
1866                                     "03mlist.gz",
1867                                     $force));
1868     $t2 = time;
1869     $debug .= "03[".($t2 - $time)."]";
1870     $time = $t2;
1871     CPAN->debug($debug) if $CPAN::DEBUG;
1872 }
1873
1874 #-> sub CPAN::Index::reload_x ;
1875 sub reload_x {
1876     my($cl,$wanted,$localname,$force) = @_;
1877     $force ||= 0;
1878     CPAN::Config->load; # we should guarantee loading wherever we rely on Config XXX
1879     my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
1880     if (
1881         -f $abs_wanted &&
1882         -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
1883         !$force
1884        ) {
1885         my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
1886         $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
1887                    qq{day$s. I\'ll use that.});
1888         return $abs_wanted;
1889     } else {
1890         $force ||= 1;
1891     }
1892     return CPAN::FTP->localize($wanted,$abs_wanted,$force);
1893 }
1894
1895 #-> sub CPAN::Index::read_authindex ;
1896 sub read_authindex {
1897     my($cl,$index_target) = @_;
1898     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1899     print "Going to read $index_target\n";
1900     my $fh = FileHandle->new("$pipe|");
1901     while (<$fh>) {
1902         chomp;
1903         my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
1904         next unless $userid && $fullname && $email;
1905
1906         # instantiate an author object
1907         my $userobj = $CPAN::META->instance('CPAN::Author',$userid);
1908         $userobj->set('FULLNAME' => $fullname, 'EMAIL' => $email);
1909         return if $CPAN::Signal;
1910     }
1911     $fh->close;
1912     $? and Carp::croak "FAILED $pipe: exit status [$?]";
1913 }
1914
1915 #-> sub CPAN::Index::read_modpacks ;
1916 sub read_modpacks {
1917     my($cl,$index_target) = @_;
1918     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1919     print "Going to read $index_target\n";
1920     my $fh = FileHandle->new("$pipe|");
1921     while (<$fh>) {
1922         last if /^\s*$/;
1923     }
1924     while (<$fh>) {
1925         chomp;
1926         my($mod,$version,$dist) = split;
1927 ###     $version =~ s/^\+//;
1928
1929         # if it as a bundle, instatiate a bundle object
1930         my($bundle,$id,$userid);
1931
1932         if ($mod eq 'CPAN') {
1933             local($^W)= 0;
1934             if ($version > $CPAN::VERSION){
1935                 print qq{
1936   There\'s a new CPAN.pm version (v$version) available!
1937   You might want to try
1938     install CPAN
1939     reload cpan
1940   without quitting the current session. It should be a seemless upgrade
1941   while we are running...
1942 };
1943                 sleep 2;
1944                 print qq{\n};
1945             }
1946             last if $CPAN::Signal;
1947         } elsif ($mod =~ /^Bundle::(.*)/) {
1948             $bundle = $1;
1949         }
1950
1951         if ($bundle){
1952             $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
1953 ###         $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
1954 # This "next" makes us faster but if the job is running long, we ignore
1955 # rereads which is bad. So we have to be a bit slower again.
1956 #       } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
1957 #           next;
1958         } else {
1959             # instantiate a module object
1960             $id = $CPAN::META->instance('CPAN::Module',$mod);
1961 ###         $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
1962 ###             if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
1963         }
1964
1965         if ($id->cpan_file ne $dist){
1966             # determine the author
1967             ($userid) = $dist =~ /([^\/]+)/;
1968             $id->set(
1969                      'CPAN_USERID' => $userid,
1970                      'CPAN_VERSION' => $version,
1971                      'CPAN_FILE' => $dist
1972                     );
1973         }
1974
1975         # instantiate a distribution object
1976         unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
1977             $CPAN::META->instance(
1978                                   'CPAN::Distribution' => $dist
1979                                  )->set(
1980                                         'CPAN_USERID' => $userid
1981                                        );
1982         }
1983
1984         return if $CPAN::Signal;
1985     }
1986     $fh->close;
1987     $? and Carp::croak "FAILED $pipe: exit status [$?]";
1988 }
1989
1990 #-> sub CPAN::Index::read_modlist ;
1991 sub read_modlist {
1992     my($cl,$index_target) = @_;
1993     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
1994     print "Going to read $index_target\n";
1995     my $fh = FileHandle->new("$pipe|");
1996     my $eval;
1997     while (<$fh>) {
1998         if (/^Date:\s+(.*)/){
1999             return if $date_of_03 eq $1;
2000             ($date_of_03) = $1;
2001         }
2002         last if /^\s*$/;
2003     }
2004     local($/) = undef;
2005     $eval = <$fh>;
2006     $fh->close;
2007     $eval .= q{CPAN::Modulelist->data;};
2008     local($^W) = 0;
2009     my($comp) = Safe->new("CPAN::Safe1");
2010     my $ret = $comp->reval($eval);
2011     Carp::confess($@) if $@;
2012     return if $CPAN::Signal;
2013     for (keys %$ret) {
2014         my $obj = $CPAN::META->instance(CPAN::Module,$_);
2015         $obj->set(%{$ret->{$_}});
2016         return if $CPAN::Signal;
2017     }
2018 }
2019
2020 package CPAN::InfoObj;
2021 @CPAN::InfoObj::ISA = qw(CPAN::Debug);
2022
2023 #-> sub CPAN::InfoObj::new ;
2024 sub new { my $this = bless {}, shift; %$this = @_; $this }
2025
2026 #-> sub CPAN::InfoObj::set ;
2027 sub set {
2028     my($self,%att) = @_;
2029     my(%oldatt) = %$self;
2030     %$self = (%oldatt, %att);
2031 }
2032
2033 #-> sub CPAN::InfoObj::id ;
2034 sub id { shift->{'ID'} }
2035
2036 #-> sub CPAN::InfoObj::as_glimpse ;
2037 sub as_glimpse {
2038     my($self) = @_;
2039     my(@m);
2040     my $class = ref($self);
2041     $class =~ s/^CPAN:://;
2042     push @m, sprintf "%-15s %s\n", $class, $self->{ID};
2043     join "", @m;
2044 }
2045
2046 #-> sub CPAN::InfoObj::as_string ;
2047 sub as_string {
2048     my($self) = @_;
2049     my(@m);
2050     my $class = ref($self);
2051     $class =~ s/^CPAN:://;
2052     push @m, $class, " id = $self->{ID}\n";
2053     for (sort keys %$self) {
2054         next if $_ eq 'ID';
2055         my $extra = "";
2056         $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
2057         if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
2058             push @m, sprintf "    %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
2059         } else {
2060             push @m, sprintf "    %-12s %s%s\n", $_, $self->{$_}, $extra;
2061         }
2062     }
2063     join "", @m, "\n";
2064 }
2065
2066 #-> sub CPAN::InfoObj::author ;
2067 sub author {
2068     my($self) = @_;
2069     $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
2070 }
2071
2072 package CPAN::Author;
2073 @CPAN::Author::ISA = qw(CPAN::InfoObj);
2074
2075 #-> sub CPAN::Author::as_glimpse ;
2076 sub as_glimpse {
2077     my($self) = @_;
2078     my(@m);
2079     my $class = ref($self);
2080     $class =~ s/^CPAN:://;
2081     push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
2082     join "", @m;
2083 }
2084
2085 # Dead code, I would have liked to have,,, but it was never reached,,,
2086 #sub make {
2087 #    my($self) = @_;
2088 #    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
2089 #}
2090
2091 #-> sub CPAN::Author::fullname ;
2092 sub fullname { shift->{'FULLNAME'} }
2093 *name = \&fullname;
2094 #-> sub CPAN::Author::email ;
2095 sub email    { shift->{'EMAIL'} }
2096
2097 package CPAN::Distribution;
2098 @CPAN::Distribution::ISA = qw(CPAN::InfoObj);
2099
2100 #-> sub CPAN::Distribution::called_for ;
2101 sub called_for {
2102     my($self,$id) = @_;
2103     $self->{'CALLED_FOR'} = $id if defined $id;
2104     return $self->{'CALLED_FOR'};
2105 }
2106
2107 #-> sub CPAN::Distribution::get ;
2108 sub get {
2109     my($self) = @_;
2110   EXCUSE: {
2111         my @e;
2112         exists $self->{'build_dir'} and push @e,
2113             "Unwrapped into directory $self->{'build_dir'}";
2114         print join "", map {"  $_\n"} @e and return if @e;
2115     }
2116     my($local_file);
2117     my($local_wanted) =
2118          CPAN->catfile(
2119                         $CPAN::Config->{keep_source_where},
2120                         "authors",
2121                         "id",
2122                         split("/",$self->{ID})
2123                        );
2124
2125     $self->debug("Doing localize") if $CPAN::DEBUG;
2126     $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
2127     $self->{localfile} = $local_file;
2128     my $builddir = $CPAN::META->{cachemgr}->dir;
2129     $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
2130     chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2131     my $packagedir;
2132
2133     $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
2134     if ($CPAN::META->hasMD5) {
2135         $self->verifyMD5;
2136     }
2137     if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
2138         $self->debug("Removing tmp") if $CPAN::DEBUG;
2139         File::Path::rmtree("tmp");
2140         mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
2141         chdir "tmp";
2142         $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
2143         if ($local_file =~ /z$/i){
2144             $self->{archived} = "tar";
2145             if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")== 0) {
2146                 $self->{unwrapped} = "YES";
2147             } else {
2148                 $self->{unwrapped} = "NO";
2149             }
2150         } elsif ($local_file =~ /zip$/i) {
2151             $self->{archived} = "zip";
2152             if (system("$CPAN::Config->{unzip} $local_file") == 0) {
2153                 $self->{unwrapped} = "YES";
2154             } else {
2155                 $self->{unwrapped} = "NO";
2156             }
2157         }
2158         # Let's check if the package has its own directory.
2159         opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
2160         my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
2161         closedir DIR;
2162         my ($distdir,$packagedir);
2163         if (@readdir == 1 && -d $readdir[0]) {
2164             $distdir = $readdir[0];
2165             $packagedir = $CPAN::META->catdir($builddir,$distdir);
2166             -d $packagedir and print "Removing previously used $packagedir\n";
2167             File::Path::rmtree($packagedir);
2168             rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
2169         } else {
2170             my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
2171             $pragmatic_dir =~ s/\W_//g;
2172             $pragmatic_dir++ while -d "../$pragmatic_dir";
2173             $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
2174             File::Path::mkpath($packagedir);
2175             my($f);
2176             for $f (@readdir) { # is already without "." and ".."
2177                 my $to = $CPAN::META->catdir($packagedir,$f);
2178                 rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
2179             }
2180         }
2181         $self->{'build_dir'} = $packagedir;
2182
2183         chdir "..";
2184         $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
2185             if $CPAN::DEBUG;
2186         File::Path::rmtree("tmp");
2187         if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
2188             print "Going to unlink $local_file\n";
2189             unlink $local_file or Carp::carp "Couldn't unlink $local_file";
2190         }
2191         my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
2192         unless (-f $makefilepl) {
2193             my($configure) = $CPAN::META->catfile($packagedir,"Configure");
2194             if (-f $configure) {
2195                 # do we have anything to do?
2196                 $self->{'configure'} = $configure;
2197             } else {
2198                 my $fh = FileHandle->new(">$makefilepl")
2199                     or Carp::croak("Could not open >$makefilepl");
2200                 my $cf = $self->called_for || "unknown";
2201                 $fh->print(qq{
2202 # This Makefile.PL has been autogenerated by the module CPAN.pm
2203 # Autogenerated on: }.scalar localtime().qq{
2204                     use ExtUtils::MakeMaker;
2205                     WriteMakefile(NAME => q[$cf]);
2206 });
2207                 print qq{Package comes without Makefile.PL.\n}.
2208                     qq{  Writing one on our own (calling it $cf)\n};
2209             }
2210         }
2211     } else {
2212         $self->{archived} = "NO";
2213     }
2214     return $self;
2215 }
2216
2217 #-> sub CPAN::Distribution::new ;
2218 sub new {
2219     my($class,%att) = @_;
2220
2221     $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
2222
2223     my $this = { %att };
2224     return bless $this, $class;
2225 }
2226
2227 #-> sub CPAN::Distribution::look ;
2228 sub look {
2229     my($self) = @_;
2230     if (  $CPAN::Config->{'shell'} ) {
2231         print qq{
2232 Trying to open a subshell in the build directory...
2233 };
2234     } else {
2235         print qq{
2236 Your configuration does not define a value for subshells.
2237 Please define it with "o conf shell <your shell>"
2238 };
2239         return;
2240     }
2241     my $dist = $self->id;
2242     my $dir  = $self->dir or $self->get;
2243     $dir = $self->dir;
2244     my $getcwd;
2245     $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2246     my $pwd  = Cwd->$getcwd();
2247     chdir($dir);
2248     print qq{Working directory is $dir.\n};
2249     system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
2250     chdir($pwd);
2251 }
2252
2253 #-> sub CPAN::Distribution::readme ;
2254 sub readme {
2255     my($self) = @_;
2256     my($dist) = $self->id;
2257     my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
2258     $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
2259     my($local_file);
2260     my($local_wanted) =
2261          CPAN->catfile(
2262                         $CPAN::Config->{keep_source_where},
2263                         "authors",
2264                         "id",
2265                         split("/","$sans.readme"),
2266                        );
2267     $self->debug("Doing localize") if $CPAN::DEBUG;
2268     $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
2269     my $fh_pager = FileHandle->new;
2270     $fh_pager->open("|$CPAN::Config->{'pager'}")
2271         or die "Could not open pager $CPAN::Config->{'pager'}: $!";
2272     my $fh_readme = FileHandle->new;
2273     $fh_readme->open($local_file) or die "Could not open $local_file: $!";
2274     $fh_pager->print(<$fh_readme>);
2275 }
2276
2277 #-> sub CPAN::Distribution::verifyMD5 ;
2278 sub verifyMD5 {
2279     my($self) = @_;
2280   EXCUSE: {
2281         my @e;
2282         $self->{MD5_STATUS} ||= "";
2283         $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
2284         print join "", map {"  $_\n"} @e and return if @e;
2285     }
2286     my($local_file);
2287     my(@local) = split("/",$self->{ID});
2288     my($basename) = pop @local;
2289     push @local, "CHECKSUMS";
2290     my($local_wanted) =
2291         CPAN->catfile(
2292                       $CPAN::Config->{keep_source_where},
2293                       "authors",
2294                       "id",
2295                       @local
2296                      );
2297     local($") = "/";
2298     if (
2299         -f $local_wanted
2300         &&
2301         $self->MD5_check_file($local_wanted,$basename)
2302        ) {
2303         return $self->{MD5_STATUS} = "OK";
2304     }
2305     $local_file = CPAN::FTP->localize(
2306                                       "authors/id/@local",
2307                                       $local_wanted,
2308                                       'force>:-{');
2309     my($checksum_pipe);
2310     if ($local_file) {
2311         # fine
2312     } else {
2313         $local[-1] .= ".gz";
2314         $local_file = CPAN::FTP->localize(
2315                                           "authors/id/@local",
2316                                           "$local_wanted.gz",
2317                                           'force>:-{'
2318                                          );
2319         my $system = "$CPAN::Config->{gzip} --decompress $local_file";
2320         system($system) == 0 or die "Could not uncompress $local_file";
2321         $local_file =~ s/\.gz$//;
2322     }
2323     $self->MD5_check_file($local_file,$basename);
2324 }
2325
2326 #-> sub CPAN::Distribution::MD5_check_file ;
2327 sub MD5_check_file {
2328     my($self,$lfile,$basename) = @_;
2329     my($cksum);
2330     my $fh = new FileHandle;
2331     local($/) = undef;
2332     if (open $fh, $lfile){
2333         my $eval = <$fh>;
2334         close $fh;
2335         my($comp) = Safe->new();
2336         $cksum = $comp->reval($eval);
2337         Carp::confess($@) if $@;
2338         if ($cksum->{$basename}->{md5}) {
2339             $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n")
2340                 if $CPAN::DEBUG;
2341             my $file = $self->{localfile};
2342             my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
2343             if (
2344                 open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
2345                 or
2346                 open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
2347                ){
2348                 print "Checksum for $file ok\n";
2349                 return $self->{MD5_STATUS} = "OK";
2350             } else {
2351                 print join(
2352                            "",
2353                            qq{Checksum mismatch for distribution file. },
2354                            qq{Please investigate.\n\n}
2355                           );
2356                 print $self->as_string;
2357                 print $CPAN::META->instance(
2358                                             'CPAN::Author',
2359                                             $self->{CPAN_USERID}
2360                                            )->as_string;
2361                 my $wrap = qq{I\'d recommend removing $self->{'localfile'}}.
2362                     qq{, put another URL at the top of the list of URLs to }.
2363                     qq{visit, and restart CPAN.pm. If all this doesn\'t help, }.
2364                     qq{please contact the author or your CPAN site admin};
2365                 print Text::Wrap::wrap("","",$wrap);
2366                 print "\n\n";
2367                 sleep 3;
2368                 return;
2369             }
2370             close $fh if fileno($fh);
2371         } else {
2372             $self->{MD5_STATUS} ||= "";
2373             if ($self->{MD5_STATUS} eq "NIL") {
2374                 print "\nNo md5 checksum for $basename in local $lfile.";
2375                 print "Removing $lfile\n";
2376                 unlink $lfile or print "Could not unlink: $!";
2377                 sleep 1;
2378             }
2379             $self->{MD5_STATUS} = "NIL";
2380             return;
2381         }
2382     } else {
2383         Carp::carp "Could not open $lfile for reading";
2384     }
2385 }
2386
2387 #-> sub CPAN::Distribution::eq_MD5 ;
2388 sub eq_MD5 {
2389     my($self,$fh,$expectMD5) = @_;
2390     my $md5 = new MD5;
2391     $md5->addfile($fh);
2392     my $hexdigest = $md5->hexdigest;
2393     $hexdigest eq $expectMD5;
2394 }
2395
2396 #-> sub CPAN::Distribution::force ;
2397 sub force {
2398     my($self) = @_;
2399     $self->{'force_update'}++;
2400     delete $self->{'MD5_STATUS'};
2401     delete $self->{'archived'};
2402     delete $self->{'build_dir'};
2403     delete $self->{'localfile'};
2404     delete $self->{'make'};
2405     delete $self->{'install'};
2406     delete $self->{'unwrapped'};
2407     delete $self->{'writemakefile'};
2408 }
2409
2410 #-> sub CPAN::Distribution::perl ;
2411 sub perl {
2412     my($self) = @_;
2413     my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
2414     my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2415     my $pwd  = Cwd->$getcwd();
2416     my $candidate = $CPAN::META->catfile($pwd,$^X);
2417     $perl ||= $candidate if MM->maybe_command($candidate);
2418     unless ($perl) {
2419         my ($component,$perl_name);
2420       DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
2421             PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
2422                   next unless defined($component) && $component;
2423                   my($abs) = MM->catfile($component,$perl_name);
2424                   if (MM->maybe_command($abs)) {
2425                       $perl = $abs;
2426                       last DIST_PERLNAME;
2427                   }
2428               }
2429           }
2430     }
2431     $perl;
2432 }
2433
2434 #-> sub CPAN::Distribution::make ;
2435 sub make {
2436     my($self) = @_;
2437     $self->debug($self->id) if $CPAN::DEBUG;
2438     print "Running make\n";
2439     $self->get;
2440   EXCUSE: {
2441         my @e;
2442         $self->{archived} eq "NO" and push @e,
2443         "Is neither a tar nor a zip archive.";
2444
2445         $self->{unwrapped} eq "NO" and push @e,
2446         "had problems unarchiving. Please build manually";
2447
2448         exists $self->{writemakefile} &&
2449             $self->{writemakefile} eq "NO" and push @e,
2450             "Had some problem writing Makefile";
2451
2452         defined $self->{'make'} and push @e,
2453         "Has already been processed within this session";
2454
2455         print join "", map {"  $_\n"} @e and return if @e;
2456     }
2457     print "\n  CPAN.pm: Going to build ".$self->id."\n\n";
2458     my $builddir = $self->dir;
2459     chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
2460     $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
2461
2462     my $system;
2463     if ($self->{'configure'}) {
2464         $system = $self->{'configure'};
2465     } else {
2466         my($perl) = $self->perl or die "Couldn\'t find executable perl\n";
2467         my $switch = "";
2468 # This needs a handler that can be turned on or off:
2469 #       $switch = "-MExtUtils::MakeMaker ".
2470 #           "-Mops=:default,:filesys_read,:filesys_open,require,chdir"
2471 #           if $] > 5.00310;
2472         $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
2473     }
2474     {
2475         local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
2476         my($ret,$pid);
2477         $@ = "";
2478         if ($CPAN::Config->{inactivity_timeout}) {
2479             eval {
2480                 alarm $CPAN::Config->{inactivity_timeout};
2481                 local $SIG{CHLD} = sub { wait };
2482                 if (defined($pid = fork)) {
2483                     if ($pid) { #parent
2484                         wait;
2485                     } else {    #child
2486                         exec $system;
2487                     }
2488                 } else {
2489                     print "Cannot fork: $!";
2490                     return;
2491                 }
2492             };
2493             alarm 0;
2494             if ($@){
2495                 kill 9, $pid;
2496                 waitpid $pid, 0;
2497                 print $@;
2498                 $self->{writemakefile} = "NO - $@";
2499                 $@ = "";
2500                 return;
2501             }
2502         } else {
2503             $ret = system($system);
2504             if ($ret != 0) {
2505                 $self->{writemakefile} = "NO";
2506                 return;
2507             }
2508         }
2509     }
2510     $self->{writemakefile} = "YES";
2511     return if $CPAN::Signal;
2512     $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
2513     if (system($system) == 0) {
2514          print "  $system -- OK\n";
2515          $self->{'make'} = "YES";
2516     } else {
2517          $self->{writemakefile} = "YES";
2518          $self->{'make'} = "NO";
2519          print "  $system -- NOT OK\n";
2520     }
2521 }
2522
2523 #-> sub CPAN::Distribution::test ;
2524 sub test {
2525     my($self) = @_;
2526     $self->make;
2527     return if $CPAN::Signal;
2528     print "Running make test\n";
2529   EXCUSE: {
2530         my @e;
2531         exists $self->{'make'} or push @e,
2532         "Make had some problems, maybe interrupted? Won't test";
2533
2534         exists $self->{'make'} and
2535             $self->{'make'} eq 'NO' and
2536                 push @e, "Oops, make had returned bad status";
2537
2538         exists $self->{'build_dir'} or push @e, "Has no own directory";
2539         print join "", map {"  $_\n"} @e and return if @e;
2540     }
2541     chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2542     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2543     my $system = join " ", $CPAN::Config->{'make'}, "test";
2544     if (system($system) == 0) {
2545          print "  $system -- OK\n";
2546          $self->{'make_test'} = "YES";
2547     } else {
2548          $self->{'make_test'} = "NO";
2549          print "  $system -- NOT OK\n";
2550     }
2551 }
2552
2553 #-> sub CPAN::Distribution::clean ;
2554 sub clean {
2555     my($self) = @_;
2556     print "Running make clean\n";
2557   EXCUSE: {
2558         my @e;
2559         exists $self->{'build_dir'} or push @e, "Has no own directory";
2560         print join "", map {"  $_\n"} @e and return if @e;
2561     }
2562     chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2563     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2564     my $system = join " ", $CPAN::Config->{'make'}, "clean";
2565     if (system($system) == 0) {
2566         print "  $system -- OK\n";
2567         $self->force;
2568     } else {
2569         # Hmmm, what to do if make clean failed?
2570     }
2571 }
2572
2573 #-> sub CPAN::Distribution::install ;
2574 sub install {
2575     my($self) = @_;
2576     $self->test;
2577     return if $CPAN::Signal;
2578     print "Running make install\n";
2579   EXCUSE: {
2580         my @e;
2581         exists $self->{'build_dir'} or push @e, "Has no own directory";
2582
2583         exists $self->{'make'} or push @e,
2584         "Make had some problems, maybe interrupted? Won't install";
2585
2586         exists $self->{'make'} and
2587             $self->{'make'} eq 'NO' and
2588                 push @e, "Oops, make had returned bad status";
2589
2590         push @e, "make test had returned bad status, won't install without force"
2591             if exists $self->{'make_test'} and
2592             $self->{'make_test'} eq 'NO' and
2593             ! $self->{'force_update'};
2594
2595         exists $self->{'install'} and push @e,
2596         $self->{'install'} eq "YES" ?
2597             "Already done" : "Already tried without success";
2598
2599         print join "", map {"  $_\n"} @e and return if @e;
2600     }
2601     chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
2602     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
2603     my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
2604     my($pipe) = FileHandle->new("$system 2>&1 |");
2605     my($makeout) = "";
2606     while (<$pipe>){
2607         print;
2608         $makeout .= $_;
2609     }
2610     $pipe->close;
2611     if ($?==0) {
2612          print "  $system -- OK\n";
2613          $self->{'install'} = "YES";
2614     } else {
2615          $self->{'install'} = "NO";
2616          print "  $system -- NOT OK\n";
2617          if ($makeout =~ /permission/s && $> > 0) {
2618              print "    You may have to su to root to install the package\n";
2619          }
2620     }
2621 }
2622
2623 #-> sub CPAN::Distribution::dir ;
2624 sub dir {
2625     shift->{'build_dir'};
2626 }
2627
2628 package CPAN::Bundle;
2629 @CPAN::Bundle::ISA = qw(CPAN::Module);
2630
2631 #-> sub CPAN::Bundle::as_string ;
2632 sub as_string {
2633     my($self) = @_;
2634     $self->contains;
2635     $self->{INST_VERSION} = $self->inst_version;
2636     return $self->SUPER::as_string;
2637 }
2638
2639 #-> sub CPAN::Bundle::contains ;
2640 sub contains {
2641     my($self) = @_;
2642     my($parsefile) = $self->inst_file;
2643     unless ($parsefile) {
2644         # Try to get at it in the cpan directory
2645         $self->debug("no parsefile") if $CPAN::DEBUG;
2646         my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
2647         $dist->get;
2648         $self->debug($dist->as_string) if $CPAN::DEBUG;
2649         my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
2650         File::Path::mkpath($todir);
2651         my($me,$from,$to);
2652         ($me = $self->id) =~ s/.*://;
2653         $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
2654         $to = $CPAN::META->catfile($todir,"$me.pm");
2655         File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
2656         $parsefile = $to;
2657     }
2658     my @result;
2659     my $fh = new FileHandle;
2660     local $/ = "\n";
2661     open($fh,$parsefile) or die "Could not open '$parsefile': $!";
2662     my $inpod = 0;
2663     $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
2664     while (<$fh>) {
2665         $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
2666         next unless $inpod;
2667         next if /^=/;
2668         next if /^\s+$/;
2669         chomp;
2670         push @result, (split " ", $_, 2)[0];
2671     }
2672     close $fh;
2673     delete $self->{STATUS};
2674     $self->{CONTAINS} = join ", ", @result;
2675     $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
2676     @result;
2677 }
2678
2679 #-> sub CPAN::Bundle::find_bundle_file
2680 sub find_bundle_file {
2681     my($self,$where,$what) = @_;
2682     my $bu = $CPAN::META->catfile($where,$what);
2683     return $bu if -f $bu;
2684     my $manifest = $CPAN::META->catfile($where,"MANIFEST");
2685     unless (-f $manifest) {
2686         require ExtUtils::Manifest;
2687         my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
2688         my $cwd = Cwd->$getcwd();
2689         chdir $where;
2690         ExtUtils::Manifest::mkmanifest();
2691         chdir $cwd;
2692     }
2693     my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
2694     local($/) = "\n";
2695     while (<$fh>) {
2696         next if /^\s*\#/;
2697         my($file) = /(\S+)/;
2698         if ($file =~ m|Bundle/$what$|) {
2699             $bu = $file;
2700             return $CPAN::META->catfile($where,$bu);
2701         }
2702     }
2703     Carp::croak("Could't find a Bundle file in $where");
2704 }
2705
2706 #-> sub CPAN::Bundle::inst_file ;
2707 sub inst_file {
2708     my($self) = @_;
2709     my($me,$inst_file);
2710     ($me = $self->id) =~ s/.*://;
2711     $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
2712     return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2713 #    $inst_file =
2714     $self->SUPER::inst_file;
2715 #    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
2716 #    return $self->{'INST_FILE'}; # even if undefined?
2717 }
2718
2719 #-> sub CPAN::Bundle::rematein ;
2720 sub rematein {
2721     my($self,$meth) = @_;
2722     $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
2723     my($s);
2724     for $s ($self->contains) {
2725         my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
2726             $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
2727         if ($type eq 'CPAN::Distribution') {
2728             warn qq{
2729 The Bundle }.$self->id.qq{ contains
2730 explicitly a file $s.
2731 };
2732             sleep 3;
2733         }
2734         $CPAN::META->instance($type,$s)->$meth();
2735     }
2736 }
2737
2738 #sub CPAN::Bundle::xs_file
2739 sub xs_file {
2740     # If a bundle contains another that contains an xs_file we have
2741     # here, we just don't bother I suppose
2742     return 0;
2743 }
2744
2745 #-> sub CPAN::Bundle::force ;
2746 sub force   { shift->rematein('force',@_); }
2747 #-> sub CPAN::Bundle::get ;
2748 sub get     { shift->rematein('get',@_); }
2749 #-> sub CPAN::Bundle::make ;
2750 sub make    { shift->rematein('make',@_); }
2751 #-> sub CPAN::Bundle::test ;
2752 sub test    { shift->rematein('test',@_); }
2753 #-> sub CPAN::Bundle::install ;
2754 sub install { shift->rematein('install',@_); }
2755 #-> sub CPAN::Bundle::clean ;
2756 sub clean   { shift->rematein('clean',@_); }
2757
2758 #-> sub CPAN::Bundle::readme ;
2759 sub readme  {
2760     my($self) = @_;
2761     my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
2762     $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
2763     $CPAN::META->instance('CPAN::Distribution',$file)->readme;
2764 }
2765
2766 package CPAN::Module;
2767 @CPAN::Module::ISA = qw(CPAN::InfoObj);
2768
2769 #-> sub CPAN::Module::as_glimpse ;
2770 sub as_glimpse {
2771     my($self) = @_;
2772     my(@m);
2773     my $class = ref($self);
2774     $class =~ s/^CPAN:://;
2775     push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
2776     join "", @m;
2777 }
2778
2779 #-> sub CPAN::Module::as_string ;
2780 sub as_string {
2781     my($self) = @_;
2782     my(@m);
2783     CPAN->debug($self) if $CPAN::DEBUG;
2784     my $class = ref($self);
2785     $class =~ s/^CPAN:://;
2786     local($^W) = 0;
2787     push @m, $class, " id = $self->{ID}\n";
2788     my $sprintf = "    %-12s %s\n";
2789     push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
2790     my $sprintf2 = "    %-12s %s (%s)\n";
2791     my($userid);
2792     if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
2793         push @m, sprintf(
2794                          $sprintf2,
2795                          'CPAN_USERID',
2796                          $userid,
2797                          CPAN::Shell->expand('Author',$userid)->fullname
2798                         )
2799     }
2800     push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
2801     push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
2802     my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
2803     my(%statd,%stats,%statl,%stati);
2804     @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
2805     @stats{qw,? m d u n,}       = qw,unknown mailing-list developer comp.lang.perl.* none,;
2806     @statl{qw,? p c + o,}       = qw,unknown perl C C++ other,;
2807     @stati{qw,? f r O,}         = qw,unknown functions references+ties object-oriented,;
2808     $statd{' '} = 'unknown';
2809     $stats{' '} = 'unknown';
2810     $statl{' '} = 'unknown';
2811     $stati{' '} = 'unknown';
2812     push @m, sprintf(
2813                      $sprintf3,
2814                      'DSLI_STATUS',
2815                      $self->{statd},
2816                      $self->{stats},
2817                      $self->{statl},
2818                      $self->{stati},
2819                      $statd{$self->{statd}},
2820                      $stats{$self->{stats}},
2821                      $statl{$self->{statl}},
2822                      $stati{$self->{stati}}
2823                     ) if $self->{statd};
2824     my $local_file = $self->inst_file;
2825     if ($local_file && ! exists $self->{MANPAGE}) {
2826         my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
2827         my $inpod = 0;
2828         my(@result);
2829         local $/ = "\n";
2830         while (<$fh>) {
2831             $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
2832             next unless $inpod;
2833             next if /^=/;
2834             next if /^\s+$/;
2835             chomp;
2836             push @result, $_;
2837         }
2838         close $fh;
2839         $self->{MANPAGE} = join " ", @result;
2840     }
2841     my($item);
2842     for $item (qw/MANPAGE CONTAINS/) {
2843         push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
2844     }
2845     push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
2846     push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
2847     join "", @m, "\n";
2848 }
2849
2850 #-> sub CPAN::Module::cpan_file ;
2851 sub cpan_file    {
2852     my $self = shift;
2853     CPAN->debug($self->id) if $CPAN::DEBUG;
2854     unless (defined $self->{'CPAN_FILE'}) {
2855         CPAN::Index->reload;
2856     }
2857     if (defined $self->{'CPAN_FILE'}){
2858         return $self->{'CPAN_FILE'};
2859     } elsif (defined $self->{'userid'}) {
2860         return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
2861     } else {
2862         return "N/A";
2863     }
2864 }
2865
2866 *name = \&cpan_file;
2867
2868 #-> sub CPAN::Module::cpan_version ;
2869 sub cpan_version { shift->{'CPAN_VERSION'} }
2870
2871 #-> sub CPAN::Module::force ;
2872 sub force {
2873     my($self) = @_;
2874     $self->{'force_update'}++;
2875 }
2876
2877 #-> sub CPAN::Module::rematein ;
2878 sub rematein {
2879     my($self,$meth) = @_;
2880     $self->debug($self->id) if $CPAN::DEBUG;
2881     my $cpan_file = $self->cpan_file;
2882     return if $cpan_file eq "N/A";
2883     return if $cpan_file =~ /^Contact Author/;
2884     my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
2885     $pack->called_for($self->id);
2886     $pack->force if exists $self->{'force_update'};
2887     $pack->$meth();
2888     delete $self->{'force_update'};
2889 }
2890
2891 #-> sub CPAN::Module::readme ;
2892 sub readme { shift->rematein('readme') }
2893 #-> sub CPAN::Module::look ;
2894 sub look { shift->rematein('look') }
2895 #-> sub CPAN::Module::get ;
2896 sub get    { shift->rematein('get',@_); }
2897 #-> sub CPAN::Module::make ;
2898 sub make   { shift->rematein('make') }
2899 #-> sub CPAN::Module::test ;
2900 sub test   { shift->rematein('test') }
2901 #-> sub CPAN::Module::install ;
2902 sub install {
2903     my($self) = @_;
2904     my($doit) = 0;
2905     my($latest) = $self->cpan_version;
2906     $latest ||= 0;
2907     my($inst_file) = $self->inst_file;
2908     my($have) = 0;
2909     if (defined $inst_file) {
2910         $have = $self->inst_version;
2911     }
2912     if (1){ # A block for scoping $^W, the if is just for the visual
2913             # appeal
2914         local($^W)=0;
2915         if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
2916             print $self->id, " is up to date.\n";
2917         } else {
2918             $doit = 1;
2919         }
2920     }
2921     $self->rematein('install') if $doit;
2922 }
2923 #-> sub CPAN::Module::clean ;
2924 sub clean  { shift->rematein('clean') }
2925
2926 #-> sub CPAN::Module::inst_file ;
2927 sub inst_file {
2928     my($self) = @_;
2929     my($dir,@packpath);
2930     @packpath = split /::/, $self->{ID};
2931     $packpath[-1] .= ".pm";
2932     foreach $dir (@INC) {
2933         my $pmfile = CPAN->catfile($dir,@packpath);
2934         if (-f $pmfile){
2935             return $pmfile;
2936         }
2937     }
2938     return;
2939 }
2940
2941 #-> sub CPAN::Module::xs_file ;
2942 sub xs_file {
2943     my($self) = @_;
2944     my($dir,@packpath);
2945     @packpath = split /::/, $self->{ID};
2946     push @packpath, $packpath[-1];
2947     $packpath[-1] .= "." . $Config::Config{'dlext'};
2948     foreach $dir (@INC) {
2949         my $xsfile = CPAN->catfile($dir,'auto',@packpath);
2950         if (-f $xsfile){
2951             return $xsfile;
2952         }
2953     }
2954     return;
2955 }
2956
2957 #-> sub CPAN::Module::inst_version ;
2958 sub inst_version {
2959     my($self) = @_;
2960     my $parsefile = $self->inst_file or return 0;
2961     local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
2962     my $have = MM->parse_version($parsefile);
2963     $have ||= 0;
2964     $have =~ s/\s+//g;
2965     $have ||= 0;
2966     $have;
2967 }
2968
2969 # Do this after you have set up the whole inheritance
2970 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
2971
2972 1;
2973 __END__
2974
2975 =head1 NAME
2976
2977 CPAN - query, download and build perl modules from CPAN sites
2978
2979 =head1 SYNOPSIS
2980
2981 Interactive mode:
2982
2983   perl -MCPAN -e shell;
2984
2985 Batch mode:
2986
2987   use CPAN;
2988
2989   autobundle, clean, install, make, recompile, test
2990
2991 =head1 DESCRIPTION
2992
2993 The CPAN module is designed to automate the make and install of perl
2994 modules and extensions. It includes some searching capabilities and
2995 knows how to use Net::FTP or LWP (or lynx or an external ftp client)
2996 to fetch the raw data from the net.
2997
2998 Modules are fetched from one or more of the mirrored CPAN
2999 (Comprehensive Perl Archive Network) sites and unpacked in a dedicated
3000 directory.
3001
3002 The CPAN module also supports the concept of named and versioned
3003 'bundles' of modules. Bundles simplify the handling of sets of
3004 related modules. See BUNDLES below.
3005
3006 The package contains a session manager and a cache manager. There is
3007 no status retained between sessions. The session manager keeps track
3008 of what has been fetched, built and installed in the current
3009 session. The cache manager keeps track of the disk space occupied by
3010 the make processes and deletes excess space according to a simple FIFO
3011 mechanism.
3012
3013 All methods provided are accessible in a programmer style and in an
3014 interactive shell style.
3015
3016 =head2 Interactive Mode
3017
3018 The interactive mode is entered by running
3019
3020     perl -MCPAN -e shell
3021
3022 which puts you into a readline interface. You will have most fun if
3023 you install Term::ReadKey and Term::ReadLine to enjoy both history and
3024 completion.
3025
3026 Once you are on the command line, type 'h' and the rest should be
3027 self-explanatory.
3028
3029 The most common uses of the interactive modes are
3030
3031 =over 2
3032
3033 =item Searching for authors, bundles, distribution files and modules
3034
3035 There are corresponding one-letter commands C<a>, C<b>, C<d>, and C<m>
3036 for each of the four categories and another, C<i> for any of the
3037 mentioned four. Each of the four entities is implemented as a class
3038 with slightly differing methods for displaying an object.
3039
3040 Arguments you pass to these commands are either strings matching exact
3041 the identification string of an object or regular expressions that are
3042 then matched case-insensitively against various attributes of the
3043 objects. The parser recognizes a regualar expression only if you
3044 enclose it between two slashes.
3045
3046 The principle is that the number of found objects influences how an
3047 item is displayed. If the search finds one item, we display the result
3048 of object-E<gt>as_string, but if we find more than one, we display
3049 each as object-E<gt>as_glimpse. E.g.
3050
3051     cpan> a ANDK
3052     Author id = ANDK
3053         EMAIL        a.koenig@franz.ww.TU-Berlin.DE
3054         FULLNAME     Andreas König
3055
3056
3057     cpan> a /andk/
3058     Author id = ANDK
3059         EMAIL        a.koenig@franz.ww.TU-Berlin.DE
3060         FULLNAME     Andreas König
3061
3062
3063     cpan> a /and.*rt/
3064     Author          ANDYD (Andy Dougherty)
3065     Author          MERLYN (Randal L. Schwartz)
3066
3067 =item make, test, install, clean  modules or distributions
3068
3069 These commands do indeed exist just as written above. Each of them
3070 takes any number of arguments and investigates for each what it might
3071 be. Is it a distribution file (recognized by embedded slashes), this
3072 file is being processed. Is it a module, CPAN determines the
3073 distribution file where this module is included and processes that.
3074
3075 Any C<make>, C<test>, and C<readme> are run unconditionally. A
3076
3077   install <distribution_file>
3078
3079 also is run unconditionally.  But for
3080
3081   install <module>
3082
3083 CPAN checks if an install is actually needed for it and prints
3084 I<Foo up to date> in case the module doesnE<39>t need to be updated.
3085
3086 CPAN also keeps track of what it has done within the current session
3087 and doesnE<39>t try to build a package a second time regardless if it
3088 succeeded or not. The C<force > command takes as first argument the
3089 method to invoke (currently: make, test, or install) and executes the
3090 command from scratch.
3091
3092 Example:
3093
3094     cpan> install OpenGL
3095     OpenGL is up to date.
3096     cpan> force install OpenGL
3097     Running make
3098     OpenGL-0.4/
3099     OpenGL-0.4/COPYRIGHT
3100     [...]
3101
3102 =item readme, look module or distribution
3103
3104 These two commands take only one argument, be it a module or a
3105 distribution file. C<readme> displays the README of the associated
3106 distribution file. C<Look> gets and untars (if not yet done) the
3107 distribution file, changes to the appropriate directory and opens a
3108 subshell process in that directory.
3109
3110 =back
3111
3112 =head2 CPAN::Shell
3113
3114 The commands that are available in the shell interface are methods in
3115 the package CPAN::Shell. If you enter the shell command, all your
3116 input is split by the Text::ParseWords::shellwords() routine which
3117 acts like most shells do. The first word is being interpreted as the
3118 method to be called and the rest of the words are treated as arguments
3119 to this method.
3120
3121 =head2 autobundle
3122
3123 C<autobundle> writes a bundle file into the
3124 C<$CPAN::Config-E<gt>{cpan_home}/Bundle> directory. The file contains
3125 a list of all modules that are both available from CPAN and currently
3126 installed within @INC. The name of the bundle file is based on the
3127 current date and a counter.
3128
3129 =head2 recompile
3130
3131 recompile() is a very special command in that it takes no argument and
3132 runs the make/test/install cycle with brute force over all installed
3133 dynamically loadable extensions (aka XS modules) with 'force' in
3134 effect. Primary purpose of this command is to finish a network
3135 installation. Imagine, you have a common source tree for two different
3136 architectures. You decide to do a completely independent fresh
3137 installation. You start on one architecture with the help of a Bundle
3138 file produced earlier. CPAN installs the whole Bundle for you, but
3139 when you try to repeat the job on the second architecture, CPAN
3140 responds with a C<"Foo up to date"> message for all modules. So you
3141 will be glad to run recompile in the second architecture and
3142 youE<39>re done.
3143
3144 Another popular use for C<recompile> is to act as a rescue in case your
3145 perl breaks binary compatibility. If one of the modules that CPAN uses
3146 is in turn depending on binary compatibility (so you cannot run CPAN
3147 commands), then you should try the CPAN::Nox module for recovery.
3148
3149 =head2 The 4 Classes: Authors, Bundles, Modules, Distributions
3150
3151 Although it may be considered internal, the class hierarchie does
3152 matter for both users and programmer. CPAN.pm deals with above
3153 mentioned four classes, and all those classes share a set of
3154 methods. It is a classical single polymorphism that is in effect.  A
3155 metaclass object registers all objects of all kinds and indexes them
3156 with a string. The strings referencing objects have a separated
3157 namespace (well, not completely separated):
3158
3159          Namespace                         Class
3160
3161    words containing a "/" (slash)      Distribution
3162     words starting with Bundle::          Bundle
3163           everything else            Module or Author
3164
3165 Modules know their associated Distribution objects. They always refer
3166 to the most recent official release. Developers may mark their
3167 releases as unstable development versions (by inserting an underbar
3168 into the visible version number), so not always is the default
3169 distribution for a given module the really hottest and newest. If a
3170 module Foo circulates on CPAN in both version 1.23 and 1.23_90,
3171 CPAN.pm offers a convenient way to install version 1.23 by saying
3172
3173     install Foo
3174
3175 This would install the complete distribution file (say
3176 BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
3177 you would like to install version 1.23_90, you need to know where the
3178 distribution file resides on CPAN relative to the authors/id/
3179 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
3180 so he would have say
3181
3182     install BAR/Foo-1.23_90.tar.gz
3183
3184 The first example will be driven by an object of the class
3185 CPAN::Module, the second by an object of class Distribution.
3186
3187 =head2 ProgrammerE<39>s interface
3188
3189 If you do not enter the shell, the available shell commands are both
3190 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
3191 functions in the calling package (C<install(...)>).
3192
3193 There's currently only one class that has a stable interface,
3194 CPAN::Shell. All commands that are available in the CPAN shell are
3195 methods of the class CPAN::Shell. The commands that produce listings
3196 of modules (C<r>, C<autobundle>, C<u>) return a list of the IDs of all
3197 modules within the list.
3198
3199 =over 2
3200
3201 =item expand($type,@things)
3202
3203 The IDs of all objects available within a program are strings that can
3204 be expanded to the corresponding real objects with the
3205 C<CPAN::Shell-E<gt>expand()> method. Expand returns a list of
3206 CPAN::Module objects according to the C<@things> arguments given. In
3207 scalar context it only returns the first element of the list.
3208
3209 =item Programming Examples
3210
3211 This enables the programmer to do operations like these:
3212
3213     # install everything that is outdated on my disk:
3214     perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
3215
3216     # install my favorite programs if necessary:
3217     for $mod (qw(Net::FTP MD5 Data::Dumper)){
3218         my $obj = CPAN::Shell->expand('Module',$mod);
3219         $obj->install;
3220     }
3221
3222 =back
3223
3224 =head2 Cache Manager
3225
3226 Currently the cache manager only keeps track of the build directory
3227 ($CPAN::Config->{build_dir}). It is a simple FIFO mechanism that
3228 deletes complete directories below C<build_dir> as soon as the size of
3229 all directories there gets bigger than $CPAN::Config->{build_cache}
3230 (in MB). The contents of this cache may be used for later
3231 re-installations that you intend to do manually, but will never be
3232 trusted by CPAN itself. This is due to the fact that the user might
3233 use these directories for building modules on different architectures.
3234
3235 There is another directory ($CPAN::Config->{keep_source_where}) where
3236 the original distribution files are kept. This directory is not
3237 covered by the cache manager and must be controlled by the user. If
3238 you choose to have the same directory as build_dir and as
3239 keep_source_where directory, then your sources will be deleted with
3240 the same fifo mechanism.
3241
3242 =head2 Bundles
3243
3244 A bundle is just a perl module in the namespace Bundle:: that does not
3245 define any functions or methods. It usually only contains documentation.
3246
3247 It starts like a perl module with a package declaration and a $VERSION
3248 variable. After that the pod section looks like any other pod with the
3249 only difference, that I<one special pod section> exists starting with
3250 (verbatim):
3251
3252         =head1 CONTENTS
3253
3254 In this pod section each line obeys the format
3255
3256         Module_Name [Version_String] [- optional text]
3257
3258 The only required part is the first field, the name of a module
3259 (eg. Foo::Bar, ie. I<not> the name of the distribution file). The rest
3260 of the line is optional. The comment part is delimited by a dash just
3261 as in the man page header.
3262
3263 The distribution of a bundle should follow the same convention as
3264 other distributions.
3265
3266 Bundles are treated specially in the CPAN package. If you say 'install
3267 Bundle::Tkkit' (assuming such a bundle exists), CPAN will install all
3268 the modules in the CONTENTS section of the pod.  You can install your
3269 own Bundles locally by placing a conformant Bundle file somewhere into
3270 your @INC path. The autobundle() command which is available in the
3271 shell interface does that for you by including all currently installed
3272 modules in a snapshot bundle file.
3273
3274 There is a meaningless Bundle::Demo available on CPAN. Try to install
3275 it, it usually does no harm, just demonstrates what the Bundle
3276 interface looks like.
3277
3278 =head2 Prerequisites
3279
3280 If you have a local mirror of CPAN and can access all files with
3281 "file:" URLs, then you only need a perl better than perl5.003 to run
3282 this module. Otherwise Net::FTP is strongly recommended. LWP may be
3283 required for non-UNIX systems or if your nearest CPAN site is
3284 associated with an URL that is not C<ftp:>.
3285
3286 If you have neither Net::FTP nor LWP, there is a fallback mechanism
3287 implemented for an external ftp command or for an external lynx
3288 command.
3289
3290 This module presumes that all packages on CPAN
3291
3292 =over 2
3293
3294 =item *
3295
3296 declare their $VERSION variable in an easy to parse manner. This
3297 prerequisite can hardly be relaxed because it consumes by far too much
3298 memory to load all packages into the running program just to determine
3299 the $VERSION variable . Currently all programs that are dealing with
3300 version use something like this
3301
3302     perl -MExtUtils::MakeMaker -le \
3303         'print MM->parse_version($ARGV[0])' filename
3304
3305 If you are author of a package and wonder if your $VERSION can be
3306 parsed, please try the above method.
3307
3308 =item *
3309
3310 come as compressed or gzipped tarfiles or as zip files and contain a
3311 Makefile.PL (well we try to handle a bit more, but without much
3312 enthusiasm).
3313
3314 =back
3315
3316 =head2 Debugging
3317
3318 The debugging of this module is pretty difficult, because we have
3319 interferences of the software producing the indices on CPAN, of the
3320 mirroring process on CPAN, of packaging, of configuration, of
3321 synchronicity, and of bugs within CPAN.pm.
3322
3323 In interactive mode you can try "o debug" which will list options for
3324 debugging the various parts of the package. The output may not be very
3325 useful for you as it's just a byproduct of my own testing, but if you
3326 have an idea which part of the package may have a bug, it's sometimes
3327 worth to give it a try and send me more specific output. You should
3328 know that "o debug" has built-in completion support.
3329
3330 =head2 Floppy, Zip, and all that Jazz
3331
3332 CPAN.pm works nicely without network too. If you maintain machines
3333 that are not networked at all, you should consider working with file:
3334 URLs. Of course, you have to collect your modules somewhere first. So
3335 you might use CPAN.pm to put together all you need on a networked
3336 machine. Then copy the $CPAN::Config->{keep_source_where} (but not
3337 $CPAN::Config->{build_dir}) directory on a floppy. This floppy is kind
3338 of a personal CPAN. CPAN.pm on the non-networked machines works nicely
3339 with this floppy.
3340
3341 =head1 CONFIGURATION
3342
3343 When the CPAN module is installed a site wide configuration file is
3344 created as CPAN/Config.pm. The default values defined there can be
3345 overridden in another configuration file: CPAN/MyConfig.pm. You can
3346 store this file in $HOME/.cpan/CPAN/MyConfig.pm if you want, because
3347 $HOME/.cpan is added to the search path of the CPAN module before the
3348 use() or require() statements.
3349
3350 Currently the following keys in the hash reference $CPAN::Config are
3351 defined:
3352
3353   build_cache        size of cache for directories to build modules
3354   build_dir          locally accessible directory to build modules
3355   index_expire       after how many days refetch index files
3356   cpan_home          local directory reserved for this package
3357   gzip               location of external program gzip
3358   inactivity_timeout breaks interactive Makefile.PLs after that
3359                      many seconds inactivity. Set to 0 to never break.
3360   inhibit_startup_message
3361                      if true, does not print the startup message
3362   keep_source        keep the source in a local directory?
3363   keep_source_where  where keep the source (if we do)
3364   make               location of external program make
3365   make_arg           arguments that should always be passed to 'make'
3366   make_install_arg   same as make_arg for 'make install'
3367   makepl_arg         arguments passed to 'perl Makefile.PL'
3368   pager              location of external program more (or any pager)
3369   tar                location of external program tar
3370   unzip              location of external program unzip
3371   urllist            arrayref to nearby CPAN sites (or equivalent locations)
3372
3373 You can set and query each of these options interactively in the cpan
3374 shell with the command set defined within the C<o conf> command:
3375
3376 =over 2
3377
3378 =item o conf E<lt>scalar optionE<gt>
3379
3380 prints the current value of the I<scalar option>
3381
3382 =item o conf E<lt>scalar optionE<gt> E<lt>valueE<gt>
3383
3384 Sets the value of the I<scalar option> to I<value>
3385
3386 =item o conf E<lt>list optionE<gt>
3387
3388 prints the current value of the I<list option> in MakeMaker's
3389 neatvalue format.
3390
3391 =item o conf E<lt>list optionE<gt> [shift|pop]
3392
3393 shifts or pops the array in the I<list option> variable
3394
3395 =item o conf E<lt>list optionE<gt> [unshift|push|splice] E<lt>listE<gt>
3396
3397 works like the corresponding perl commands.
3398
3399 =back
3400
3401 =head1 SECURITY
3402
3403 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
3404 install foreign, unmasked, unsigned code on your machine. We compare
3405 to a checksum that comes from the net just as the distribution file
3406 itself. If somebody has managed to tamper with the distribution file,
3407 they may have as well tampered with the CHECKSUMS file. Future
3408 development will go towards strong authentification.
3409
3410 =head1 EXPORT
3411
3412 Most functions in package CPAN are exported per default. The reason
3413 for this is that the primary use is intended for the cpan shell or for
3414 oneliners.
3415
3416 =head1 BUGS
3417
3418 we should give coverage for _all_ of the CPAN and not just the
3419 __PAUSE__ part, right? In this discussion CPAN and PAUSE have become
3420 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
3421 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
3422
3423 Future development should be directed towards a better intergration of
3424 the other parts.
3425
3426 =head1 AUTHOR
3427
3428 Andreas König E<lt>a.koenig@mind.deE<gt>
3429
3430 =head1 SEE ALSO
3431
3432 perl(1), CPAN::Nox(3)
3433
3434 =cut
3435