lib/CPAN.pm

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