Refresh CPAN to 1.19
Andreas Koenig [Sun, 2 Feb 1997 15:08:24 +0000 (03:08 +1200)]
lib/Bundle/CPAN.pm [new file with mode: 0644]
lib/CPAN.pm
lib/CPAN/FirstTime.pm

diff --git a/lib/Bundle/CPAN.pm b/lib/Bundle/CPAN.pm
new file mode 100644 (file)
index 0000000..2a05dee
--- /dev/null
@@ -0,0 +1,33 @@
+package Bundle::CPAN;
+
+$VERSION = '0.02';
+
+1;
+
+__END__
+
+=head1 NAME
+
+Bundle::CPAN - A bundle to play with all the other modules on CPAN
+
+=head1 SYNOPSIS
+
+C<perl -MCPAN -e 'install Bundle::CPAN'>
+
+=head1 CONTENTS
+
+CPAN
+
+CPAN::WAIT
+
+=head1 DESCRIPTION
+
+This bundle includes CPAN.pm as the base module and CPAN::WAIT, the
+first plugin for CPAN that was developed even before there was an API.
+
+After installing this bundle, it is recommended to quit the current
+session and start again in a new process.
+
+=head1 AUTHOR
+
+Andreas König
index f524983..2a5ef29 100644 (file)
@@ -1,11 +1,11 @@
 package CPAN;
 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
 
-$VERSION = '1.15';
+$VERSION = '1.19';
 
-# $Id: CPAN.pm,v 1.106 1997/01/24 12:26:36 k Exp $
+# $Id: CPAN.pm,v 1.121 1997/02/03 09:08:23 k Exp $
 
-# my $version = substr q$Revision: 1.106 $, 10; # only used during development
+# my $version = substr q$Revision: 1.121 $, 10; # only used during development
 
 use Carp ();
 use Config ();
@@ -20,6 +20,7 @@ use File::Path ();
 use FileHandle ();
 use Safe ();
 use Text::ParseWords ();
+use Text::Wrap;
 
 $Cwd = Cwd::cwd();
 
@@ -45,10 +46,10 @@ $CPAN::DEBUG ||= 0;
 $CPAN::Signal ||= 0;
 
 package CPAN;
-use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META);
+use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
 use strict qw(vars);
 
-@CPAN::ISA = qw(CPAN::Debug Exporter MY); # the MY class from
+@CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
                                           # MakeMaker, gives us
                                           # catfile and catdir
 
@@ -119,20 +120,24 @@ sub checklock {
        if (defined $other && $other) {
            chomp $other;
            return if $$==$other; # should never happen
-           print qq{There seems to be running another CPAN process ($other). Trying to contact...\n};
+           print qq{There seems to be running another CPAN process }.
+               qq{($other). Trying to contact...\n};
            if (kill 0, $other) {
                Carp::croak qq{Other job is running.\n}.
-                   qq{You may want to kill it and delete the lockfile, maybe. On UNIX try:\n}.
+                   qq{You may want to kill it and delete the lockfile, }.
+                       qq{maybe. On UNIX try:\n}.
                        qq{    kill $other\n}.
                            qq{    rm $lockfile\n};
            } elsif (-w $lockfile) {
                my($ans)=
                    ExtUtils::MakeMaker::prompt
-                       (qq{Other job not responding. Shall I overwrite the lockfile? (Y/N)},"y");
+                       (qq{Other job not responding. Shall I overwrite }.
+                        qq{the lockfile? (Y/N)},"y");
                print("Ok, bye\n"), exit unless $ans =~ /^y/i;
            } else {
                Carp::croak(
-                           qq{Lockfile $lockfile not writeable by you. Cannot proceed.\n}.
+                           qq{Lockfile $lockfile not writeable by you. }.
+                           qq{Cannot proceed.\n}.
                            qq{    On UNIX try:\n}.
                            qq{    rm $lockfile\n}.
                            qq{  and then rerun us.\n}
@@ -145,7 +150,7 @@ sub checklock {
     unless ($fh = FileHandle->new(">$lockfile")) {
        if ($! =~ /Permission/) {
            my $incc = $INC{'CPAN/Config.pm'};
-           my $myincc = MY->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
+           my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
            print qq{
 
 Your configuration suggests that CPAN.pm should use a working
@@ -177,7 +182,8 @@ or
        $Signal = 1;
     };
     $SIG{'__DIE__'} = \&cleanup;
-    print STDERR "Signal handler set.\n" unless $CPAN::Config->{'inhibit_startup_message'};
+    print STDERR "Signal handler set.\n"
+       unless $CPAN::Config->{'inhibit_startup_message'};
 }
 
 #-> sub CPAN::DESTROY ;
@@ -237,6 +243,22 @@ sub hasMD5 {
     return $self->{'hasMD5'};
 }
 
+#-> sub CPAN::hasWAIT ;
+sub hasWAIT {
+    my($self,$arg) = @_;
+    if (defined $arg) {
+       $self->{'hasWAIT'} = $arg;
+    } elsif (not defined $self->{'hasWAIT'}) {
+       eval {require CPAN::WAIT;};
+       if ($@) {
+           $self->{'hasWAIT'} = 0;
+       } else {
+           $self->{'hasWAIT'} = 1;
+       }
+    }
+    return $self->{'hasWAIT'};
+}
+
 #-> sub CPAN::instance ;
 sub instance {
     my($mgr,$class,$id) = @_;
@@ -273,7 +295,6 @@ sub shell {
 
     my $prompt = "cpan> ";
     local($^W) = 1;
-    my $term;
     unless ($Suppress_readline) {
        require Term::ReadLine;
        import Term::ReadLine;
@@ -288,7 +309,7 @@ sub shell {
     # How should we determine if we have more than stub ReadLine enabled?
     my $rl_avail = $Suppress_readline ? "suppressed" :
        defined &Term::ReadLine::Perl::readline ? "enabled" :
-           "available (get Term::ReadKey and Term::ReadLine)";
+           "available (get Term::ReadKey and Term::ReadLine::Perl)";
 
     print qq{
 cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
@@ -298,8 +319,19 @@ Readline support $rl_avail
     while () {
        if ($Suppress_readline) {
            print $prompt;
-           last unless defined (chomp($_ = <>));
+           last unless defined ($_ = <>);
+           chomp;
        } else {
+#           if ($CPAN::DEBUG) {
+#               my($report,$item);
+#               $report = "";
+#               for $item (qw/ReadLine IN OUT MinLine findConsole Features/) {
+#                   $report .= sprintf "%-15s", $item;
+#                   $report .= $term->$item() || "";
+#                   $report .= "\n";
+#               }
+#               CPAN->debug($report);
+#           }
            last unless defined ($_ = $term->readline($prompt));
        }
        s/^\s//;
@@ -318,7 +350,7 @@ Readline support $rl_avail
            last;
        } elsif (/./) {
            my(@line);
-           if ($] < 5.00322) { # parsewords had a bug at until recently
+           if ($] < 5.00322) { # parsewords had a bug until recently
                @line = split;
            } else {
                eval { @line = Text::ParseWords::shellwords($_) };
@@ -336,729 +368,1221 @@ Readline support $rl_avail
     }
 }
 
-package CPAN::Shell;
-use vars qw($AUTOLOAD $redef);
-@CPAN::Shell::ISA = qw(CPAN::Debug);
-
-# private function ro re-eval this module (handy during development)
-#-> sub CPAN::Shell::AUTOLOAD ;
-sub AUTOLOAD {
-    warn "CPAN::Shell doesn't know how to autoload $AUTOLOAD :-(
-Nothing Done.
-";
-       CPAN::Shell->h;
-}
+package CPAN::CacheMgr;
+use vars qw($Du);
+@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
+use File::Find;
 
-#-> sub CPAN::Shell::h ;
-sub h {
-    my($class,$about) = @_;
-    if (defined $about) {
-       print "Detailed help not yet implemented\n";
+#-> sub CPAN::CacheMgr::as_string ;
+sub as_string {
+    eval { require Data::Dumper };
+    if ($@) {
+       return shift->SUPER::as_string;
     } else {
-       print q{
-command   arguments       description
-a         string                  authors
-b         or              display bundles
-d         /regex/         info    distributions
-m         or              about   modules
-i         none                    anything of above
-
-r          as             reinstall recommendations
-u          above          uninstalled distributions
-See manpage for autobundle, recompile, force, look, etc.
-
-make                      make
-test      modules,        make test (implies make)
-install   dists, bundles, make install (implies test)
-clean     "r" or "u"      make clean
-readme                    display the README file
-
-reload    index|cpan    load most recent indices/CPAN.pm
-h or ?                  display this menu
-o         various       set and query options
-!         perl-code     eval a perl command
-q                       quit the shell subroutine
-};
+       return Data::Dumper::Dumper(shift);
     }
 }
 
-#-> sub CPAN::Shell::a ;
-sub a { print shift->format_result('Author',@_);}
-#-> sub CPAN::Shell::b ;
-sub b {
-    my($self,@which) = @_;
-    CPAN->debug("which[@which]") if $CPAN::DEBUG;
-    my($incdir,$bdir,$dh); 
-    foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
-       $bdir = $CPAN::META->catdir($incdir,"Bundle");
-       if ($dh = DirHandle->new($bdir)) { # may fail
-           my($entry);
-           for $entry ($dh->read) {
-               next if -d $CPAN::META->catdir($bdir,$entry);
-               next unless $entry =~ s/\.pm$//;
-               $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
-           }
-       }
-    }
-    print $self->format_result('Bundle',@which);
+#-> sub CPAN::CacheMgr::cachesize ;
+sub cachesize {
+    shift->{DU};
 }
-#-> sub CPAN::Shell::d ;
-sub d { print shift->format_result('Distribution',@_);}
-#-> sub CPAN::Shell::m ;
-sub m { print shift->format_result('Module',@_);}
 
-#-> sub CPAN::Shell::i ;
-sub i {
-    my($self) = shift;
-    my(@args) = @_;
-    my(@type,$type,@m);
-    @type = qw/Author Bundle Distribution Module/;
-    @args = '/./' unless @args;
-    my(@result);
-    for $type (@type) {
-       push @result, $self->expand($type,@args);
+# sub check {
+#     my($self,@dirs) = @_;
+#     return unless -d $self->{ID};
+#     my $dir;
+#     @dirs = $self->dirs unless @dirs;
+#     for $dir (@dirs) {
+#        $self->disk_usage($dir);
+#     }
+# }
+
+#-> sub CPAN::CacheMgr::clean_cache ;
+sub clean_cache {
+    my $self = shift;
+    my $dir;
+    while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
+       $self->force_clean_cache($dir);
     }
-    my $result =  @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
-    $result ||= "No objects found of any type for argument @args\n";
-    print $result;
+    $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
 }
 
-#-> sub CPAN::Shell::o ;
-sub o {
-    my($self,$o_type,@o_what) = @_;
-    $o_type ||= "";
-    CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
-    if ($o_type eq 'conf') {
-       shift @o_what if @o_what && $o_what[0] eq 'help';
-       if (!@o_what) {
-           my($k,$v);
-           print "CPAN::Config options:\n";
-           for $k (sort keys %CPAN::Config::can) {
-               $v = $CPAN::Config::can{$k};
-               printf "    %-18s %s\n", $k, $v;
-           }
-           print "\n";
-           for $k (sort keys %$CPAN::Config) {
-               $v = $CPAN::Config->{$k};
-               if (ref $v) {
-                   printf "    %-18s\n", $k;
-                   print map {"\t$_\n"} @{$v};
-               } else {
-                   printf "    %-18s %s\n", $k, $v;
-               }
-           }
-           print "\n";
-       } elsif (!CPAN::Config->edit(@o_what)) {
-           print qq[Type 'o conf' to view configuration edit options\n\n];
-       }
-    } elsif ($o_type eq 'debug') {
-       my(%valid);
-       @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
-       if (@o_what) {
-           while (@o_what) {
-               my($what) = shift @o_what;
-               if ( exists $CPAN::DEBUG{$what} ) {
-                   $CPAN::DEBUG |= $CPAN::DEBUG{$what};
-               } elsif ($what =~ /^\d/) {
-                   $CPAN::DEBUG = $what;
-               } elsif (lc $what eq 'all') {
-                   my($max) = 0;
-                   for (values %CPAN::DEBUG) {
-                       $max += $_;
-                   }
-                   $CPAN::DEBUG = $max;
-               } else {
-                   for (keys %CPAN::DEBUG) {
-                       next unless lc($_) eq lc($what);
-                       $CPAN::DEBUG |= $CPAN::DEBUG{$_};
-                   }
-                   print "unknown argument [$what]\n";
-               }
-           }
-       } else {
-           print "Valid options for debug are ".join(", ",sort(keys %CPAN::DEBUG), 'all').
-               " or a number. Completion works on the options. Case is ignored.\n\n";
-       }
-       if ($CPAN::DEBUG) {
-           print "Options set for debugging:\n";
-           my($k,$v);
-           for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
-               $v = $CPAN::DEBUG{$k};
-               printf "    %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
-           }
+#-> sub CPAN::CacheMgr::dir ;
+sub dir {
+    shift->{ID};
+}
+
+#-> sub CPAN::CacheMgr::entries ;
+sub entries {
+    my($self,$dir) = @_;
+    $dir ||= $self->{ID};
+    my($cwd) = Cwd::cwd();
+    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
+    my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
+    my(@entries);
+    for ($dh->read) {
+       next if $_ eq "." || $_ eq "..";
+       if (-f $_) {
+           push @entries, $CPAN::META->catfile($dir,$_);
+       } elsif (-d _) {
+           push @entries, $CPAN::META->catdir($dir,$_);
        } else {
-           print "Debugging turned off completely.\n";
+           print STDERR "Warning: weird direntry in $dir: $_\n";
        }
-    } else {
-       print qq{
-Known options:
-  conf    set or get configuration variables
-  debug   set or get debugging options
-};
     }
+    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
+    sort {-M $b <=> -M $a} @entries;
 }
 
-#-> sub CPAN::Shell::reload ;
-sub reload {
-    if ($_[1] =~ /cpan/i) {
-       CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
-       my $fh = FileHandle->new($INC{'CPAN.pm'});
-       local($/);
-       undef $/;
-       $redef = 0;
-       local($SIG{__WARN__})
-           = sub {
-               if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
-                   ++$redef;
-                   local($|) = 1;
-                   print ".";
-                   return;
-               }
-               warn @_;
-           };
-       eval <$fh>;
-       warn $@ if $@;
-       print "\n$redef subroutines redefined\n";
-    } elsif ($_[1] =~ /index/) {
-       CPAN::Index->force_reload;
+#-> sub CPAN::CacheMgr::disk_usage ;
+sub disk_usage {
+    my($self,$dir) = @_;
+    if (! defined $dir or $dir eq "") {
+       $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
+       return;
+    }
+    return if defined $self->{SIZE}{$dir};
+    local($Du) = 0;
+    find(
+        sub {
+            return if -l $_;
+            $Du += -s;
+        },
+        $dir
+       );
+    $self->{SIZE}{$dir} = $Du/1024/1024;
+    push @{$self->{FIFO}}, $dir;
+    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
+    $self->{DU} += $Du/1024/1024;
+    if ($self->{DU} > $self->{'MAX'} ) {
+       my($toremove) = $self->{FIFO}[0];
+       printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
+               $self->{DU}, $self->{'MAX'};
+       $self->clean_cache;
+    } else {
+       $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}")
+           if $CPAN::DEBUG;
+       $self->debug($self->as_string) if $CPAN::DEBUG;
     }
+    $self->{DU};
 }
 
-#-> sub CPAN::Shell::_binary_extensions ;
-sub _binary_extensions {
-    my($self) = shift @_;
-    my(@result,$module,%seen,%need,$headerdone);
-    for $module ($self->expand('Module','/./')) {
-       my $file  = $module->cpan_file;
-       next if $file eq "N/A";
-       next if $file =~ /^Contact Author/;
-       next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
-       next unless $module->xs_file;
-       local($|) = 1;
-       print ".";
-       push @result, $module;
-    }
-#    print join " | ", @result;
-    print "\n";
-    return @result;
+#-> sub CPAN::CacheMgr::force_clean_cache ;
+sub force_clean_cache {
+    my($self,$dir) = @_;
+    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
+       if $CPAN::DEBUG;
+    File::Path::rmtree($dir);
+    $self->{DU} -= $self->{SIZE}{$dir};
+    delete $self->{SIZE}{$dir};
 }
 
-#-> sub CPAN::Shell::recompile ;
-sub recompile {
-    my($self) = shift @_;
-    my($module,@module,$cpan_file,%dist);
-    @module = $self->_binary_extensions();
-    for $module (@module){  # we force now and compile later, so we don't do it twice
-       $cpan_file = $module->cpan_file;
-       my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
-       $pack->force;
-       $dist{$cpan_file}++;
-    }
-    for $cpan_file (sort keys %dist) {
-       print "  CPAN: Recompiling $cpan_file\n\n";
-       my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
-       $pack->install;
-       $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
-                           # stop a package from recompiling,
-                           # e.g. IO-1.12 when we have perl5.003_10
+#-> sub CPAN::CacheMgr::new ;
+sub new {
+    my $class = shift;
+    my $self = {
+               ID => $CPAN::Config->{'build_dir'},
+               MAX => $CPAN::Config->{'build_cache'},
+               DU => 0
+              };
+    File::Path::mkpath($self->{ID});
+    my $dh = DirHandle->new($self->{ID});
+    bless $self, $class;
+    $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
+    my $e;
+    for $e ($self->entries) {
+       next if $e eq ".." || $e eq ".";
+       $self->debug("Have to check size $e") if $CPAN::DEBUG;
+       $self->disk_usage($e);
     }
+    $self;
 }
 
-#-> sub CPAN::Shell::_u_r_common ;
-sub _u_r_common {
-    my($self) = shift @_;
-    my($what) = shift @_;
-    CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
-    Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
-    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
-    my(@args) = @_;
-    @args = '/./' unless @args;
-    my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
-    $version_zeroes = 0;
-    my $sprintf = "%-25s %9s %9s  %s\n";
-    for $module ($self->expand('Module',@args)) {
-       my $file  = $module->cpan_file;
-       next unless defined $file; # ??
-       my($latest) = $module->cpan_version || 0;
-       my($inst_file) = $module->inst_file;
-       my($have);
-       if ($inst_file){
-           if ($what eq "a") {
-               $have = $module->inst_version;
-           } elsif ($what eq "r") {
-               $have = $module->inst_version;
-               local($^W) = 0;
-               $version_zeroes++ unless $have;
-               next if $have >= $latest;
-           } elsif ($what eq "u") {
-               next;
+package CPAN::Debug;
+
+#-> sub CPAN::Debug::debug ;
+sub debug {
+    my($self,$arg) = @_;
+    my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
+                                               # Complete, caller(1)
+                                               # eg readline
+    ($caller) = caller(0);
+    $caller =~ s/.*:://;
+#    print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
+#    print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
+    if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
+       if (ref $arg) {
+           eval { require Data::Dumper };
+           if ($@) {
+               print $arg->as_string;
+           } else {
+               print Data::Dumper::Dumper($arg);
            }
        } else {
-           if ($what eq "a") {
-               next;
-           } elsif ($what eq "r") {
-               next;
-           } elsif ($what eq "u") {
-               $have = "-";
-           }
-       }
-       return if $CPAN::Signal; # this is sometimes lengthy
-       $seen{$file} ||= 0;
-       if ($what eq "a") {
-           push @result, sprintf "%s %s\n", $module->id, $have;
-       } elsif ($what eq "r") {
-           push @result, $module->id;
-           next if $seen{$file}++;
-       } elsif ($what eq "u") {
-           push @result, $module->id;
-           next if $seen{$file}++;
-           next if $file =~ /^Contact/;
+           print "Debug($caller:$func,$line,@rest): $arg\n"
        }
-       unless ($headerdone++){
-           print "\n";
-           printf $sprintf, "Package namespace", "installed", "latest", "in CPAN file";
+    }
+}
+
+package CPAN::Config;
+import ExtUtils::MakeMaker 'neatvalue';
+use vars qw(%can);
+
+%can = (
+  'commit' => "Commit changes to disk",
+  'defaults' => "Reload defaults from disk",
+  'init'   => "Interactive setting of all options",
+);
+
+#-> sub CPAN::Config::edit ;
+sub edit {
+    my($class,@args) = @_;
+    return unless @args;
+    CPAN->debug("class[$class]args[".join(" | ",@args)."]");
+    my($o,$str,$func,$args,$key_exists);
+    $o = shift @args;
+    if($can{$o}) {
+       $class->$o(@args);
+       return 1;
+    } else {
+       if (ref($CPAN::Config->{$o}) eq ARRAY) {
+           $func = shift @args;
+           $func ||= "";
+           # Let's avoid eval, it's easier to comprehend without.
+           if ($func eq "push") {
+               push @{$CPAN::Config->{$o}}, @args;
+           } elsif ($func eq "pop") {
+               pop @{$CPAN::Config->{$o}};
+           } elsif ($func eq "shift") {
+               shift @{$CPAN::Config->{$o}};
+           } elsif ($func eq "unshift") {
+               unshift @{$CPAN::Config->{$o}}, @args;
+           } elsif ($func eq "splice") {
+               splice @{$CPAN::Config->{$o}}, @args;
+           } elsif (@args) {
+               $CPAN::Config->{$o} = [@args];
+           } else {
+               print(
+                     "  $o  ",
+                     ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
+                     "\n"
+                    );
+           }
+       } else {
+           $CPAN::Config->{$o} = $args[0] if defined $args[0];
+           print "    $o    ";
+           print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
        }
-       $latest = substr($latest,0,8) if length($latest) > 8;
-       $have = substr($have,0,8) if length($have) > 8;
-       printf $sprintf, $module->id, $have, $latest, $file;
-       $need{$module->id}++;
     }
-    unless (%need) {
-       if ($what eq "u") {
-           print "No modules found for @args\n";
-       } elsif ($what eq "r") {
-           print "All modules are up to date for @args\n";
+}
+
+#-> sub CPAN::Config::commit ;
+sub commit {
+    my($self,$configpm) = @_;
+    unless (defined $configpm){
+       $configpm ||= $INC{"CPAN/MyConfig.pm"};
+       $configpm ||= $INC{"CPAN/Config.pm"};
+       $configpm || Carp::confess(qq{
+CPAN::Config::commit called without an argument.
+Please specify a filename where to save the configuration or try
+"o conf init" to have an interactive course through configing.
+});
+    }
+    my($mode);
+    if (-f $configpm) {
+       $mode = (stat $configpm)[2];
+       if ($mode && ! -w _) {
+           Carp::confess("$configpm is not writable");
        }
     }
-    if ($what eq "r" && $version_zeroes) {
-       my $s = $version_zeroes>1 ? "s have" : " has";
-       print qq{$version_zeroes installed module$s no version number to compare\n};
+
+    my $msg = <<EOF unless $configpm =~ /MyConfig/;
+
+# This is CPAN.pm's systemwide configuration file.  This file provides
+# defaults for users, and the values can be changed in a per-user configuration
+# file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
+
+EOF
+    $msg ||= "\n";
+    my($fh) = FileHandle->new;
+    open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
+    print $fh qq[$msg\$CPAN::Config = \{\n];
+    foreach (sort keys %$CPAN::Config) {
+       $fh->print(
+                  "  '$_' => ",
+                  ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}),
+                  ",\n"
+                 );
     }
-    @result;
+
+    print $fh "};\n1;\n__END__\n";
+    close $fh;
+
+    #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+    #chmod $mode, $configpm;
+    $self->defaults;
+    print "commit: wrote $configpm\n";
+    1;
 }
 
-#-> sub CPAN::Shell::r ;
-sub r {
-    shift->_u_r_common("r",@_);
+*default = \&defaults;
+#-> sub CPAN::Config::defaults ;
+sub defaults {
+    my($self) = @_;
+    $self->unload;
+    $self->load;
+    1;
 }
 
-#-> sub CPAN::Shell::u ;
-sub u {
-    shift->_u_r_common("u",@_);
+sub init {
+    my($self) = @_;
+    undef $CPAN::Config->{'inhibit_startup_message'}; # lazy trick to
+                                                      # have the least
+                                                      # important
+                                                      # variable
+                                                      # undefined
+    $self->load;
+    1;
 }
 
-#-> sub CPAN::Shell::autobundle ;
-sub autobundle {
-    my($self) = shift;
-    my(@bundle) = $self->_u_r_common("a",@_);
-    my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
-    File::Path::mkpath($todir);
-    unless (-d $todir) {
-       print "Couldn't mkdir $todir for some reason\n";
-       return;
+my $dot_cpan;
+#-> sub CPAN::Config::load ;
+sub load {
+    my($self) = @_;
+    eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
+    unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
+    eval {require CPAN::MyConfig;};     # where you can override system wide settings
+    unless ( $self->load_succeeded ) {
+         require CPAN::FirstTime;
+         my($configpm,$fh);
+         if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
+             $configpm = $INC{"CPAN/Config.pm"};
+         } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
+             $configpm = $INC{"CPAN/MyConfig.pm"};
+         } else {
+             my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
+             my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
+             my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
+             if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
+                 if (-w $configpmtest) {
+                     $configpm = $configpmtest;
+                 } elsif (-w $configpmdir) {
+#_#_# following code dumped core on me with 5.003_11, a.k.
+                     unlink "$configpmtest.bak" if -f "$configpmtest.bak";
+                     rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
+                     my $fh = FileHandle->new;
+                     if ($fh->open(">$configpmtest")) {
+                         $fh->print("1;\n");
+                         $configpm = $configpmtest;
+                     } else {
+                         # Should never happen
+                         Carp::confess("Cannot open >$configpmtest");
+                     }
+                 }
+             }
+             unless ($configpm) {
+                 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
+                 File::Path::mkpath($configpmdir);
+                 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
+                 if (-w $configpmtest) {
+                     $configpm = $configpmtest;
+                 } elsif (-w $configpmdir) {
+#_#_# following code dumped core on me with 5.003_11, a.k.
+                     my $fh = FileHandle->new;
+                     if ($fh->open(">$configpmtest")) {
+                         $fh->print("1;\n");
+                         $configpm = $configpmtest;
+                     } else {
+                         # Should never happen
+                         Carp::confess("Cannot open >$configpmtest");
+                     }
+                 } else {
+                     Carp::confess(qq{WARNING: CPAN.pm is unable to }.
+                                   qq{create a configuration file.});
+                 }
+             }
+         }
+         CPAN->debug(qq{Calling CPAN::FirstTime::init("$configpm")})
+             if $CPAN::DEBUG;
+         print qq{
+Configuring CPAN.pm.
+$configpm initialized.
+};
+         CPAN::FirstTime::init($configpm);
     }
-    my($y,$m,$d) =  (localtime)[5,4,3];
-    $y+=1900;
-    $m++;
-    my($c) = 0;
-    my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
-    my($to) = $CPAN::META->catfile($todir,"$me.pm");
-    while (-f $to) {
-       $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
-       $to = $CPAN::META->catfile($todir,"$me.pm");
-    }
-    my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
-    $fh->print(
-              "package Bundle::$me;\n\n",
-              "\$VERSION = '0.01';\n\n",
-              "1;\n\n",
-              "__END__\n\n",
-              "=head1 NAME\n\n",
-              "Bundle::$me - Snapshot of installation on ",
-              $Config::Config{'myhostname'},
-              " on ",
-              scalar(localtime),
-              "\n\n=head1 SYNOPSIS\n\n",
-              "perl -MCPAN -e 'install Bundle::$me'\n\n",
-              "=head1 CONTENTS\n\n",
-              join("\n", @bundle),
-              "\n\n=head1 CONFIGURATION\n\n",
-              Config->myconfig,
-              "\n\n=head1 AUTHOR\n\n",
-              "This Bundle has been generated automatically by the autobundle routine in CPAN.pm.\n",
-             );
-    $fh->close;
-    print "\nWrote bundle file
-    $to\n\n";
 }
 
-#-> sub CPAN::Shell::expand ;
-sub expand {
-    shift;
-    my($type,@args) = @_;
-    my($arg,@m);
-    for $arg (@args) {
-       my $regex;
-       if ($arg =~ m|^/(.*)/$|) {
-           $regex = $1;
-       }
-       my $class = "CPAN::$type";
-       my $obj;
-       if (defined $regex) {
-           for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
-               push @m, $obj
-                   if
-                       $obj->id =~ /$regex/i
-                           or
-                       (
-                        (
-                         $] < 5.00303 ### provide sort of compatibility with 5.003
-                         ||
-                         $obj->can('name')
-                        )
-                        &&
-                        $obj->name  =~ /$regex/i
-                       );
-           }
-       } else {
-           my($xarg) = $arg;
-           if ( $type eq 'Bundle' ) {
-               $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
-           }
-           if ($CPAN::META->exists($class,$xarg)) {
-               $obj = $CPAN::META->instance($class,$xarg);
-           } elsif ($CPAN::META->exists($class,$arg)) {
-               $obj = $CPAN::META->instance($class,$arg);
-           } else {
-               next;
-           }
-           push @m, $obj;
+#-> sub CPAN::Config::load_succeeded ;
+sub load_succeeded {
+    my($miss) = 0;
+    for (qw(
+           cpan_home keep_source_where build_dir build_cache index_expire
+           gzip tar unzip make pager makepl_arg make_arg make_install_arg
+           urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
+          )) {
+       unless (defined $CPAN::Config->{$_}){
+           $miss++;
+           CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG;
        }
     }
-    return @m;
+    return !$miss;
 }
 
-#-> sub CPAN::Shell::format_result ;
-sub format_result {
-    my($self) = shift;
-    my($type,@args) = @_;
-    @args = '/./' unless @args;
-    my(@result) = $self->expand($type,@args);
-    my $result =  @result==1 ? $result[0]->as_string : join "", map {$_->as_glimpse} @result;
-    $result ||= "No objects of type $type found for argument @args\n";
-    $result;
+#-> sub CPAN::Config::unload ;
+sub unload {
+    delete $INC{'CPAN/MyConfig.pm'};
+    delete $INC{'CPAN/Config.pm'};
 }
 
-#-> sub CPAN::Shell::rematein ;
-sub rematein {
-    shift;
-    my($meth,@some) = @_;
-    my $pragma = "";
-    if ($meth eq 'force') {
-       $pragma = $meth;
-       $meth = shift @some;
-    }
-    CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
-    my($s,@s);
-    foreach $s (@some) {
-       my $obj;
-       if (ref $s) {
-           $obj = $s;
-       } elsif ($s =~ m|/|) { # looks like a file
-           $obj = $CPAN::META->instance('CPAN::Distribution',$s);
-       } elsif ($s =~ m|^Bundle::|) {
-           $obj = $CPAN::META->instance('CPAN::Bundle',$s);
-       } else {
-           $obj = $CPAN::META->instance('CPAN::Module',$s) if $CPAN::META->exists('CPAN::Module',$s);
-       }
-       if (ref $obj) {
-           CPAN->debug(qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.$obj->as_string.qq{\]}) if $CPAN::DEBUG;
-           $obj->$pragma()
-               if
-                   $pragma
-                       &&
-                   ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
-           $obj->$meth();
-       } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
-           $obj = $CPAN::META->instance('CPAN::Author',$s);
-           print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
-       } else {
-           print "Warning: Cannot $meth $s, don't know what it is\n";
-       }
-    }
-}
+*h = \&help;
+#-> sub CPAN::Config::help ;
+sub help {
+    print <<EOF;
+Known options:
+  defaults  reload default config values from disk
+  commit    commit session changes to disk
+  init      go through a dialog to set all parameters
 
-#-> sub CPAN::Shell::force ;
-sub force   { shift->rematein('force',@_); }
-#-> sub CPAN::Shell::get ;
-sub get     { shift->rematein('get',@_); }
-#-> sub CPAN::Shell::readme ;
-sub readme  { shift->rematein('readme',@_); }
-#-> sub CPAN::Shell::make ;
-sub make    { shift->rematein('make',@_); }
-#-> sub CPAN::Shell::test ;
-sub test    { shift->rematein('test',@_); }
-#-> sub CPAN::Shell::install ;
-sub install { shift->rematein('install',@_); }
-#-> sub CPAN::Shell::clean ;
-sub clean   { shift->rematein('clean',@_); }
-#-> sub CPAN::Shell::look ;
-sub look   { shift->rematein('look',@_); }
+You may edit key values in the follow fashion:
 
-package CPAN::FTP;
-use vars qw($Ua);
-@CPAN::FTP::ISA = qw(CPAN::Debug);
+  o conf build_cache 15
 
-#-> sub CPAN::FTP::ftp_get ;
-sub ftp_get {
-    my($class,$host,$dir,$file,$target) = @_;
-    $class->debug(
-                      qq[Going to fetch file [$file] from dir [$dir]
-       on host [$host] as local [$target]\n]
-                     ) if $CPAN::DEBUG;
-    my $ftp = Net::FTP->new($host);
-    return 0 unless defined $ftp;
-    $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
-    $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
-    unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
-       warn "Couldn't login on $host";
-       return;
-    }
-    # print qq[Going to ->cwd("$dir")\n];
-    unless ( $ftp->cwd($dir) ){
-       warn "Couldn't cwd $dir";
-       return;
-    }
-    $ftp->binary;
-    $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
-    unless ( $ftp->get($file,$target) ){
-       warn "Couldn't fetch $file from $host";
-       return;
-    }
-    $ftp->quit; # it's ok if this fails
-    return 1;
-}
+  o conf build_dir "/foo/bar"
 
-#-> sub CPAN::FTP::localize ;
-sub localize {
-    my($self,$file,$aslocal,$force) = @_;
-    $force ||= 0;
-    Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])" unless defined $aslocal;
-    $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
+  o conf urllist shift
 
-    return $aslocal if -f $aslocal && -r _ && ! $force;
+  o conf urllist unshift ftp://ftp.foo.bar/
 
-    my($aslocal_dir) = File::Basename::dirname($aslocal);
-    File::Path::mkpath($aslocal_dir);
-    print STDERR qq{Warning: You are not allowed to write into directory "$aslocal_dir".
-    I\'ll continue, but if you face any problems, they may be due
-    to insufficient permissions.\n} unless -w $aslocal_dir;
+EOF
+    undef; #don't reprint CPAN::Config
+}
 
-    # Inheritance is not easier to manage than a few if/else branches
-    if ($CPAN::META->hasLWP) {
-       require LWP::UserAgent;
-       unless ($Ua) {
-           $Ua = new LWP::UserAgent;
-           my($var);
-           $Ua->proxy('ftp',  $var)
-               if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
-           $Ua->proxy('http', $var)
-               if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
-           $Ua->no_proxy($var)
-               if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+#-> sub CPAN::Config::complete ;
+sub complete {
+    my($word,$line,$pos) = @_;
+    $word ||= "";
+    my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
+    return grep /^\Q$word\E/, @o_conf;
+}
+
+package CPAN::Shell;
+use vars qw($AUTOLOAD $redef @ISA);
+@CPAN::Shell::ISA = qw(CPAN::Debug);
+if ($CPAN::META->hasWAIT) {
+    unshift @ISA, "CPAN::WAIT";
+}
+# private function ro re-eval this module (handy during development)
+#-> sub CPAN::Shell::AUTOLOAD ;
+sub AUTOLOAD {
+    my($autoload) = $AUTOLOAD;
+    $autoload =~ s/.*:://;
+    if ($autoload =~ /^w/) {
+       if ($CPAN::META->hasWAIT) {
+           CPAN::WAIT->wh;
+           return;
+       } else {
+           warn qq{
+Commands starting with "w" require CPAN::WAIT to be installed.
+Please consider installing CPAN::WAIT to use the fulltext index.
+Type "install CPAN::WAIT" and restart CPAN.pm.
+}
        }
+    } else {
+       warn "CPAN::Shell doesn't know how to autoload $autoload :-(
+Nothing Done.
+";
     }
+    CPAN::Shell->h;
+}
 
-    # Try the list of urls for each single object. We keep a record
-    # where we did get a file from
-    for (0..$#{$CPAN::Config->{urllist}}) {
-       my $url = $CPAN::Config->{urllist}[$_];
-       $url .= "/" unless substr($url,-1) eq "/";
-       $url .= $file;
-       $self->debug("localizing[$url]") if $CPAN::DEBUG;
-       if ($url =~ /^file:/) {
-           my $l;
-           if ($CPAN::META->hasLWP) {
-               require URI::URL;
-               my $u = new URI::URL $url;
-               $l = $u->path;
-           } else { # works only on Unix, is poorly constructed, but
-                     # hopefully better than nothing. 
-                    # RFC 1738 says fileurl BNF is
-                    # fileurl = "file://" [ host | "localhost" ] "/" fpath
-                    # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
-               ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
-               $l =~ s/^file://;       # assume they meant file://localhost
-           }
-           return $l if -f $l && -r _;
-       }
-
-       if ($CPAN::META->hasLWP) {
-           print "Fetching $url with LWP\n";
-           my $res = $Ua->mirror($url, $aslocal);
-           if ($res->is_success) {
-               return $aslocal;
-           }
-       }
-       if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
-           # that's the nice and easy way thanks to Graham
-           my($host,$dir,$getfile) = ($1,$2,$3);
-           if ($CPAN::META->hasFTP) {
-               $dir =~ s|/+|/|g;
-               $self->debug("Going to fetch file [$getfile]
-  from dir [$dir]
-  on host  [$host]
-  as local [$aslocal]") if $CPAN::DEBUG;
-               CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
-               warn "Net::FTP failed for some reason\n";
-           } else {
-               warn qq{
-  Please, install Net::FTP as soon as possible. Just type
-    install Net::FTP
-  Thank you.
+#-> sub CPAN::Shell::h ;
+sub h {
+    my($class,$about) = @_;
+    if (defined $about) {
+       print "Detailed help not yet implemented\n";
+    } else {
+       print q{
+command   arguments       description
+a         string                  authors
+b         or              display bundles
+d         /regex/         info    distributions
+m         or              about   modules
+i         none                    anything of above
 
-}
-           }
+r          as             reinstall recommendations
+u          above          uninstalled distributions
+See manpage for autobundle, recompile, force, look, etc.
 
-           # Came back if Net::FTP couldn't establish connection (or failed otherwise)
-           # Maybe they are behind a firewall, but they gave us
-           # a socksified (or other) ftp program...
-           my($netrcfile,$fh);
-           if (-x $CPAN::Config->{'ftp'}) {
-               my $timestamp = 0;
-               my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
-                  $ctime,$blksize,$blocks) = stat($aslocal);
-               $timestamp = $mtime if defined $mtime;
+make                      make
+test      modules,        make test (implies make)
+install   dists, bundles, make install (implies test)
+clean     "r" or "u"      make clean
+readme                    display the README file
 
-               my($netrc) = CPAN::FTP::netrc->new;
-               my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
+reload    index|cpan    load most recent indices/CPAN.pm
+h or ?                  display this menu
+o         various       set and query options
+!         perl-code     eval a perl command
+q                       quit the shell subroutine
+};
+    }
+}
 
-               my $targetfile = File::Basename::basename($aslocal);
-               my(@dialog);
-               push(
-                    @dialog,
-                    "lcd $aslocal_dir",
-                    "cd /",
-                    map("cd $_", split "/", $dir), # RFC 1738
-                    "bin",
-                    "get $getfile $targetfile",
-                    "quit"
-                   );
-               if (! $netrc->netrc) {
-                   warn "No ~/.netrc file found";
-               } elsif ($netrc->hasdefault || $netrc->contains($host)) {
-                   CPAN->debug(
-                               sprint(
-                                      "hasdef[%d]cont($host)[%d]",
-                                      $netrc->hasdefault,
-                                      $netrc->contains($host)
-                                     )
-                              ) if $CPAN::DEBUG;
-                   if ($netrc->protected) {
-                       print(
-                             qq{
-  Trying with external ftp to get
-    $url
-  As this requires some features that are not thoroughly tested, we\'re
-  not sure, that we get it right....
+#-> sub CPAN::Shell::a ;
+sub a { print shift->format_result('Author',@_);}
+#-> sub CPAN::Shell::b ;
+sub b {
+    my($self,@which) = @_;
+    CPAN->debug("which[@which]") if $CPAN::DEBUG;
+    my($incdir,$bdir,$dh); 
+    foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
+       $bdir = $CPAN::META->catdir($incdir,"Bundle");
+       if ($dh = DirHandle->new($bdir)) { # may fail
+           my($entry);
+           for $entry ($dh->read) {
+               next if -d $CPAN::META->catdir($bdir,$entry);
+               next unless $entry =~ s/\.pm$//;
+               $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
+           }
+       }
+    }
+    print $self->format_result('Bundle',@which);
+}
+#-> sub CPAN::Shell::d ;
+sub d { print shift->format_result('Distribution',@_);}
+#-> sub CPAN::Shell::m ;
+sub m { print shift->format_result('Module',@_);}
 
+#-> sub CPAN::Shell::i ;
+sub i {
+    my($self) = shift;
+    my(@args) = @_;
+    my(@type,$type,@m);
+    @type = qw/Author Bundle Distribution Module/;
+    @args = '/./' unless @args;
+    my(@result);
+    for $type (@type) {
+       push @result, $self->expand($type,@args);
+    }
+    my $result =  @result==1 ?
+       $result[0]->as_string :
+           join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects found of any type for argument @args\n";
+    print $result;
 }
-                            );
-                       my $fh = FileHandle->new;
-                       $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
-                           or die "Couldn't open ftp: $!";
-                       # pilot is blind now
-                       CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
-                       foreach (@dialog) { $fh->print("$_\n") }
-                       $fh->close;             # Wait for process to complete
-                       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-                        $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
-                       if ($mtime > $timestamp) {
-                           print "GOT $aslocal\n";
-                           return $aslocal;
-                       } else {
-                           print "Hmm... Still failed!\n";
-                       }
-                   } else {
-                       warn "Your $netrcfile is not correctly protected.\n";
-                   }
-               } else {
-                   warn "Your ~/.netrc neither contains $host
-  nor does it have a default entry\n";
-               }
 
-               # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
-               # login manually to host, using e-mail as password.
-               print qq{Issuing "ftp$verbose -n"\n};
-               unshift @dialog, "open $host", "user anonymous $Config::Config{'cf_email'}";
-               CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
-               $fh = FileHandle->new;
-               $fh->open("|$CPAN::Config->{'ftp'} -n") or
-                   die "Cannot fork: $!\n";
-               foreach (@dialog) { $fh->print("$_\n") }
-               $fh->close;
-               ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-                  $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
-               if ($mtime > $timestamp) {
-                   print "GOT $aslocal\n";
-                   return $aslocal;
+#-> sub CPAN::Shell::o ;
+sub o {
+    my($self,$o_type,@o_what) = @_;
+    $o_type ||= "";
+    CPAN->debug("o_type[$o_type] o_what[".join(" | ",@o_what)."]\n");
+    if ($o_type eq 'conf') {
+       shift @o_what if @o_what && $o_what[0] eq 'help';
+       if (!@o_what) {
+           my($k,$v);
+           print "CPAN::Config options:\n";
+           for $k (sort keys %CPAN::Config::can) {
+               $v = $CPAN::Config::can{$k};
+               printf "    %-18s %s\n", $k, $v;
+           }
+           print "\n";
+           for $k (sort keys %$CPAN::Config) {
+               $v = $CPAN::Config->{$k};
+               if (ref $v) {
+                   printf "    %-18s\n", $k;
+                   print map {"\t$_\n"} @{$v};
                } else {
-                   print "Bad luck... Still failed!\n";
+                   printf "    %-18s %s\n", $k, $v;
                }
            }
-           sleep 2;
+           print "\n";
+       } elsif (!CPAN::Config->edit(@o_what)) {
+           print qq[Type 'o conf' to view configuration edit options\n\n];
        }
-
-       # what, still not succeeded?
-       if (-x $CPAN::Config->{'lynx'}) {
-           my($want_compressed);
-           print(
-                 qq{
-  Trying with lynx to get $url
-}
-                );
-           $want_compressed = $aslocal =~ s/\.gz//;
-           my($system) = "$CPAN::Config->{'lynx'} -source '$url' > $aslocal";
-           if (system($system)==0) {
-               if ($want_compressed) {
-                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
-                   if (system($system)==0) {
-                       rename $aslocal, "$aslocal.gz";
-                   } else {
-                       $system = "$CPAN::Config->{'gzip'} $aslocal";
-                       system($system);
+    } elsif ($o_type eq 'debug') {
+       my(%valid);
+       @o_what = () if defined $o_what[0] && $o_what[0] =~ /help/i;
+       if (@o_what) {
+           while (@o_what) {
+               my($what) = shift @o_what;
+               if ( exists $CPAN::DEBUG{$what} ) {
+                   $CPAN::DEBUG |= $CPAN::DEBUG{$what};
+               } elsif ($what =~ /^\d/) {
+                   $CPAN::DEBUG = $what;
+               } elsif (lc $what eq 'all') {
+                   my($max) = 0;
+                   for (values %CPAN::DEBUG) {
+                       $max += $_;
                    }
-                   return "$aslocal.gz";
+                   $CPAN::DEBUG = $max;
                } else {
-                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
-                   if (system($system)==0) {
-                       $system = "$CPAN::Config->{'gzip'} -d $aslocal";
-                       system($system);
-                   } else {
-                       # should be fine, eh?
+                   for (keys %CPAN::DEBUG) {
+                       next unless lc($_) eq lc($what);
+                       $CPAN::DEBUG |= $CPAN::DEBUG{$_};
                    }
-                   return $aslocal;
+                   print "unknown argument [$what]\n";
                }
            }
+       } else {
+           print "Valid options for debug are ".
+               join(", ",sort(keys %CPAN::DEBUG), 'all').
+                   qq{ or a number. Completion works on the options. }.
+                       qq{Case is ignored.\n\n};
+       }
+       if ($CPAN::DEBUG) {
+           print "Options set for debugging:\n";
+           my($k,$v);
+           for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
+               $v = $CPAN::DEBUG{$k};
+               printf "    %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
+           }
+       } else {
+           print "Debugging turned off completely.\n";
        }
-       warn "Can't access URL $url.
-  Either get LWP or Net::FTP
-  or an external lynx or ftp";
+    } else {
+       print qq{
+Known options:
+  conf    set or get configuration variables
+  debug   set or get debugging options
+};
     }
-    Carp::croak("Cannot fetch $file from anywhere");
 }
 
-package CPAN::FTP::netrc;
-
-sub new {
-    my($class) = @_;
-    my $file = MY->catfile($ENV{HOME},".netrc");
-
-    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-       $atime,$mtime,$ctime,$blksize,$blocks)
-       = stat($file);
-    my $protected = 0;
-
+#-> sub CPAN::Shell::reload ;
+sub reload {
+    if ($_[1] =~ /cpan/i) {
+       CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
+       my $fh = FileHandle->new($INC{'CPAN.pm'});
+       local($/);
+       undef $/;
+       $redef = 0;
+       local($SIG{__WARN__})
+           = sub {
+               if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
+                   ++$redef;
+                   local($|) = 1;
+                   print ".";
+                   return;
+               }
+               warn @_;
+           };
+       eval <$fh>;
+       warn $@ if $@;
+       print "\n$redef subroutines redefined\n";
+    } elsif ($_[1] =~ /index/) {
+       CPAN::Index->force_reload;
+    }
+}
+
+#-> sub CPAN::Shell::_binary_extensions ;
+sub _binary_extensions {
+    my($self) = shift @_;
+    my(@result,$module,%seen,%need,$headerdone);
+    for $module ($self->expand('Module','/./')) {
+       my $file  = $module->cpan_file;
+       next if $file eq "N/A";
+       next if $file =~ /^Contact Author/;
+       next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
+       next unless $module->xs_file;
+       local($|) = 1;
+       print ".";
+       push @result, $module;
+    }
+#    print join " | ", @result;
+    print "\n";
+    return @result;
+}
+
+#-> sub CPAN::Shell::recompile ;
+sub recompile {
+    my($self) = shift @_;
+    my($module,@module,$cpan_file,%dist);
+    @module = $self->_binary_extensions();
+    for $module (@module){  # we force now and compile later, so we don't do it twice
+       $cpan_file = $module->cpan_file;
+       my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+       $pack->force;
+       $dist{$cpan_file}++;
+    }
+    for $cpan_file (sort keys %dist) {
+       print "  CPAN: Recompiling $cpan_file\n\n";
+       my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+       $pack->install;
+       $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
+                           # stop a package from recompiling,
+                           # e.g. IO-1.12 when we have perl5.003_10
+    }
+}
+
+#-> sub CPAN::Shell::_u_r_common ;
+sub _u_r_common {
+    my($self) = shift @_;
+    my($what) = shift @_;
+    CPAN->debug("self[$self] what[$what] args[@_]") if $CPAN::DEBUG;
+    Carp::croak "Usage: \$obj->_u_r_common($what)" unless defined $what;
+    Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
+    my(@args) = @_;
+    @args = '/./' unless @args;
+    my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
+    $version_zeroes = 0;
+    my $sprintf = "%-25s %9s %9s  %s\n";
+    for $module ($self->expand('Module',@args)) {
+       my $file  = $module->cpan_file;
+       next unless defined $file; # ??
+       my($latest) = $module->cpan_version || 0;
+       my($inst_file) = $module->inst_file;
+       my($have);
+       if ($inst_file){
+           if ($what eq "a") {
+               $have = $module->inst_version;
+           } elsif ($what eq "r") {
+               $have = $module->inst_version;
+               local($^W) = 0;
+               $version_zeroes++ unless $have;
+               next if $have >= $latest;
+           } elsif ($what eq "u") {
+               next;
+           }
+       } else {
+           if ($what eq "a") {
+               next;
+           } elsif ($what eq "r") {
+               next;
+           } elsif ($what eq "u") {
+               $have = "-";
+           }
+       }
+       return if $CPAN::Signal; # this is sometimes lengthy
+       $seen{$file} ||= 0;
+       if ($what eq "a") {
+           push @result, sprintf "%s %s\n", $module->id, $have;
+       } elsif ($what eq "r") {
+           push @result, $module->id;
+           next if $seen{$file}++;
+       } elsif ($what eq "u") {
+           push @result, $module->id;
+           next if $seen{$file}++;
+           next if $file =~ /^Contact/;
+       }
+       unless ($headerdone++){
+           print "\n";
+           printf(
+                  $sprintf,
+                  "Package namespace",
+                  "installed",
+                  "latest",
+                  "in CPAN file"
+                  );
+       }
+       $latest = substr($latest,0,8) if length($latest) > 8;
+       $have = substr($have,0,8) if length($have) > 8;
+       printf $sprintf, $module->id, $have, $latest, $file;
+       $need{$module->id}++;
+    }
+    unless (%need) {
+       if ($what eq "u") {
+           print "No modules found for @args\n";
+       } elsif ($what eq "r") {
+           print "All modules are up to date for @args\n";
+       }
+    }
+    if ($what eq "r" && $version_zeroes) {
+       my $s = $version_zeroes>1 ? "s have" : " has";
+       print qq{$version_zeroes installed module$s no version number to compare\n};
+    }
+    @result;
+}
+
+#-> sub CPAN::Shell::r ;
+sub r {
+    shift->_u_r_common("r",@_);
+}
+
+#-> sub CPAN::Shell::u ;
+sub u {
+    shift->_u_r_common("u",@_);
+}
+
+#-> sub CPAN::Shell::autobundle ;
+sub autobundle {
+    my($self) = shift;
+    my(@bundle) = $self->_u_r_common("a",@_);
+    my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+    File::Path::mkpath($todir);
+    unless (-d $todir) {
+       print "Couldn't mkdir $todir for some reason\n";
+       return;
+    }
+    my($y,$m,$d) =  (localtime)[5,4,3];
+    $y+=1900;
+    $m++;
+    my($c) = 0;
+    my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
+    my($to) = $CPAN::META->catfile($todir,"$me.pm");
+    while (-f $to) {
+       $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
+       $to = $CPAN::META->catfile($todir,"$me.pm");
+    }
+    my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
+    $fh->print(
+              "package Bundle::$me;\n\n",
+              "\$VERSION = '0.01';\n\n",
+              "1;\n\n",
+              "__END__\n\n",
+              "=head1 NAME\n\n",
+              "Bundle::$me - Snapshot of installation on ",
+              $Config::Config{'myhostname'},
+              " on ",
+              scalar(localtime),
+              "\n\n=head1 SYNOPSIS\n\n",
+              "perl -MCPAN -e 'install Bundle::$me'\n\n",
+              "=head1 CONTENTS\n\n",
+              join("\n", @bundle),
+              "\n\n=head1 CONFIGURATION\n\n",
+              Config->myconfig,
+              "\n\n=head1 AUTHOR\n\n",
+              "This Bundle has been generated automatically ",
+              "by the autobundle routine in CPAN.pm.\n",
+             );
+    $fh->close;
+    print "\nWrote bundle file
+    $to\n\n";
+}
+
+#-> sub CPAN::Shell::expand ;
+sub expand {
+    shift;
+    my($type,@args) = @_;
+    my($arg,@m);
+    for $arg (@args) {
+       my $regex;
+       if ($arg =~ m|^/(.*)/$|) {
+           $regex = $1;
+       }
+       my $class = "CPAN::$type";
+       my $obj;
+       if (defined $regex) {
+           for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
+               push @m, $obj
+                   if
+                       $obj->id =~ /$regex/i
+                           or
+                       (
+                        (
+                         $] < 5.00303 ### provide sort of compatibility with 5.003
+                         ||
+                         $obj->can('name')
+                        )
+                        &&
+                        $obj->name  =~ /$regex/i
+                       );
+           }
+       } else {
+           my($xarg) = $arg;
+           if ( $type eq 'Bundle' ) {
+               $xarg =~ s/^(Bundle::)?(.*)/Bundle::$2/;
+           }
+           if ($CPAN::META->exists($class,$xarg)) {
+               $obj = $CPAN::META->instance($class,$xarg);
+           } elsif ($CPAN::META->exists($class,$arg)) {
+               $obj = $CPAN::META->instance($class,$arg);
+           } else {
+               next;
+           }
+           push @m, $obj;
+       }
+    }
+    return @m;
+}
+
+#-> sub CPAN::Shell::format_result ;
+sub format_result {
+    my($self) = shift;
+    my($type,@args) = @_;
+    @args = '/./' unless @args;
+    my(@result) = $self->expand($type,@args);
+    my $result =  @result==1 ?
+       $result[0]->as_string :
+           join "", map {$_->as_glimpse} @result;
+    $result ||= "No objects of type $type found for argument @args\n";
+    $result;
+}
+
+#-> sub CPAN::Shell::rematein ;
+sub rematein {
+    shift;
+    my($meth,@some) = @_;
+    my $pragma = "";
+    if ($meth eq 'force') {
+       $pragma = $meth;
+       $meth = shift @some;
+    }
+    CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
+    my($s,@s);
+    foreach $s (@some) {
+       my $obj;
+       if (ref $s) {
+           $obj = $s;
+       } elsif ($s =~ m|/|) { # looks like a file
+           $obj = $CPAN::META->instance('CPAN::Distribution',$s);
+       } elsif ($s =~ m|^Bundle::|) {
+           $obj = $CPAN::META->instance('CPAN::Bundle',$s);
+       } else {
+           $obj = $CPAN::META->instance('CPAN::Module',$s)
+               if $CPAN::META->exists('CPAN::Module',$s);
+       }
+       if (ref $obj) {
+           CPAN->debug(
+                       qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+                       $obj->as_string.
+                       qq{\]}
+                      ) if $CPAN::DEBUG;
+           $obj->$pragma()
+               if
+                   $pragma
+                       &&
+                   ($] < 5.00303 || $obj->can($pragma)); ### compatibility with 5.003
+           $obj->$meth();
+       } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
+           $obj = $CPAN::META->instance('CPAN::Author',$s);
+           print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
+       } else {
+           print "Warning: Cannot $meth $s, don't know what it is\n";
+       }
+    }
+}
+
+#-> sub CPAN::Shell::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Shell::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Shell::readme ;
+sub readme  { shift->rematein('readme',@_); }
+#-> sub CPAN::Shell::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Shell::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Shell::install ;
+sub install { shift->rematein('install',@_); }
+#-> sub CPAN::Shell::clean ;
+sub clean   { shift->rematein('clean',@_); }
+#-> sub CPAN::Shell::look ;
+sub look   { shift->rematein('look',@_); }
+
+package CPAN::FTP;
+use vars qw($Ua);
+@CPAN::FTP::ISA = qw(CPAN::Debug);
+
+#-> sub CPAN::FTP::ftp_get ;
+sub ftp_get {
+    my($class,$host,$dir,$file,$target) = @_;
+    $class->debug(
+                      qq[Going to fetch file [$file] from dir [$dir]
+       on host [$host] as local [$target]\n]
+                     ) if $CPAN::DEBUG;
+    my $ftp = Net::FTP->new($host);
+    return 0 unless defined $ftp;
+    $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
+    $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
+    unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
+       warn "Couldn't login on $host";
+       return;
+    }
+    # print qq[Going to ->cwd("$dir")\n];
+    unless ( $ftp->cwd($dir) ){
+       warn "Couldn't cwd $dir";
+       return;
+    }
+    $ftp->binary;
+    $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
+    unless ( $ftp->get($file,$target) ){
+       warn "Couldn't fetch $file from $host\n";
+       return;
+    }
+    $ftp->quit; # it's ok if this fails
+    return 1;
+}
+
+#-> sub CPAN::FTP::localize ;
+sub localize {
+    my($self,$file,$aslocal,$force) = @_;
+    $force ||= 0;
+    Carp::croak "Usage: ->localize(cpan_file,as_local_file[,$force])"
+       unless defined $aslocal;
+    $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
+
+    return $aslocal if -f $aslocal && -r _ && ! $force;
+
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+    print STDERR qq{Warning: You are not allowed to write into }.
+       qq{directory "$aslocal_dir".
+    I\'ll continue, but if you face any problems, they may be due
+    to insufficient permissions.\n} unless -w $aslocal_dir;
+
+    # Inheritance is not easier to manage than a few if/else branches
+    if ($CPAN::META->hasLWP) {
+       require LWP::UserAgent;
+       unless ($Ua) {
+           $Ua = new LWP::UserAgent;
+           my($var);
+           $Ua->proxy('ftp',  $var)
+               if $var = $CPAN::Config->{'ftp_proxy'} || $ENV{'ftp_proxy'};
+           $Ua->proxy('http', $var)
+               if $var = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
+           $Ua->no_proxy($var)
+               if $var = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
+       }
+    }
+
+    # Try the list of urls for each single object. We keep a record
+    # where we did get a file from
+    my($i);
+    for $i (0..$#{$CPAN::Config->{urllist}}) {
+       my $url = $CPAN::Config->{urllist}[$i];
+       $url .= "/" unless substr($url,-1) eq "/";
+       $url .= $file;
+       $self->debug("localizing[$url]") if $CPAN::DEBUG;
+       if ($url =~ /^file:/) {
+           my $l;
+           if ($CPAN::META->hasLWP) {
+               require URI::URL;
+               my $u = new URI::URL $url;
+               $l = $u->path;
+           } else { # works only on Unix, is poorly constructed, but
+                     # hopefully better than nothing. 
+                    # RFC 1738 says fileurl BNF is
+                    # fileurl = "file://" [ host | "localhost" ] "/" fpath
+                    # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
+               ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
+               $l =~ s/^file://;       # assume they meant file://localhost
+           }
+           return $l if -f $l && -r _;
+           # Maybe mirror has compressed it?
+           if (-f "$l.gz") {
+               $self->debug("found compressed $l.gz");
+               system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
+               return $aslocal if -f $aslocal;
+           }
+       }
+
+       if ($CPAN::META->hasLWP) {
+           print "Fetching $url with LWP\n";
+           my $res = $Ua->mirror($url, $aslocal);
+           if ($res->is_success) {
+               return $aslocal;
+           }
+       }
+       if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+           # that's the nice and easy way thanks to Graham
+           my($host,$dir,$getfile) = ($1,$2,$3);
+           if ($CPAN::META->hasFTP) {
+               $dir =~ s|/+|/|g;
+               $self->debug("Going to fetch file [$getfile]
+  from dir [$dir]
+  on host  [$host]
+  as local [$aslocal]") if $CPAN::DEBUG;
+               CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
+               warn "Net::FTP failed for some reason\n";
+           } else {
+               warn qq{
+  Please, install Net::FTP as soon as possible. Just type
+    install Net::FTP
+  Thank you.
+
+}
+           }
+       }
+
+       # Came back if Net::FTP couldn't establish connection (or failed otherwise)
+       # Maybe they are behind a firewall, but they gave us
+       # a socksified (or other) ftp program...
+
+       my($funkyftp);
+       # does ncftp handle http?
+       for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
+           next unless defined $funkyftp;
+           next unless -x $funkyftp;
+           my($want_compressed);
+           print(
+                 qq{
+Trying with $funkyftp to get
+  $url
+});
+           $want_compressed = $aslocal =~ s/\.gz//;
+           my($source_switch) = "";
+           $source_switch = "-source" if $funkyftp =~ /\blynx$/;
+           my($system) = "$funkyftp $source_switch '$url' > $aslocal";
+           my($wstatus);
+           if (($wstatus = system($system)) == 0) {
+               if ($want_compressed) {
+                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+                   if (system($system)==0) {
+                       rename $aslocal, "$aslocal.gz";
+                   } else {
+                       $system = "$CPAN::Config->{'gzip'} $aslocal";
+                       system($system);
+                   }
+                   return "$aslocal.gz";
+               } else {
+                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+                   if (system($system)==0) {
+                       $system = "$CPAN::Config->{'gzip'} -d $aslocal";
+                       system($system);
+                   } else {
+                       # should be fine, eh?
+                   }
+                   return $aslocal;
+               }
+           } else {
+               my $estatus = $wstatus >> 8;
+               print qq{
+System call "$system"
+returned status $estatus (wstat $wstatus)
+};
+           }
+       }
+
+       if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+           my($host,$dir,$getfile) = ($1,$2,$3);
+           my($netrcfile,$fh);
+           if (-x $CPAN::Config->{'ftp'}) {
+               my $timestamp = 0;
+               my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+                  $ctime,$blksize,$blocks) = stat($aslocal);
+               $timestamp = $mtime ||=0;
+
+               my($netrc) = CPAN::FTP::netrc->new;
+               my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
+
+               my $targetfile = File::Basename::basename($aslocal);
+               my(@dialog);
+               push(
+                    @dialog,
+                    "lcd $aslocal_dir",
+                    "cd /",
+                    map("cd $_", split "/", $dir), # RFC 1738
+                    "bin",
+                    "get $getfile $targetfile",
+                    "quit"
+                   );
+               if (! $netrc->netrc) {
+                   CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
+               } elsif ($netrc->hasdefault || $netrc->contains($host)) {
+                   CPAN->debug(
+                               sprint(
+                                      "hasdef[%d]cont($host)[%d]",
+                                      $netrc->hasdefault,
+                                      $netrc->contains($host)
+                                     )
+                              ) if $CPAN::DEBUG;
+                   if ($netrc->protected) {
+                       print(
+                             qq{
+  Trying with external ftp to get
+    $url
+  As this requires some features that are not thoroughly tested, we\'re
+  not sure, that we get it right....
+
+}
+                            );
+                       my $fh = FileHandle->new;
+                       $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
+                           or die "Couldn't open ftp: $!";
+                       # pilot is blind now
+                       CPAN->debug("dialog [".(join "|",@dialog)."]")
+                           if $CPAN::DEBUG;
+                       foreach (@dialog) { $fh->print("$_\n") }
+                       $fh->close;             # Wait for process to complete
+                       my $wstatus = $?;
+                       my $estatus = $wstatus >> 8;
+                       print qq{
+Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
+  returned status $estatus (wstat $wstatus)
+} if $wstatus;
+                       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+                        $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+                       $mtime ||= 0;
+                       if ($mtime > $timestamp) {
+                           print "GOT $aslocal\n";
+                           return $aslocal;
+                       } else {
+                           print "Hmm... Still failed!\n";
+                       }
+                   } else {
+                       warn "Your $netrcfile is not correctly protected.\n";
+                   }
+               } else {
+                   warn "Your ~/.netrc neither contains $host
+  nor does it have a default entry\n";
+               }
+
+               # OK, they don't have a valid ~/.netrc. Use 'ftp -n' then and
+               # login manually to host, using e-mail as password.
+               print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
+               unshift(
+                       @dialog,
+                       "open $host",
+                       "user anonymous $Config::Config{'cf_email'}"
+                      );
+               CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
+               $fh = FileHandle->new;
+               $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
+                   die "Cannot fork: $!\n";
+               foreach (@dialog) { $fh->print("$_\n") }
+               $fh->close;
+               my $wstatus = $?;
+               my $estatus = $wstatus >> 8;
+               print qq{
+Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
+  returned status $estatus (wstat $wstatus)
+} if $wstatus;
+               ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+                  $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+               $mtime ||= 0;
+               if ($mtime > $timestamp) {
+                   print "GOT $aslocal\n";
+                   return $aslocal;
+               } else {
+                   print "Bad luck... Still failed!\n";
+               }
+           }
+           sleep 2;
+       }
+
+       print "Can't access URL $url.\n\n";
+       my(@mess,$mess);
+       push @mess, "LWP" unless CPAN->hasLWP;
+       push @mess, "Net::FTP" unless CPAN->hasFTP;
+       my($ext);
+       for $ext (qw/lynx ncftp ftp/) {
+           $CPAN::Config->{$ext} ||= "";
+           push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
+       }
+       $mess = qq{Either get }.
+           join(" or ",@mess).
+           qq{ or check, if the URL found in your configuration file, }.
+           $CPAN::Config->{urllist}[$i].
+           qq{, is valid.};
+       print Text::Wrap::wrap("","",$mess), "\n";
+    }
+    print "Cannot fetch $file\n";
+    return;
+}
+
+package CPAN::FTP::netrc;
+
+sub new {
+    my($class) = @_;
+    my $file = MM->catfile($ENV{HOME},".netrc");
+
+    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+       = stat($file);
+    $mode ||= 0;
+    my $protected = 0;
+
     my($fh,@machines,$hasdefault);
     $hasdefault = 0;
     $fh = FileHandle->new or die "Could not create a filehandle";
@@ -1217,11 +1741,20 @@ sub reload {
     return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
     $last_time = $time;
 
-    $cl->read_authindex($cl->reload_x("authors/01mailrc.txt.gz","01mailrc.gz",$force));
+    $cl->read_authindex($cl->reload_x(
+                                     "authors/01mailrc.txt.gz",
+                                     "01mailrc.gz",
+                                     $force));
     return if $CPAN::Signal; # this is sometimes lengthy
-    $cl->read_modpacks($cl->reload_x("modules/02packages.details.txt.gz","02packag.gz",$force));
+    $cl->read_modpacks($cl->reload_x(
+                                    "modules/02packages.details.txt.gz",
+                                    "02packag.gz",
+                                    $force));
     return if $CPAN::Signal; # this is sometimes lengthy
-    $cl->read_modlist($cl->reload_x("modules/03modlist.data.gz","03mlist.gz",$force));
+    $cl->read_modlist($cl->reload_x(
+                                   "modules/03modlist.data.gz",
+                                   "03mlist.gz",
+                                   $force));
 }
 
 #-> sub CPAN::Index::reload_x ;
@@ -1229,9 +1762,12 @@ sub reload_x {
     my($cl,$wanted,$localname,$force) = @_;
     $force ||= 0;
     my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
-    if (-f $abs_wanted && -M $abs_wanted < $CPAN::Config->{'index_expire'} && !$force) {
+    if (-f $abs_wanted &&
+       -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
+       !$force) {
        my($s) = $CPAN::Config->{'index_expire'} != 1;
-       $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} day$s. I\'ll use that.\n});
+       $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
+                  qq{day$s. I\'ll use that.\n});
        return $abs_wanted;
     } else {
        $force ||= 1;
@@ -1285,1223 +1821,954 @@ sub read_modpacks {
   available! I\'d suggest--provided you have time--you try
     install CPAN
     reload cpan
-  without quitting the current session. It should be a seemless upgrade
-  while we are running...
-};
-               sleep 2;
-               print qq{\n};
-           }
-       }
-
-       my($id);
-       if ($bundle){
-           $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
-           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
-# This "next" makes us faster but if the job is running long, we ignore
-# rereads which is bad. So we have to be a bit slower again.
-#      } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
-#          next;
-       } else {
-           # instantiate a module object
-           $id = $CPAN::META->instance('CPAN::Module',$mod);
-           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
-       }
-
-       # determine the author
-       my($userid) = $dist =~ /([^\/]+)/;
-       $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
-
-       # instantiate a distribution object
-       unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
-           $CPAN::META->instance(
-                                 'CPAN::Distribution' => $dist
-                                )->set(
-                                       'CPAN_USERID' => $userid
-                                      )
-                                    if $userid =~ /\w/;
-       }
-
-       return if $CPAN::Signal;
-    }
-    $fh->close;
-    $? and Carp::croak "FAILED $pipe: exit status [$?]";
-}
-
-#-> sub CPAN::Index::read_modlist ;
-sub read_modlist {
-    my($cl,$index_target) = @_;
-    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    warn "Going to read $index_target\n";
-    my $fh = FileHandle->new("$pipe|");
-    my $eval = "";
-    while (<$fh>) {
-       next if 1../^\s*$/;
-       next if /use vars/; # will go away in 03...
-       $eval .= $_;
-       return if $CPAN::Signal;
-    }
-    $eval .= q{CPAN::Modulelist->data;};
-    local($^W) = 0;
-    my($comp) = Safe->new("CPAN::Safe1");
-    my $ret = $comp->reval($eval);
-    Carp::confess($@) if $@;
-    return if $CPAN::Signal;
-    for (keys %$ret) {
-       my $obj = $CPAN::META->instance(CPAN::Module,$_);
-       $obj->set(%{$ret->{$_}});
-       return if $CPAN::Signal;
-    }
-}
-
-package CPAN::InfoObj;
-@CPAN::InfoObj::ISA = qw(CPAN::Debug);
-
-#-> sub CPAN::InfoObj::new ;
-sub new { my $this = bless {}, shift; %$this = @_; $this }
-
-#-> sub CPAN::InfoObj::set ;
-sub set {
-    my($self,%att) = @_;
-    my(%oldatt) = %$self;
-    %$self = (%oldatt, %att);
-}
-
-#-> sub CPAN::InfoObj::id ;
-sub id { shift->{'ID'} }
-
-#-> sub CPAN::InfoObj::as_glimpse ;
-sub as_glimpse {
-    my($self) = @_;
-    my(@m);
-    my $class = ref($self);
-    $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %s\n", $class, $self->{ID};
-    join "", @m;
-}
-
-#-> sub CPAN::InfoObj::as_string ;
-sub as_string {
-    my($self) = @_;
-    my(@m);
-    my $class = ref($self);
-    $class =~ s/^CPAN:://;
-    push @m, $class, " id = $self->{ID}\n";
-    for (sort keys %$self) {
-       next if $_ eq 'ID';
-       my $extra = "";
-       $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
-       if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
-           push @m, sprintf "    %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
-       } else {
-           push @m, sprintf "    %-12s %s%s\n", $_, $self->{$_}, $extra;
-       }
-    }
-    join "", @m, "\n";
-}
-
-#-> sub CPAN::InfoObj::author ;
-sub author {
-    my($self) = @_;
-    $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
-}
-
-package CPAN::Author;
-@CPAN::Author::ISA = qw(CPAN::Debug CPAN::InfoObj);
-
-#-> sub CPAN::Author::as_glimpse ;
-sub as_glimpse {
-    my($self) = @_;
-    my(@m);
-    my $class = ref($self);
-    $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
-    join "", @m;
-}
-
-# Dead code, I would have liked to have,,, but it was never reached,,,
-#sub make {
-#    my($self) = @_;
-#    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
-#}
-
-#-> sub CPAN::Author::fullname ;
-sub fullname { shift->{'FULLNAME'} }
-*name = \&fullname;
-#-> sub CPAN::Author::email ;
-sub email    { shift->{'EMAIL'} }
-
-package CPAN::Distribution;
-@CPAN::Distribution::ISA = qw(CPAN::Debug CPAN::InfoObj);
-
-#-> sub CPAN::Distribution::called_for ;
-sub called_for {
-    my($self,$id) = @_;
-    $self->{'CALLED_FOR'} = $id if defined $id;
-    return $self->{'CALLED_FOR'};
-}
-
-#-> sub CPAN::Distribution::get ;
-sub get {
-    my($self) = @_;
-  EXCUSE: {
-       my @e;
-       exists $self->{'build_dir'} and push @e, "Unwrapped into directory $self->{'build_dir'}";
-       print join "", map {"  $_\n"} @e and return if @e;
-    }
-    my($local_file);
-    my($local_wanted) =
-        CPAN->catfile(
-                       $CPAN::Config->{keep_source_where},
-                       "authors",
-                       "id",
-                       split("/",$self->{ID})
-                      );
-
-    $self->debug("Doing localize") if $CPAN::DEBUG;
-    $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
-    $self->{localfile} = $local_file;
-    my $builddir = $CPAN::META->{cachemgr}->dir;
-    $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
-    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
-    my $packagedir;
-
-    $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
-    if ($CPAN::META->hasMD5) {
-       $self->verifyMD5;
-    }
-    if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
-       $self->debug("Removing tmp") if $CPAN::DEBUG;
-       File::Path::rmtree("tmp");
-       mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
-       chdir "tmp";
-       $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
-       if ($local_file =~ /z$/i){
-           $self->{archived} = "tar";
-           if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
-               $self->{unwrapped} = "YES";
-           } else {
-               $self->{unwrapped} = "NO";
-           }
-       } elsif ($local_file =~ /zip$/i) {
-           $self->{archived} = "zip";
-           if (system("$CPAN::Config->{unzip} $local_file")==0) {
-               $self->{unwrapped} = "YES";
-           } else {
-               $self->{unwrapped} = "NO";
+  without quitting the current session. It should be a seemless upgrade
+  while we are running...
+};
+               sleep 2;
+               print qq{\n};
            }
+           last if $CPAN::Signal;
        }
-       # Let's check if the package has its own directory.
-       opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
-       my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
-       closedir DIR;
-       my ($distdir,$packagedir);
-       if (@readdir == 1 && -d $readdir[0]) {
-           $distdir = $readdir[0];
-           $packagedir = $CPAN::META->catdir($builddir,$distdir);
-           -d $packagedir and print "Removing previously used $packagedir\n";
-           File::Path::rmtree($packagedir);
-           rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
+
+       my($id);
+       if ($bundle){
+           $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
+           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
+# This "next" makes us faster but if the job is running long, we ignore
+# rereads which is bad. So we have to be a bit slower again.
+#      } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
+#          next;
        } else {
-           my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
-           $pragmatic_dir =~ s/\W_//g;
-           $pragmatic_dir++ while -d "../$pragmatic_dir";
-           $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
-           File::Path::mkpath($packagedir);
-           my($f);
-           for $f (@readdir) { # is already without "." and ".."
-               my $to = $CPAN::META->catdir($packagedir,$f);
-               rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
-           }
+           # instantiate a module object
+           $id = $CPAN::META->instance('CPAN::Module',$mod);
+           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
        }
-       $self->{'build_dir'} = $packagedir;
 
-       chdir "..";
-       $self->debug("Changed directory to .. (self is $self [".$self->as_string."])") if $CPAN::DEBUG;
-       File::Path::rmtree("tmp");
-       if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
-           print "Going to unlink $local_file\n";
-           unlink $local_file or Carp::carp "Couldn't unlink $local_file";
-       }
-       my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
-       unless (-f $makefilepl) {
-           my($configure) = $CPAN::META->catfile($packagedir,"Configure");
-           if (-f $configure) {
-               # do we have anything to do?
-               $self->{'configure'} = $configure;
-           } else {
-               my $fh = FileHandle->new(">$makefilepl") or Carp::croak("Could not open >$makefilepl");
-               my $cf = $self->called_for || "unknown";
-               $fh->print(qq{
-# This Makefile.PL has been autogenerated by the module CPAN.pm
-# Autogenerated on: }.scalar localtime().qq{
-                   use ExtUtils::MakeMaker;
-                   WriteMakefile(NAME => q[$cf]);
-});
-               print qq{Package comes without Makefile.PL.\n}.
-                   qq{  Writing one on our own (calling it $cf)\n};
-           }
+       # determine the author
+       my($userid) = $dist =~ /([^\/]+)/;
+       $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
+
+       # instantiate a distribution object
+       unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
+           $CPAN::META->instance(
+                                 'CPAN::Distribution' => $dist
+                                )->set(
+                                       'CPAN_USERID' => $userid
+                                      )
+                                    if $userid =~ /\w/;
        }
-    } else {
-       $self->{archived} = "NO";
+
+       return if $CPAN::Signal;
     }
-    return $self;
+    $fh->close;
+    $? and Carp::croak "FAILED $pipe: exit status [$?]";
 }
 
-#-> sub CPAN::Distribution::new ;
-sub new {
-    my($class,%att) = @_;
+#-> sub CPAN::Index::read_modlist ;
+sub read_modlist {
+    my($cl,$index_target) = @_;
+    my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
+    warn "Going to read $index_target\n";
+    my $fh = FileHandle->new("$pipe|");
+    my $eval = "";
+    while (<$fh>) {
+       next if 1../^\s*$/;
+       next if /use vars/; # will go away in 03...
+       $eval .= $_;
+       return if $CPAN::Signal;
+    }
+    $eval .= q{CPAN::Modulelist->data;};
+    local($^W) = 0;
+    my($comp) = Safe->new("CPAN::Safe1");
+    my $ret = $comp->reval($eval);
+    Carp::confess($@) if $@;
+    return if $CPAN::Signal;
+    for (keys %$ret) {
+       my $obj = $CPAN::META->instance(CPAN::Module,$_);
+       $obj->set(%{$ret->{$_}});
+       return if $CPAN::Signal;
+    }
+}
 
-    $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
+package CPAN::InfoObj;
+@CPAN::InfoObj::ISA = qw(CPAN::Debug);
 
-    my $this = { %att };
-    return bless $this, $class;
-}
+#-> sub CPAN::InfoObj::new ;
+sub new { my $this = bless {}, shift; %$this = @_; $this }
 
-#-> sub CPAN::Distribution::look ;
-sub look {
-    my($self) = @_;
-    if (  $CPAN::Config->{'shell'} ) {
-       print qq{
-Trying to open a subshell in the build directory...
-};
-    } else {
-       print qq{
-Your configuration does not define a value for subshells.
-Please define it with "o conf shell <your shell>"
-};
-       return;
-    }
-    my $dist = $self->id;
-    my $dir  = $self->dir or $self->get;
-    $dir = $self->dir;
-    my $pwd  = Cwd::cwd();
-    chdir($dir);
-    print qq{Working directory is $dir.\n};
-    system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error";
-    chdir($pwd);
+#-> sub CPAN::InfoObj::set ;
+sub set {
+    my($self,%att) = @_;
+    my(%oldatt) = %$self;
+    %$self = (%oldatt, %att);
 }
 
-#-> sub CPAN::Distribution::readme ;
-sub readme {
-    my($self) = @_;
-    my($dist) = $self->id;
-    my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
-    $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
-    my($local_file);
-    my($local_wanted) =
-        CPAN->catfile(
-                       $CPAN::Config->{keep_source_where},
-                       "authors",
-                       "id",
-                       split("/","$sans.readme"),
-                      );
-    $self->debug("Doing localize") if $CPAN::DEBUG;
-    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
-    my $fh_pager = FileHandle->new;
-    $fh_pager->open("|$CPAN::Config->{'pager'}") or die "Could not open pager $CPAN::Config->{'pager'}: $!";
-    my $fh_readme = FileHandle->new;
-    $fh_readme->open($local_file) or die "Could not open $local_file: $!";
-    $fh_pager->print(<$fh_readme>);
-}
+#-> sub CPAN::InfoObj::id ;
+sub id { shift->{'ID'} }
 
-#-> sub CPAN::Distribution::verifyMD5 ;
-sub verifyMD5 {
+#-> sub CPAN::InfoObj::as_glimpse ;
+sub as_glimpse {
     my($self) = @_;
-  EXCUSE: {
-       my @e;
-       $self->{MD5_STATUS} and push @e, "MD5 Checksum was ok";
-       print join "", map {"  $_\n"} @e and return if @e;
-    }
-    my($local_file);
-    my(@local) = split("/",$self->{ID});
-    my($basename) = pop @local;
-    push @local, "CHECKSUMS";
-    my($local_wanted) =
-       CPAN->catfile(
-                     $CPAN::Config->{keep_source_where},
-                     "authors",
-                     "id",
-                     @local
-                    );
-    local($") = "/";
-    if (
-       -f $local_wanted
-       &&
-       $self->MD5_check_file($local_wanted,$basename)
-       ) {
-       return $self->{MD5_STATUS}="OK";
-    }
-    $local_file = CPAN::FTP->localize("authors/id/@local", $local_wanted, 'force>:-{');
-    my($checksum_pipe);
-    if ($local_file) {
-       # fine
-    } else {
-       $local[-1] .= ".gz";
-       $local_file = CPAN::FTP->localize(
-                                         "authors/id/@local",
-                                         "$local_wanted.gz",
-                                         'force>:-{'
-                                        );
-       my $system = "$CPAN::Config->{gzip} --decompress $local_file";
-       system($system)==0 or die "Could not uncompress $local_file";
-       $local_file =~ s/\.gz$//;
-    }
-    $self->MD5_check_file($local_file,$basename);
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s\n", $class, $self->{ID};
+    join "", @m;
 }
 
-#-> sub CPAN::Distribution::MD5_check_file ;
-sub MD5_check_file {
-    my($self,$lfile,$basename) = @_;
-    my($cksum);
-    my $fh = new FileHandle;
-    local($/)=undef;
-    if (open $fh, $lfile){
-       my $eval = <$fh>;
-       close $fh;
-       my($comp) = Safe->new();
-       $cksum = $comp->reval($eval);
-       Carp::confess($@) if $@;
-       if ($cksum->{$basename}->{md5}) {
-           $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n") if $CPAN::DEBUG;
-           my $file = $self->{localfile};
-           my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
-           if (
-               open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
-               or
-               open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
-              ){
-               print "Checksum for $file ok\n";
-               return $self->{MD5_STATUS}="OK";
-           } else {
-               die join(
-                        "",
-                        "\nChecksum mismatch for distribution file. Please investigate.\n\n",
-                        $self->as_string,
-                        $CPAN::META->instance('CPAN::Author',$self->{CPAN_USERID})->as_string,
-                        "Please contact the author or your CPAN site admin"
-                       );
-           }
-           close $fh if fileno($fh);
+#-> sub CPAN::InfoObj::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, $class, " id = $self->{ID}\n";
+    for (sort keys %$self) {
+       next if $_ eq 'ID';
+       my $extra = "";
+       $_ eq "CPAN_USERID" and $extra = " (".$self->author.")";
+       if (ref($self->{$_}) eq "ARRAY") { # Should we setup a language interface? XXX
+           push @m, sprintf "    %-12s %s%s\n", $_, "@{$self->{$_}}", $extra;
        } else {
-           print "No md5 checksum for $basename in local $lfile\n";
-           return;
-       }
-    } else {
-       Carp::carp "Could not open $lfile for reading";
+           push @m, sprintf "    %-12s %s%s\n", $_, $self->{$_}, $extra;
+       }
     }
+    join "", @m, "\n";
 }
 
-#-> sub CPAN::Distribution::eq_MD5 ;
-sub eq_MD5 {
-    my($self,$fh,$expectMD5) = @_;
-    my $md5 = new MD5;
-    $md5->addfile($fh);
-    my $hexdigest = $md5->hexdigest;
-    $hexdigest eq $expectMD5;
+#-> sub CPAN::InfoObj::author ;
+sub author {
+    my($self) = @_;
+    $CPAN::META->instance(CPAN::Author,$self->{CPAN_USERID})->fullname;
 }
 
-#-> sub CPAN::Distribution::force ;
-sub force {
+package CPAN::Author;
+@CPAN::Author::ISA = qw(CPAN::InfoObj);
+
+#-> sub CPAN::Author::as_glimpse ;
+sub as_glimpse {
     my($self) = @_;
-    $self->{'force_update'}++;
-    delete $self->{'MD5_STATUS'};
-    delete $self->{'archived'};
-    delete $self->{'build_dir'};
-    delete $self->{'localfile'};
-    delete $self->{'make'};
-    delete $self->{'install'};
-    delete $self->{'unwrapped'};
-    delete $self->{'writemakefile'};
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %s (%s)\n", $class, $self->{ID}, $self->fullname;
+    join "", @m;
 }
 
-#-> sub CPAN::Distribution::make ;
-sub make {
-    my($self) = @_;
-    $self->debug($self->id) if $CPAN::DEBUG;
-    print "Running make\n";
-    $self->get;
-    EXCUSE: {
-         my @e;
-         $self->{archived} eq "NO" and push @e, "Is neither a tar nor a zip archive.";
-         $self->{unwrapped} eq "NO"   and push @e, "had problems unarchiving. Please build manually";
-         exists $self->{writemakefile} && $self->{writemakefile} eq "NO" and push @e, "Had some problem writing Makefile";
-         defined $self->{'make'} and push @e, "Has already been processed within this session";
-         print join "", map {"  $_\n"} @e and return if @e;
-     }
-    print "\n  CPAN.pm: Going to build ".$self->id."\n\n";
-    my $builddir = $self->dir;
-    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
-    $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+# Dead code, I would have liked to have,,, but it was never reached,,,
+#sub make {
+#    my($self) = @_;
+#    return "Don't be silly, you can't make $self->{FULLNAME} ;-)\n";
+#}
 
-    my $system;
-    if ($self->{'configure'}) {
-       $system = $self->{'configure'};
-    } else {
-       my($perl) = $^X =~ /^\.\// ? "$CPAN::Cwd/$^X" : $^X; # XXX subclassing folks, forgive me!
-       $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
-    }
-    $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
-    my($ret,$pid);
-    $@ = "";
-    if ($CPAN::Config->{inactivity_timeout}) {
-       eval {
-           alarm $CPAN::Config->{inactivity_timeout};
-           #$SIG{CHLD} = \&REAPER;
-           if (defined($pid=fork)) {
-               if ($pid) { #parent
-                   wait;
-               } else {    #child
-                   exec $system;
-               }
-           } else {
-               print "Cannot fork: $!";
-               return;
-           }
-           $ret = system($system);
-       };
-       alarm 0;
-    } else {
-       $ret = system($system);
-    }
-    if ($@){
-       kill 9, $pid;
-       waitpid $pid, 0;
-       print $@;
-       $self->{writemakefile} = "NO - $@";
-       $@ = "";
-       return;
-    } elsif ($ret != 0) {
-        $self->{writemakefile} = "NO";
-        return;
-    }
-    $self->{writemakefile} = "YES";
-    return if $CPAN::Signal;
-    $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
-    if (system($system)==0) {
-        print "  $system -- OK\n";
-        $self->{'make'} = "YES";
-    } else {
-        $self->{writemakefile} = "YES";
-        $self->{'make'} = "NO";
-        print "  $system -- NOT OK\n";
-    }
-}
+#-> sub CPAN::Author::fullname ;
+sub fullname { shift->{'FULLNAME'} }
+*name = \&fullname;
+#-> sub CPAN::Author::email ;
+sub email    { shift->{'EMAIL'} }
 
-#-> sub CPAN::Distribution::test ;
-sub test {
-    my($self) = @_;
-    $self->make;
-    return if $CPAN::Signal;
-    print "Running make test\n";
-    EXCUSE: {
-         my @e;
-         exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't test";
-         exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
-         exists $self->{'build_dir'} or push @e, "Has no own directory";
-         print join "", map {"  $_\n"} @e and return if @e;
-     }
-    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
-    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
-    my $system = join " ", $CPAN::Config->{'make'}, "test";
-    if (system($system)==0) {
-        print "  $system -- OK\n";
-        $self->{'make_test'} = "YES";
-    } else {
-        $self->{'make_test'} = "NO";
-        print "  $system -- NOT OK\n";
-    }
-}
+package CPAN::Distribution;
+@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
 
-#-> sub CPAN::Distribution::clean ;
-sub clean {
-    my($self) = @_;
-    print "Running make clean\n";
-    EXCUSE: {
-         my @e;
-         exists $self->{'build_dir'} or push @e, "Has no own directory";
-         print join "", map {"  $_\n"} @e and return if @e;
-     }
-    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
-    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
-    my $system = join " ", $CPAN::Config->{'make'}, "clean";
-    if (system($system)==0) {
-       print "  $system -- OK\n";
-       $self->force;
-    } else {
-       # Hmmm, what to do if make clean failed?
-    }
+#-> sub CPAN::Distribution::called_for ;
+sub called_for {
+    my($self,$id) = @_;
+    $self->{'CALLED_FOR'} = $id if defined $id;
+    return $self->{'CALLED_FOR'};
 }
 
-#-> sub CPAN::Distribution::install ;
-sub install {
+#-> sub CPAN::Distribution::get ;
+sub get {
     my($self) = @_;
-    $self->test;
-    return if $CPAN::Signal;
-    print "Running make install\n";
   EXCUSE: {
        my @e;
-       exists $self->{'build_dir'} or push @e, "Has no own directory";
-       exists $self->{'make'} or push @e, "Make had some problems, maybe interrupted? Won't install";
-       exists $self->{'make'} and $self->{'make'} eq 'NO' and push @e, "Oops, make had returned bad status";
-       exists $self->{'install'} and push @e, $self->{'install'} eq "YES" ? "Already done" : "Already tried without success";
+       exists $self->{'build_dir'} and push @e,
+           "Unwrapped into directory $self->{'build_dir'}";
        print join "", map {"  $_\n"} @e and return if @e;
     }
-    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
-    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
-    my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
-    my($pipe) = FileHandle->new("$system 2>&1 |");
-    my($makeout) = "";
-    while (<$pipe>){
-       print;
-       $makeout .= $_;
+    my($local_file);
+    my($local_wanted) =
+        CPAN->catfile(
+                       $CPAN::Config->{keep_source_where},
+                       "authors",
+                       "id",
+                       split("/",$self->{ID})
+                      );
+
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
+    $self->{localfile} = $local_file;
+    my $builddir = $CPAN::META->{cachemgr}->dir;
+    $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    my $packagedir;
+
+    $self->debug("local_file[$local_file]") if $CPAN::DEBUG;
+    if ($CPAN::META->hasMD5) {
+       $self->verifyMD5;
     }
-    $pipe->close;
-    if ($?==0) {
-        print "  $system -- OK\n";
-        $self->{'install'} = "YES";
-    } else {
-        $self->{'install'} = "NO";
-        print "  $system -- NOT OK\n";
-        if ($makeout =~ /permission/s && $> > 0) {
-            print "    You may have to su to root to install the package\n";
-        }
+    if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz|\.zip)$/i){
+       $self->debug("Removing tmp") if $CPAN::DEBUG;
+       File::Path::rmtree("tmp");
+       mkdir "tmp", 0777 or Carp::croak "Couldn't mkdir tmp: $!";
+       chdir "tmp";
+       $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
+       if ($local_file =~ /z$/i){
+           $self->{archived} = "tar";
+           if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
+               $self->{unwrapped} = "YES";
+           } else {
+               $self->{unwrapped} = "NO";
+           }
+       } elsif ($local_file =~ /zip$/i) {
+           $self->{archived} = "zip";
+           if (system("$CPAN::Config->{unzip} $local_file")==0) {
+               $self->{unwrapped} = "YES";
+           } else {
+               $self->{unwrapped} = "NO";
+           }
+       }
+       # Let's check if the package has its own directory.
+       opendir DIR, "." or Carp::croak("Weird: couldn't opendir .: $!");
+       my @readdir = grep $_ !~ /^\.\.?$/, readdir DIR; ### MAC??
+       closedir DIR;
+       my ($distdir,$packagedir);
+       if (@readdir == 1 && -d $readdir[0]) {
+           $distdir = $readdir[0];
+           $packagedir = $CPAN::META->catdir($builddir,$distdir);
+           -d $packagedir and print "Removing previously used $packagedir\n";
+           File::Path::rmtree($packagedir);
+           rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
+       } else {
+           my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
+           $pragmatic_dir =~ s/\W_//g;
+           $pragmatic_dir++ while -d "../$pragmatic_dir";
+           $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
+           File::Path::mkpath($packagedir);
+           my($f);
+           for $f (@readdir) { # is already without "." and ".."
+               my $to = $CPAN::META->catdir($packagedir,$f);
+               rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
+           }
+       }
+       $self->{'build_dir'} = $packagedir;
+
+       chdir "..";
+       $self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
+           if $CPAN::DEBUG;
+       File::Path::rmtree("tmp");
+       if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
+           print "Going to unlink $local_file\n";
+           unlink $local_file or Carp::carp "Couldn't unlink $local_file";
+       }
+       my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
+       unless (-f $makefilepl) {
+           my($configure) = $CPAN::META->catfile($packagedir,"Configure");
+           if (-f $configure) {
+               # do we have anything to do?
+               $self->{'configure'} = $configure;
+           } else {
+               my $fh = FileHandle->new(">$makefilepl")
+                   or Carp::croak("Could not open >$makefilepl");
+               my $cf = $self->called_for || "unknown";
+               $fh->print(qq{
+# This Makefile.PL has been autogenerated by the module CPAN.pm
+# Autogenerated on: }.scalar localtime().qq{
+                   use ExtUtils::MakeMaker;
+                   WriteMakefile(NAME => q[$cf]);
+});
+               print qq{Package comes without Makefile.PL.\n}.
+                   qq{  Writing one on our own (calling it $cf)\n};
+           }
+       }
+    } else {
+       $self->{archived} = "NO";
     }
+    return $self;
 }
 
-#-> sub CPAN::Distribution::dir ;
-sub dir {
-    shift->{'build_dir'};
-}
-
-package CPAN::Bundle;
-@CPAN::Bundle::ISA = qw(CPAN::Debug CPAN::InfoObj CPAN::Module);
+#-> sub CPAN::Distribution::new ;
+sub new {
+    my($class,%att) = @_;
 
-#-> sub CPAN::Bundle::as_string ;
-sub as_string {
-    my($self) = @_;
-    $self->contains;
-    return $self->SUPER::as_string;
-}
+    $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new();
 
-#-> sub CPAN::Bundle::contains ;
-sub contains {
-    my($self) = @_;
-    my($parsefile) = $self->inst_file;
-    unless ($parsefile) {
-       # Try to get at it in the cpan directory
-       $self->debug("no parsefile") if $CPAN::DEBUG;
-       my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
-       $self->debug($dist->as_string) if $CPAN::DEBUG;
-       $dist->get;
-       $self->debug($dist->as_string) if $CPAN::DEBUG;
-       my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
-       File::Path::mkpath($todir);
-       my($me,$from,$to);
-       ($me = $self->id) =~ s/.*://;
-       $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
-       $to = $CPAN::META->catfile($todir,"$me.pm");
-       File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
-       $parsefile = $to;
-    }
-    my @result;
-    my $fh = new FileHandle;
-    local $/ = "\n";
-    open($fh,$parsefile) or die "Could not open '$parsefile': $!";
-    my $inpod = 0;
-    while (<$fh>) {
-       $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
-       next unless $inpod;
-       next if /^=/;
-       next if /^\s+$/;
-       chomp;
-       push @result, (split " ", $_, 2)[0];
-    }
-    close $fh;
-    delete $self->{STATUS};
-    $self->{CONTAINS} = [@result];
-    @result;
+    my $this = { %att };
+    return bless $this, $class;
 }
 
-#-> sub CPAN::Bundle::inst_file ;
-sub inst_file {
+#-> sub CPAN::Distribution::look ;
+sub look {
     my($self) = @_;
-    my($me,$inst_file);
-    ($me = $self->id) =~ s/.*://;
-    $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
-    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
-    $inst_file = $self->SUPER::inst_file;
-    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
-    return $self->{'INST_FILE'}; # even if undefined?
-}
-
-#-> sub CPAN::Bundle::rematein ;
-sub rematein {
-    my($self,$meth) = @_;
-    $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
-    my($s);
-    for $s ($self->contains) {
-       $CPAN::META->instance('CPAN::Module',$s)->$meth();
+    if (  $CPAN::Config->{'shell'} ) {
+       print qq{
+Trying to open a subshell in the build directory...
+};
+    } else {
+       print qq{
+Your configuration does not define a value for subshells.
+Please define it with "o conf shell <your shell>"
+};
+       return;
     }
+    my $dist = $self->id;
+    my $dir  = $self->dir or $self->get;
+    $dir = $self->dir;
+    my $pwd  = Cwd::cwd();
+    chdir($dir);
+    print qq{Working directory is $dir.\n};
+    system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error";
+    chdir($pwd);
 }
 
-#-> sub CPAN::Bundle::force ;
-sub force   { shift->rematein('force',@_); }
-#-> sub CPAN::Bundle::get ;
-sub get     { shift->rematein('get',@_); }
-#-> sub CPAN::Bundle::make ;
-sub make    { shift->rematein('make',@_); }
-#-> sub CPAN::Bundle::test ;
-sub test    { shift->rematein('test',@_); }
-#-> sub CPAN::Bundle::install ;
-sub install { shift->rematein('install',@_); }
-#-> sub CPAN::Bundle::clean ;
-sub clean   { shift->rematein('clean',@_); }
-
-#-> sub CPAN::Bundle::readme ;
-sub readme  {
+#-> sub CPAN::Distribution::readme ;
+sub readme {
     my($self) = @_;
-    my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
-    $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
-    $CPAN::META->instance('CPAN::Distribution',$file)->readme;
+    my($dist) = $self->id;
+    my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
+    $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
+    my($local_file);
+    my($local_wanted) =
+        CPAN->catfile(
+                       $CPAN::Config->{keep_source_where},
+                       "authors",
+                       "id",
+                       split("/","$sans.readme"),
+                      );
+    $self->debug("Doing localize") if $CPAN::DEBUG;
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
+    my $fh_pager = FileHandle->new;
+    $fh_pager->open("|$CPAN::Config->{'pager'}")
+       or die "Could not open pager $CPAN::Config->{'pager'}: $!";
+    my $fh_readme = FileHandle->new;
+    $fh_readme->open($local_file) or die "Could not open $local_file: $!";
+    $fh_pager->print(<$fh_readme>);
 }
 
-package CPAN::Module;
-@CPAN::Module::ISA = qw(CPAN::Debug CPAN::InfoObj);
-
-#-> sub CPAN::Module::as_glimpse ;
-sub as_glimpse {
+#-> sub CPAN::Distribution::verifyMD5 ;
+sub verifyMD5 {
     my($self) = @_;
-    my(@m);
-    my $class = ref($self);
-    $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
-    join "", @m;
+  EXCUSE: {
+       my @e;
+       $self->{MD5_STATUS} ||= "";
+       $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
+       print join "", map {"  $_\n"} @e and return if @e;
+    }
+    my($local_file);
+    my(@local) = split("/",$self->{ID});
+    my($basename) = pop @local;
+    push @local, "CHECKSUMS";
+    my($local_wanted) =
+       CPAN->catfile(
+                     $CPAN::Config->{keep_source_where},
+                     "authors",
+                     "id",
+                     @local
+                    );
+    local($") = "/";
+    if (
+       -f $local_wanted
+       &&
+       $self->MD5_check_file($local_wanted,$basename)
+       ) {
+       return $self->{MD5_STATUS} = "OK";
+    }
+    $local_file = CPAN::FTP->localize(
+                                     "authors/id/@local",
+                                     $local_wanted,
+                                     'force>:-{');
+    my($checksum_pipe);
+    if ($local_file) {
+       # fine
+    } else {
+       $local[-1] .= ".gz";
+       $local_file = CPAN::FTP->localize(
+                                         "authors/id/@local",
+                                         "$local_wanted.gz",
+                                         'force>:-{'
+                                        );
+       my $system = "$CPAN::Config->{gzip} --decompress $local_file";
+       system($system)==0 or die "Could not uncompress $local_file";
+       $local_file =~ s/\.gz$//;
+    }
+    $self->MD5_check_file($local_file,$basename);
 }
 
-#-> sub CPAN::Module::as_string ;
-sub as_string {
-    my($self) = @_;
-    my(@m);
-    CPAN->debug($self) if $CPAN::DEBUG;
-    my $class = ref($self);
-    $class =~ s/^CPAN:://;
-    local($^W) = 0;
-    push @m, $class, " id = $self->{ID}\n";
-    my $sprintf = "    %-12s %s\n";
-    push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
-    my $sprintf2 = "    %-12s %s (%s)\n";
-    my($userid);
-    if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
-       push @m, sprintf(
-                        $sprintf2,
-                        'CPAN_USERID',
-                        $userid,
-                        $CPAN::META->instance(CPAN::Author,$userid)->fullname
-                       )
-    }
-    push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
-    push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
-    my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
-    my(%statd,%stats,%statl,%stati);
-    @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
-    @stats{qw,? m d u n,}       = qw,unknown mailing-list developer comp.lang.perl.* none,;
-    @statl{qw,? p c + o,}       = qw,unknown perl C C++ other,;
-    @stati{qw,? f r O,}         = qw,unknown functions references+ties object-oriented,;
-    $statd{' '} = 'unknown';
-    $stats{' '} = 'unknown';
-    $statl{' '} = 'unknown';
-    $stati{' '} = 'unknown';
-    push @m, sprintf(
-                    $sprintf3,
-                    'DSLI_STATUS',
-                    $self->{statd},
-                    $self->{stats},
-                    $self->{statl},
-                    $self->{stati},
-                    $statd{$self->{statd}},
-                    $stats{$self->{stats}},
-                    $statl{$self->{statl}},
-                    $stati{$self->{stati}}
-                   ) if $self->{statd};
-    my $local_file = $self->inst_file;
-    if ($local_file && ! exists $self->{MANPAGE}) {
-       my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
-       my $inpod = 0;
-       my(@result);
-       local $/ = "\n";
-       while (<$fh>) {
-           $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
-           next unless $inpod;
-           next if /^=/;
-           next if /^\s+$/;
-           chomp;
-           push @result, $_;
+#-> sub CPAN::Distribution::MD5_check_file ;
+sub MD5_check_file {
+    my($self,$lfile,$basename) = @_;
+    my($cksum);
+    my $fh = new FileHandle;
+    local($/)=undef;
+    if (open $fh, $lfile){
+       my $eval = <$fh>;
+       close $fh;
+       my($comp) = Safe->new();
+       $cksum = $comp->reval($eval);
+       Carp::confess($@) if $@;
+       if ($cksum->{$basename}->{md5}) {
+           $self->debug("Found checksum for $basename: $cksum->{$basename}->{md5}\n")
+               if $CPAN::DEBUG;
+           my $file = $self->{localfile};
+           my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $self->{localfile}|";
+           if (
+               open($fh, $file) && $self->eq_MD5($fh,$cksum->{$basename}->{md5})
+               or
+               open($fh, $pipe) && $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
+              ){
+               print "Checksum for $file ok\n";
+               return $self->{MD5_STATUS} = "OK";
+           } else {
+               print join(
+                          "",
+                          qq{Checksum mismatch for distribution file. },
+                          qq{Please investigate.\n\n}
+                         );
+               print $self->as_string;
+               print $CPAN::META->instance(
+                                           'CPAN::Author',
+                                           $self->{CPAN_USERID}
+                                          )->as_string;
+               my $wrap = qq{I\'d recommend removing $self->{'localfile'}}.
+                   qq{, put another URL at the top of the list of URLs to }.
+                   qq{visit, and restart CPAN.pm. If all this doesn\'t help, }.
+                   qq{please contact the author or your CPAN site admin};
+               print Text::Wrap::wrap("","",$wrap);
+               print "\n\n";
+               sleep 3;
+               return;
+           }
+           close $fh if fileno($fh);
+       } else {
+           $self->{MD5_STATUS} ||= "";
+           if ($self->{MD5_STATUS} eq "NIL") {
+               print "\nNo md5 checksum for $basename in local $lfile.";
+               print "Removing $lfile\n";
+               unlink $lfile or print "Could not unlink: $!";
+               sleep 1;
+           }
+           $self->{MD5_STATUS} = "NIL";
+           return;
        }
-       close $fh;
-       $self->{MANPAGE} = join " ", @result;
-    }
-    push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
-    push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
-    push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
-    join "", @m, "\n";
-}
-
-#-> sub CPAN::Module::cpan_file ;
-sub cpan_file    {
-    my $self = shift;
-    CPAN->debug($self->id) if $CPAN::DEBUG;
-    unless (defined $self->{'CPAN_FILE'}) {
-       CPAN::Index->reload;
-    }
-    if (defined $self->{'CPAN_FILE'}){
-       return $self->{'CPAN_FILE'};
-    } elsif (defined $self->{'userid'}) {
-       return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
     } else {
-       return "N/A";
+       Carp::carp "Could not open $lfile for reading";
     }
 }
 
-*name = \&cpan_file;
-
-#-> sub CPAN::Module::cpan_version ;
-sub cpan_version { shift->{'CPAN_VERSION'} }
+#-> sub CPAN::Distribution::eq_MD5 ;
+sub eq_MD5 {
+    my($self,$fh,$expectMD5) = @_;
+    my $md5 = new MD5;
+    $md5->addfile($fh);
+    my $hexdigest = $md5->hexdigest;
+    $hexdigest eq $expectMD5;
+}
 
-#-> sub CPAN::Module::force ;
+#-> sub CPAN::Distribution::force ;
 sub force {
     my($self) = @_;
     $self->{'force_update'}++;
+    delete $self->{'MD5_STATUS'};
+    delete $self->{'archived'};
+    delete $self->{'build_dir'};
+    delete $self->{'localfile'};
+    delete $self->{'make'};
+    delete $self->{'install'};
+    delete $self->{'unwrapped'};
+    delete $self->{'writemakefile'};
 }
 
-#-> sub CPAN::Module::rematein ;
-sub rematein {
-    my($self,$meth) = @_;
+#-> sub CPAN::Distribution::make ;
+sub make {
+    my($self) = @_;
     $self->debug($self->id) if $CPAN::DEBUG;
-    my $cpan_file = $self->cpan_file;
-    return if $cpan_file eq "N/A";
-    return if $cpan_file =~ /^Contact Author/;
-    my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
-    $pack->called_for($self->id);
-    $pack->force if exists $self->{'force_update'};
-    $pack->$meth();
-    delete $self->{'force_update'};
-}
+    print "Running make\n";
+    $self->get;
+  EXCUSE: {
+       my @e;
+       $self->{archived} eq "NO" and push @e,
+       "Is neither a tar nor a zip archive.";
 
-#-> sub CPAN::Module::readme ;
-sub readme { shift->rematein('readme') }
-#-> sub CPAN::Module::look ;
-sub look { shift->rematein('look') }
-#-> sub CPAN::Module::get ;
-sub get    { shift->rematein('get',@_); }
-#-> sub CPAN::Module::make ;
-sub make   { shift->rematein('make') }
-#-> sub CPAN::Module::test ;
-sub test   { shift->rematein('test') }
-#-> sub CPAN::Module::install ;
-sub install {
-    my($self) = @_;
-    my($doit) = 0;
-    my($latest) = $self->cpan_version;
-    $latest ||= 0;
-    my($inst_file) = $self->inst_file;
-    my($have) = 0;
-    if (defined $inst_file) {
-       $have = $self->inst_version;
+       $self->{unwrapped} eq "NO"   and push @e,
+       "had problems unarchiving. Please build manually";
+
+       exists $self->{writemakefile} &&
+           $self->{writemakefile} eq "NO" and push @e,
+           "Had some problem writing Makefile";
+
+       defined $self->{'make'} and push @e,
+       "Has already been processed within this session";
+
+       print join "", map {"  $_\n"} @e and return if @e;
     }
-    if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
-       print $self->id, " is up to date.\n";
+    print "\n  CPAN.pm: Going to build ".$self->id."\n\n";
+    my $builddir = $self->dir;
+    chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
+    $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+
+    my $system;
+    if ($self->{'configure'}) {
+       $system = $self->{'configure'};
     } else {
-       $doit = 1;
+       my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
+       $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X";
+       unless ($perl) {
+           my ($component,$perl_name);
+           DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
+                 DIST_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
+                       next unless defined($component) && $component;
+                       my($abs) = MM->catfile($component,$perl_name);
+                       if (MM->maybe_command($abs)) {
+                           $perl = $abs;
+                           last DIST_PERLNAME;
+                       }
+                   }
+               }
+       }
+       die "Couldn\'t find executable perl\n" unless $perl;
+       $system = "$perl Makefile.PL $CPAN::Config->{makepl_arg}";
+   }
+    $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
+    my($ret,$pid);
+    $@ = "";
+    if ($CPAN::Config->{inactivity_timeout}) {
+       eval {
+           alarm $CPAN::Config->{inactivity_timeout};
+           #$SIG{CHLD} = \&REAPER;
+           if (defined($pid=fork)) {
+               if ($pid) { #parent
+                   wait;
+               } else {    #child
+                   exec $system;
+               }
+           } else {
+               print "Cannot fork: $!";
+               return;
+           }
+           $ret = system($system);
+       };
+       alarm 0;
+    } else {
+       $ret = system($system);
+    }
+    if ($@){
+       kill 9, $pid;
+       waitpid $pid, 0;
+       print $@;
+       $self->{writemakefile} = "NO - $@";
+       $@ = "";
+       return;
+    } elsif ($ret != 0) {
+        $self->{writemakefile} = "NO";
+        return;
+    }
+    $self->{writemakefile} = "YES";
+    return if $CPAN::Signal;
+    $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
+    if (system($system)==0) {
+        print "  $system -- OK\n";
+        $self->{'make'} = "YES";
+    } else {
+        $self->{writemakefile} = "YES";
+        $self->{'make'} = "NO";
+        print "  $system -- NOT OK\n";
     }
-    $self->rematein('install') if $doit;
 }
-#-> sub CPAN::Module::clean ;
-sub clean  { shift->rematein('clean') }
 
-#-> sub CPAN::Module::inst_file ;
-sub inst_file {
+#-> sub CPAN::Distribution::test ;
+sub test {
     my($self) = @_;
-    my($dir,@packpath);
-    @packpath = split /::/, $self->{ID};
-    $packpath[-1] .= ".pm";
-    foreach $dir (@INC) {
-       my $pmfile = CPAN->catfile($dir,@packpath);
-       if (-f $pmfile){
-           return $pmfile;
-       }
+    $self->make;
+    return if $CPAN::Signal;
+    print "Running make test\n";
+  EXCUSE: {
+       my @e;
+       exists $self->{'make'} or push @e,
+       "Make had some problems, maybe interrupted? Won't test";
+
+       exists $self->{'make'} and
+           $self->{'make'} eq 'NO' and
+               push @e, "Oops, make had returned bad status";
+
+       exists $self->{'build_dir'} or push @e, "Has no own directory";
+       print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "test";
+    if (system($system)==0) {
+        print "  $system -- OK\n";
+        $self->{'make_test'} = "YES";
+    } else {
+        $self->{'make_test'} = "NO";
+        print "  $system -- NOT OK\n";
     }
 }
 
-#-> sub CPAN::Module::xs_file ;
-sub xs_file {
+#-> sub CPAN::Distribution::clean ;
+sub clean {
     my($self) = @_;
-    my($dir,@packpath);
-    @packpath = split /::/, $self->{ID};
-    push @packpath, $packpath[-1];
-    $packpath[-1] .= "." . $Config::Config{'dlext'};
-    foreach $dir (@INC) {
-       my $xsfile = CPAN->catfile($dir,'auto',@packpath);
-       if (-f $xsfile){
-           return $xsfile;
-       }
+    print "Running make clean\n";
+  EXCUSE: {
+       my @e;
+       exists $self->{'build_dir'} or push @e, "Has no own directory";
+       print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "clean";
+    if (system($system)==0) {
+       print "  $system -- OK\n";
+       $self->force;
+    } else {
+       # Hmmm, what to do if make clean failed?
     }
 }
 
-#-> sub CPAN::Module::inst_version ;
-sub inst_version {
+#-> sub CPAN::Distribution::install ;
+sub install {
     my($self) = @_;
-    my $parsefile = $self->inst_file or return 0;
-    local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
-    my $have = MY->parse_version($parsefile);
-    $have ||= 0;
-    $have =~ s/\s+//g;
-    $have ||= 0;
-    $have;
-}
+    $self->test;
+    return if $CPAN::Signal;
+    print "Running make install\n";
+  EXCUSE: {
+       my @e;
+       exists $self->{'build_dir'} or push @e, "Has no own directory";
 
-package CPAN::CacheMgr;
-use vars qw($Du);
-@CPAN::CacheMgr::ISA = qw(CPAN::Debug CPAN::InfoObj);
-use File::Find;
+       exists $self->{'make'} or push @e,
+       "Make had some problems, maybe interrupted? Won't install";
 
-#-> sub CPAN::CacheMgr::as_string ;
-sub as_string {
-    eval { require Data::Dumper };
-    if ($@) {
-       return shift->SUPER::as_string;
+       exists $self->{'make'} and
+           $self->{'make'} eq 'NO' and
+               push @e, "Oops, make had returned bad status";
+
+       exists $self->{'install'} and push @e,
+       $self->{'install'} eq "YES" ?
+           "Already done" : "Already tried without success";
+
+       print join "", map {"  $_\n"} @e and return if @e;
+    }
+    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+    my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
+    my($pipe) = FileHandle->new("$system 2>&1 |");
+    my($makeout) = "";
+    while (<$pipe>){
+       print;
+       $makeout .= $_;
+    }
+    $pipe->close;
+    if ($?==0) {
+        print "  $system -- OK\n";
+        $self->{'install'} = "YES";
     } else {
-       return Data::Dumper::Dumper(shift);
+        $self->{'install'} = "NO";
+        print "  $system -- NOT OK\n";
+        if ($makeout =~ /permission/s && $> > 0) {
+            print "    You may have to su to root to install the package\n";
+        }
     }
 }
 
-#-> sub CPAN::CacheMgr::cachesize ;
-sub cachesize {
-    shift->{DU};
+#-> sub CPAN::Distribution::dir ;
+sub dir {
+    shift->{'build_dir'};
 }
 
-# sub check {
-#     my($self,@dirs) = @_;
-#     return unless -d $self->{ID};
-#     my $dir;
-#     @dirs = $self->dirs unless @dirs;
-#     for $dir (@dirs) {
-#        $self->disk_usage($dir);
-#     }
-# }
+package CPAN::Bundle;
+@CPAN::Bundle::ISA = qw(CPAN::Module);
 
-#-> sub CPAN::CacheMgr::clean_cache ;
-sub clean_cache {
-    my $self = shift;
-    my $dir;
-    while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
-       $self->force_clean_cache($dir);
+#-> sub CPAN::Bundle::as_string ;
+sub as_string {
+    my($self) = @_;
+    $self->contains;
+    $self->{INST_VERSION} = $self->inst_version;
+    return $self->SUPER::as_string;
+}
+
+#-> sub CPAN::Bundle::contains ;
+sub contains {
+    my($self) = @_;
+    my($parsefile) = $self->inst_file;
+    unless ($parsefile) {
+       # Try to get at it in the cpan directory
+       $self->debug("no parsefile") if $CPAN::DEBUG;
+       my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
+       $self->debug($dist->as_string) if $CPAN::DEBUG;
+       $dist->get;
+       $self->debug($dist->as_string) if $CPAN::DEBUG;
+       my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+       File::Path::mkpath($todir);
+       my($me,$from,$to);
+       ($me = $self->id) =~ s/.*://;
+       $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
+       $to = $CPAN::META->catfile($todir,"$me.pm");
+       File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
+       $parsefile = $to;
     }
-    $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
+    my @result;
+    my $fh = new FileHandle;
+    local $/ = "\n";
+    open($fh,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    while (<$fh>) {
+       $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
+       next unless $inpod;
+       next if /^=/;
+       next if /^\s+$/;
+       chomp;
+       push @result, (split " ", $_, 2)[0];
+    }
+    close $fh;
+    delete $self->{STATUS};
+    $self->{CONTAINS} = [@result];
+    @result;
 }
 
-#-> sub CPAN::CacheMgr::dir ;
-sub dir {
-    shift->{ID};
+#-> sub CPAN::Bundle::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($me,$inst_file);
+    ($me = $self->id) =~ s/.*://;
+    $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
+    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+    $inst_file = $self->SUPER::inst_file;
+    return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
+    return $self->{'INST_FILE'}; # even if undefined?
 }
 
-#-> sub CPAN::CacheMgr::entries ;
-sub entries {
-    my($self,$dir) = @_;
-    $dir ||= $self->{ID};
-    my($cwd) = Cwd::cwd();
-    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
-    my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
-    my(@entries);
-    for ($dh->read) {
-       next if $_ eq "." || $_ eq "..";
-       if (-f $_) {
-           push @entries, $CPAN::META->catfile($dir,$_);
-       } elsif (-d _) {
-           push @entries, $CPAN::META->catdir($dir,$_);
-       } else {
-           print STDERR "Warning: weird direntry in $dir: $_\n";
+#-> sub CPAN::Bundle::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
+    my($s);
+    for $s ($self->contains) {
+       my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
+           $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
+       if ($type eq 'CPAN::Distribution') {
+           warn qq{
+The Bundle }.$self->id.qq{ contains
+explicitly a file $s.
+};
+           sleep 3;
        }
+       $CPAN::META->instance($type,$s)->$meth();
     }
-    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
-    sort {-M $b <=> -M $a} @entries;
 }
 
-#-> sub CPAN::CacheMgr::disk_usage ;
-sub disk_usage {
-    my($self,$dir) = @_;
-    if (! defined $dir or $dir eq "") {
-       $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
-       return;
-    }
-    return if defined $self->{SIZE}{$dir};
-    local($Du) = 0;
-    find(
-        sub {
-            return if -l $_;
-            $Du += -s;
-        },
-        $dir
-       );
-    $self->{SIZE}{$dir} = $Du/1024/1024;
-    push @{$self->{FIFO}}, $dir;
-    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
-    $self->{DU} += $Du/1024/1024;
-    if ($self->{DU} > $self->{'MAX'} ) {
-       printf "...Hold on a sec... CPAN's cleaning the cache: %.2f MB > %.2f MB\n",
-               $self->{DU}, $self->{'MAX'};
-       $self->clean_cache;
-    } else {
-       $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}") if $CPAN::DEBUG;
-       $self->debug($self->as_string) if $CPAN::DEBUG;
-    }
-    $self->{DU};
-}
+#-> sub CPAN::Bundle::force ;
+sub force   { shift->rematein('force',@_); }
+#-> sub CPAN::Bundle::get ;
+sub get     { shift->rematein('get',@_); }
+#-> sub CPAN::Bundle::make ;
+sub make    { shift->rematein('make',@_); }
+#-> sub CPAN::Bundle::test ;
+sub test    { shift->rematein('test',@_); }
+#-> sub CPAN::Bundle::install ;
+sub install { shift->rematein('install',@_); }
+#-> sub CPAN::Bundle::clean ;
+sub clean   { shift->rematein('clean',@_); }
 
-#-> sub CPAN::CacheMgr::force_clean_cache ;
-sub force_clean_cache {
-    my($self,$dir) = @_;
-    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}") if $CPAN::DEBUG;
-    File::Path::rmtree($dir);
-    $self->{DU} -= $self->{SIZE}{$dir};
-    delete $self->{SIZE}{$dir};
+#-> sub CPAN::Bundle::readme ;
+sub readme  {
+    my($self) = @_;
+    my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
+    $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
+    $CPAN::META->instance('CPAN::Distribution',$file)->readme;
 }
 
-#-> sub CPAN::CacheMgr::new ;
-sub new {
-    my $class = shift;
-    my $self = { ID => $CPAN::Config->{'build_dir'}, MAX => $CPAN::Config->{'build_cache'}, DU => 0 };
-    File::Path::mkpath($self->{ID});
-    my $dh = DirHandle->new($self->{ID});
-    bless $self, $class;
-    $self->debug("dir [$self->{ID}]") if $CPAN::DEBUG;
-    my $e;
-    for $e ($self->entries) {
-       next if $e eq ".." || $e eq ".";
-       $self->debug("Have to check size $e") if $CPAN::DEBUG;
-       $self->disk_usage($e);
-    }
-    $self;
-}
+package CPAN::Module;
+@CPAN::Module::ISA = qw(CPAN::InfoObj);
 
-package CPAN::Debug;
+#-> sub CPAN::Module::as_glimpse ;
+sub as_glimpse {
+    my($self) = @_;
+    my(@m);
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
+    join "", @m;
+}
 
-#-> sub CPAN::Debug::debug ;
-sub debug {
-    my($self,$arg) = @_;
-    my($caller,$func,$line,@rest) = caller(1); # caller(0) eg Complete, caller(1) eg readline
-    ($caller) = caller(0);
-    $caller =~ s/.*:://;
-#    print "caller[$caller]func[$func]line[$line]rest[@rest]\n";
-#    print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]CPAN::DEBUG[$CPAN::DEBUG]\n";
-    if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
-       if (ref $arg) {
-           eval { require Data::Dumper };
-           if ($@) {
-               print $arg->as_string;
-           } else {
-               print Data::Dumper::Dumper($arg);
-           }
-       } else {
-           print "Debug($caller:$func,$line,@rest): $arg\n"
+#-> sub CPAN::Module::as_string ;
+sub as_string {
+    my($self) = @_;
+    my(@m);
+    CPAN->debug($self) if $CPAN::DEBUG;
+    my $class = ref($self);
+    $class =~ s/^CPAN:://;
+    local($^W) = 0;
+    push @m, $class, " id = $self->{ID}\n";
+    my $sprintf = "    %-12s %s\n";
+    push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
+    my $sprintf2 = "    %-12s %s (%s)\n";
+    my($userid);
+    if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
+       push @m, sprintf(
+                        $sprintf2,
+                        'CPAN_USERID',
+                        $userid,
+                        $CPAN::META->instance(CPAN::Author,$userid)->fullname
+                       )
+    }
+    push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
+    push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
+    my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
+    my(%statd,%stats,%statl,%stati);
+    @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
+    @stats{qw,? m d u n,}       = qw,unknown mailing-list developer comp.lang.perl.* none,;
+    @statl{qw,? p c + o,}       = qw,unknown perl C C++ other,;
+    @stati{qw,? f r O,}         = qw,unknown functions references+ties object-oriented,;
+    $statd{' '} = 'unknown';
+    $stats{' '} = 'unknown';
+    $statl{' '} = 'unknown';
+    $stati{' '} = 'unknown';
+    push @m, sprintf(
+                    $sprintf3,
+                    'DSLI_STATUS',
+                    $self->{statd},
+                    $self->{stats},
+                    $self->{statl},
+                    $self->{stati},
+                    $statd{$self->{statd}},
+                    $stats{$self->{stats}},
+                    $statl{$self->{statl}},
+                    $stati{$self->{stati}}
+                   ) if $self->{statd};
+    my $local_file = $self->inst_file;
+    if ($local_file && ! exists $self->{MANPAGE}) {
+       my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
+       my $inpod = 0;
+       my(@result);
+       local $/ = "\n";
+       while (<$fh>) {
+           $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
+           next unless $inpod;
+           next if /^=/;
+           next if /^\s+$/;
+           chomp;
+           push @result, $_;
        }
+       close $fh;
+       $self->{MANPAGE} = join " ", @result;
     }
+    push @m, sprintf $sprintf, 'MANPAGE', $self->{MANPAGE} if $self->{MANPAGE};
+    push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
+    push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
+    join "", @m, "\n";
 }
 
-package CPAN::Config;
-import ExtUtils::MakeMaker 'neatvalue';
-use vars qw(%can);
-
-%can = (
-  'commit' => "Commit changes to disk",
-  'defaults' => "Reload defaults from disk",
-);
-
-#-> sub CPAN::Config::edit ;
-sub edit {
-    my($class,@args) = @_;
-    return unless @args;
-    CPAN->debug("class[$class]args[".join(" | ",@args)."]");
-    my($o,$str,$func,$args,$key_exists);
-    $o = shift @args;
-    if($can{$o}) {
-       $class->$o(@args);
-       return 1;
+#-> sub CPAN::Module::cpan_file ;
+sub cpan_file    {
+    my $self = shift;
+    CPAN->debug($self->id) if $CPAN::DEBUG;
+    unless (defined $self->{'CPAN_FILE'}) {
+       CPAN::Index->reload;
+    }
+    if (defined $self->{'CPAN_FILE'}){
+       return $self->{'CPAN_FILE'};
+    } elsif (defined $self->{'userid'}) {
+       return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
     } else {
-       if (ref($CPAN::Config->{$o}) eq ARRAY) {
-           $func = shift @args;
-           # Let's avoid eval, it's easier to comprehend without.
-           if ($func eq "push") {
-               push @{$CPAN::Config->{$o}}, @args;
-           } elsif ($func eq "pop") {
-               pop @{$CPAN::Config->{$o}};
-           } elsif ($func eq "shift") {
-               shift @{$CPAN::Config->{$o}};
-           } elsif ($func eq "unshift") {
-               unshift @{$CPAN::Config->{$o}}, @args;
-           } elsif ($func eq "splice") {
-               splice @{$CPAN::Config->{$o}}, @args;
-           } else {
-               $CPAN::Config->{$o} = [@args];
-           }
-       } else {
-           $CPAN::Config->{$o} = $args[0] if defined $args[0];
-           print "    $o    ";
-           print defined $CPAN::Config->{$o} ? $CPAN::Config->{$o} : "UNDEFINED";
-       }
+       return "N/A";
     }
 }
 
-#-> sub CPAN::Config::commit ;
-sub commit {
-    my($self, $configpm) = @_;
-    my $mode;
-    # mkpath!?
-
-    my($fh) = FileHandle->new;
-    $configpm ||= cfile();
-    if (-f $configpm) {
-       $mode = (stat $configpm)[2];
-       if ($mode && ! -w _) {
-           print "$configpm is not writable\n" and return;
-       }
-       #chmod 0644, $configpm; #?
-    }
-
-    my $msg = <<EOF unless $configpm =~ /MyConfig/;
-
-# This is CPAN.pm's systemwide configuration file.  This file provides
-# defaults for users, and the values can be changed in a per-user configuration
-# file. The user-config file is being looked for as ~/.cpan/CPAN/MyConfig.pm.
-
-EOF
-    $msg ||= "\n";
-    open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
-    print $fh qq[$msg\$CPAN::Config = \{\n];
-    foreach (sort keys %$CPAN::Config) {
-       print $fh "  '$_' => ", ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$_}), ",\n";
-    }
+*name = \&cpan_file;
 
-    print $fh "};\n1;\n__END__\n";
-    close $fh;
+#-> sub CPAN::Module::cpan_version ;
+sub cpan_version { shift->{'CPAN_VERSION'} }
 
-    #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
-    #chmod $mode, $configpm;
-    $self->defaults;
-    print "commit: wrote $configpm\n";
-    1;
+#-> sub CPAN::Module::force ;
+sub force {
+    my($self) = @_;
+    $self->{'force_update'}++;
 }
 
-*default = \&defaults;
-#-> sub CPAN::Config::defaults ;
-sub defaults {
-    my($self) = @_;
-    $self->unload;
-    $self->load;
-    1;
+#-> sub CPAN::Module::rematein ;
+sub rematein {
+    my($self,$meth) = @_;
+    $self->debug($self->id) if $CPAN::DEBUG;
+    my $cpan_file = $self->cpan_file;
+    return if $cpan_file eq "N/A";
+    return if $cpan_file =~ /^Contact Author/;
+    my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
+    $pack->called_for($self->id);
+    $pack->force if exists $self->{'force_update'};
+    $pack->$meth();
+    delete $self->{'force_update'};
 }
 
-my $dot_cpan;
-#-> sub CPAN::Config::load ;
-sub load {
+#-> sub CPAN::Module::readme ;
+sub readme { shift->rematein('readme') }
+#-> sub CPAN::Module::look ;
+sub look { shift->rematein('look') }
+#-> sub CPAN::Module::get ;
+sub get    { shift->rematein('get',@_); }
+#-> sub CPAN::Module::make ;
+sub make   { shift->rematein('make') }
+#-> sub CPAN::Module::test ;
+sub test   { shift->rematein('test') }
+#-> sub CPAN::Module::install ;
+sub install {
     my($self) = @_;
-    eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
-    unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
-    eval {require CPAN::MyConfig;};     # where you can override system wide settings
-    unless ( $self->load_succeeded ) {
-         require CPAN::FirstTime;
-         my($configpm,$fh);
-         if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
-             $configpm = $INC{"CPAN/Config.pm"};
-         } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
-             $configpm = $INC{"CPAN/MyConfig.pm"};
-         } else {
-             my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
-             my($configpmdir) = MY->catdir($path_to_cpan,"CPAN");
-             my($configpmtest) = MY->catfile($configpmdir,"Config.pm");
-             if (-d $configpmdir || File::Path::mkpath($configpmdir)) {
-                 if (-w $configpmtest or -w $configpmdir) {
-                     $configpm = $configpmtest;
-                 }
-             }
-             unless ($configpm) {
-                 $configpmdir = MY->catdir($ENV{HOME},".cpan","CPAN");
-                 File::Path::mkpath($configpmdir);
-                 $configpmtest = MY->catfile($configpmdir,"MyConfig.pm");
-                 if (-w $configpmtest or -w $configpmdir) {
-                     $configpm = $configpmtest;
-                 } else {
-                     warn "WARNING: CPAN.pm is unable to create a configuration file.\n";
-                 }
-             }
-         }
-         warn "Calling CPAN::FirstTime::init($configpm)";
-         CPAN::FirstTime::init($configpm);
+    my($doit) = 0;
+    my($latest) = $self->cpan_version;
+    $latest ||= 0;
+    my($inst_file) = $self->inst_file;
+    my($have) = 0;
+    if (defined $inst_file) {
+       $have = $self->inst_version;
+    }
+    if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
+       print $self->id, " is up to date.\n";
+    } else {
+       $doit = 1;
     }
+    $self->rematein('install') if $doit;
 }
+#-> sub CPAN::Module::clean ;
+sub clean  { shift->rematein('clean') }
 
-#-> sub CPAN::Config::load_succeeded ;
-sub load_succeeded {
-    my($miss) = 0;
-    for (qw(
-           cpan_home keep_source_where build_dir build_cache index_expire
-           gzip tar unzip make pager makepl_arg make_arg make_install_arg
-           urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
-          )) {
-       unless (defined $CPAN::Config->{$_}){
-           $miss++;
-           CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG;
+#-> sub CPAN::Module::inst_file ;
+sub inst_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    $packpath[-1] .= ".pm";
+    foreach $dir (@INC) {
+       my $pmfile = CPAN->catfile($dir,@packpath);
+       if (-f $pmfile){
+           return $pmfile;
        }
     }
-    return !$miss;
-}
-
-#-> sub CPAN::Config::unload ;
-sub unload {
-    delete $INC{'CPAN/MyConfig.pm'};
-    delete $INC{'CPAN/Config.pm'};
-}
-
-#-> sub CPAN::Config::cfile ;
-sub cfile {
-    $INC{'CPAN/MyConfig.pm'} || $INC{'CPAN/Config.pm'};
 }
 
-*h = \&help;
-#-> sub CPAN::Config::help ;
-sub help {
-    print <<EOF;
-Known options:
-  defaults  reload default config values from disk
-  commit    commit session changes to disk
-
-You may edit key values in the follow fashion:
-
-  o conf build_cache 15
-
-  o conf build_dir "/foo/bar"
-
-  o conf urllist shift
-
-  o conf urllist unshift ftp://ftp.foo.bar/
-
-EOF
-    undef; #don't reprint CPAN::Config
+#-> sub CPAN::Module::xs_file ;
+sub xs_file {
+    my($self) = @_;
+    my($dir,@packpath);
+    @packpath = split /::/, $self->{ID};
+    push @packpath, $packpath[-1];
+    $packpath[-1] .= "." . $Config::Config{'dlext'};
+    foreach $dir (@INC) {
+       my $xsfile = CPAN->catfile($dir,'auto',@packpath);
+       if (-f $xsfile){
+           return $xsfile;
+       }
+    }
 }
 
-#-> sub CPAN::Config::complete ;
-sub complete {
-    my($word,$line,$pos) = @_;
-    $word ||= "";
-    my(@words) = split " ", $line;
-    my(@o_conf) = (sort keys %CPAN::Config::can, sort keys %$CPAN::Config);
-    return (@o_conf) unless @words>2;
-    if($words[2] =~ /->(.*)/) {
-       my $meth = $1;
-       my(@methods) = qw(shift unshift push pop splice);
-       return @methods unless $meth;
-       return sort grep /^\Q$meth\E/, @methods;
-    }
-    return sort grep /^\Q$word\E/, @o_conf;
+#-> sub CPAN::Module::inst_version ;
+sub inst_version {
+    my($self) = @_;
+    my $parsefile = $self->inst_file or return 0;
+    local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
+    my $have = MM->parse_version($parsefile);
+    $have ||= 0;
+    $have =~ s/\s+//g;
+    $have ||= 0;
+    $have;
 }
 
 1;
@@ -2608,11 +2875,11 @@ distribution file where this module is included and processes that.
 
 Any C<make>, C<test>, and C<readme> are run unconditionally. A 
 
-  C<install E<lt>distribution_fileE<gt>>
+  install <distribution_file>
 
 also is run unconditionally.  But for 
 
-  C<install E<lt>moduleE<gt>>
+  install <module>
 
 CPAN checks if an install is actually needed for it and prints
 I<Foo up to date> in case the module doesnE<39>t need to be updated.
index e970cf1..3127a5e 100644 (file)
@@ -12,9 +12,10 @@ package CPAN::FirstTime;
 
 use strict;
 use ExtUtils::MakeMaker qw(prompt);
-require File::Path;
+use FileHandle ();
+use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.13 $, 10;
+$VERSION = substr q$Revision: 1.15 $, 10;
 
 =head1 NAME
 
@@ -48,7 +49,6 @@ sub init {
     #
 
     print qq{
-
 The CPAN module needs a directory of its own to cache important
 index files and maybe keep a temporary mirror of CPAN files. This may
 be a site-wide directory or a personal directory.
@@ -72,11 +72,15 @@ First of all, I\'d like to create this directory. Where?
     }
 
     $default = $cpan_home;
-    until (-d ($ans = prompt("CPAN build and cache directory?",$default)) && -w _) {
-       print "Couldn't find directory $ans
+    while ($ans = prompt("CPAN build and cache directory?",$default)) {
+       File::Path::mkpath($ans); # dies if it can't
+       if (-d $ans && -w _) {
+           last;
+       } else {
+           warn "Couldn't find directory $ans
   or directory is not writable. Please retry.\n";
+       }
     }
-    File::Path::mkpath($ans); # dies if it can't
     $CPAN::Config->{cpan_home} = $ans;
     
     print qq{
@@ -117,6 +121,8 @@ with all the intermediate files?
 
 The CPAN module will need a few external programs to work
 properly. Please correct me, if I guess the wrong path for a program.
+Don\'t panic if you do not have some of them, just press ENTER for
+those.
 
 };
 
@@ -134,6 +140,7 @@ properly. Please correct me, if I guess the wrong path for a program.
     $CPAN::Config->{'pager'} = $ans;
     $path = $CPAN::Config->{'shell'} || $ENV{SHELL} || "";
     $ans = prompt("What is your favorite shell?",$path) || $path;
+    $CPAN::Config->{'shell'} = $ans;
 
     #
     # Arguments to make etc.
@@ -146,6 +153,8 @@ run \'make\' and \'make install\' in processes. If you have any parameters
 \(e.g. PREFIX, INSTALLPRIVLIB, UNINST or the like\) you want to pass to
 the calls, please specify them here.
 
+If you don\'t understand this question, just press ENTER.
+
 };
 
     $default = $CPAN::Config->{makepl_arg} || "";
@@ -183,29 +192,59 @@ If you set this value to 0, these processes will wait forever.
     #
 
     $local = 'MIRRORED.BY';
+    $local = MM->catfile($CPAN::Config->{keep_source_where},"MIRRORED.BY") unless -f $local;
     if (@{$CPAN::Config->{urllist}||[]}) {
        print qq{
 I found a list of URLs in CPAN::Config and will use this.
 You can change it later with the 'o conf' command.
 
 }
-    } elsif (-f $local) { # if they really have a wrong MIRRORED.BY in
-                          # the current directory, we can't help
+    } elsif (
+            -s $local
+            &&
+            -M $local < 30
+           ) {
        read_mirrored_by($local);
     } else {
        $CPAN::Config->{urllist} ||= [];
        while (! @{$CPAN::Config->{urllist}}) {
-           print qq{
+           my($input) = prompt(qq{
 We need to know the URL of your favorite CPAN site.
-Please enter it here: };
-           chop($_ = <>);
-           s/\s//g;
-           push @{$CPAN::Config->{urllist}}, $_ if $_;
+Please enter it here:});
+           $input =~ s/\s//g;
+           next unless $input;
+           my($wanted) = "MIRRORED.BY";
+           print qq{
+Testing "$input" ...
+};
+           push @{$CPAN::Config->{urllist}}, $input;
+           CPAN::FTP->localize($wanted,$local,"force");
+           if (-s $local) {
+               print qq{
+"$input" seems to work
+};
+           } else {
+               my $ans = prompt(qq{$input doesn\'t seem to work. Keep it in the list?},"n");
+               last unless $ans =~ /^n/i;
+               pop @{$CPAN::Config->{urllist}};
+           }
        }
     }
 
     print qq{
 
+WAIT support is available as a Plugin. You need the CPAN::WAIT module
+to actually use it.  But we need to know your favorite WAIT server. If
+you don\'t know a WAIT server near you, just press ENTER.
+
+};
+
+    $default = "wait://ls6.informatik.uni-dortmund.de:1404";
+    $ans = prompt("Your favorite WAIT server?\n  ",$default);
+    push @{$CPAN::Config->{'wait_list'}}, $ans;
+
+    print qq{
+
 If you\'re accessing the net via proxies, you can specify them in the
 CPAN configuration or via environment variables. The variable in
 the \$CPAN::Config takes precedence.
@@ -240,8 +279,9 @@ sub find_exe {
 sub read_mirrored_by {
     my($local) = @_;
     my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
-    open FH, $local or die "Couldn't open $local: $!";
-    while (<FH>) {
+    my $fh = FileHandle->new;
+    $fh->open($local) or die "Couldn't open $local: $!";
+    while (<$fh>) {
        ($host) = /^([\w\.\-]+)/ unless defined $host;
        next unless defined $host;
        next unless /\s+dst_(dst|location)/;
@@ -254,6 +294,7 @@ sub read_mirrored_by {
        undef $host;
        $dst=$continent=$country="";
     }
+    $fh->close;
     $CPAN::Config->{urllist} ||= [];
     if ($expected_size = @{$CPAN::Config->{urllist}}) {
        for $url (@{$CPAN::Config->{urllist}}) {
@@ -286,12 +327,13 @@ file:, ftp: or http: URL, or "q" to finish selecting.
     while () {
        my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
        my(@valid,$previous_best);
-       open FH, $pipe;
+       my $fh = FileHandle->new;
+       $fh->open($pipe);
        {
            my($cont,$country,$url,$item);
            my(@cont) = sort keys %all;
            for $cont (@cont) {
-               print FH "    $cont\n";
+               $fh->print("    $cont\n");
                for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
                    for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
                        my $t = sprintf(
@@ -304,12 +346,11 @@ file:, ftp: or http: URL, or "q" to finish selecting.
                            $previous_best ||= $item;
                        }
                        push @valid, $all{$cont}{$country}{$url};
-                       print FH $t;
+                       $fh->print($t);
                    }
                }
            }
        }
-       close FH;
        $previous_best ||= 1;
        $default =
            @{$CPAN::Config->{urllist}} >= $expected_size ? "q" : $previous_best;