lib/CPAN.pm

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