--- ./lib/CPAN.pm-pre	Thu Jul 31 13:56:22 2003
+++ ./lib/CPAN.pm	Tue Oct  7 00:00:46 2003
@@ -1,6 +1,7 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.76';
+$VERSION = '1.76_01';
+$VERSION = eval $VERSION;
 # $Id: CPAN.pm,v 1.412 2003/07/31 14:53:04 k Exp $
 
 # only used during development:
@@ -259,7 +260,7 @@ package CPAN::Complete;
 ) unless @CPAN::Complete::COMMANDS;
 
 package CPAN::Index;
-use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03);
+use vars qw($LAST_TIME $DATE_OF_02 $DATE_OF_03 $BUILD_DIRS);
 @CPAN::Index::ISA = qw(CPAN::Debug);
 $LAST_TIME ||= 0;
 $DATE_OF_03 ||= 0;
@@ -807,6 +808,10 @@ sub cleanup {
 	  $subroutine eq '(eval)';
   }
   return if $ineval && !$End;
+  if ($CPAN::Index::BUILD_DIRS and $CPAN::Index::BUILD_DIRS->{'*new*'}) {
+    CPAN::Index->write_metadata_cache();
+    $CPAN::Frontend->mywarn("List of tested dirs updated.\n");
+  }
   return unless defined $META->{LOCK};
   return unless -f $META->{LOCK};
   $META->savehist;
@@ -842,8 +847,9 @@ sub savehist {
     close $fh;
 }
 
+# Actually, this means: tested, but not installed...
 sub is_tested {
-    my($self,$what) = @_;
+    my($self,$what,) = @_;
     $self->{is_tested}{$what} = 1;
 }
 
@@ -860,8 +866,14 @@ sub set_perl5lib {
     $env = $ENV{PERLLIB} unless defined $env;
     my @env;
     push @env, $env if defined $env and length $env;
-    my @dirs = map {("$_/blib/arch", "$_/blib/lib")} keys %{$self->{is_tested}};
-    $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
+    my @dirs = map {("$_/blib/arch", "$_/blib/lib")} sort keys %{$self->{is_tested}};
+    if (@dirs < 15) {
+       $CPAN::Frontend->myprint("Prepending @dirs to PERL5LIB.\n");
+    } else {
+       my @d = map {s/^\Q$CPAN::Config->{'build_dir'}/%BUILDDIR%/; $_ }
+	 sort keys %{$self->{is_tested}};
+       $CPAN::Frontend->myprint("Prepending blib/arch and blib/lib subdirs of @d to PERL5LIB; %BUILDDIR%=$CPAN::Config->{'build_dir'}.\n");
+    }
     $ENV{PERL5LIB} = join $Config::Config{path_sep}, @dirs, @env;
 }
 
@@ -1285,7 +1297,7 @@ sub missing_config_data {
          "pager",
          "makepl_arg", "make_arg", "make_install_arg", "urllist",
          "inhibit_startup_message", "ftp_proxy", "http_proxy", "no_proxy",
-         "prerequisites_policy",
+         "prerequisites_policy", "expire_old_builds",
          "cache_metadata",
         ) {
 	push @miss, $_ unless defined $CPAN::Config->{$_};
@@ -1493,13 +1505,14 @@ sub o {
 	    $CPAN::Frontend->myprint(":\n");
 	    for $k (sort keys %CPAN::Config::can) {
 		$v = $CPAN::Config::can{$k};
-		$CPAN::Frontend->myprint(sprintf "    %-18s %s\n", $k, $v);
+		# use distinctive whitespace to make the commands stand out
+		$CPAN::Frontend->myprint(sprintf "      %-10s %s\n", $k, $v);
 	    }
 	    $CPAN::Frontend->myprint("\n");
 	    for $k (sort keys %$CPAN::Config) {
                 CPAN::Config->prettyprint($k);
 	    }
-	    $CPAN::Frontend->myprint("\n");
+	    # $CPAN::Frontend->myprint("\n");	# Why second empty line?
 	} elsif (!CPAN::Config->edit(@o_what)) {
 	    $CPAN::Frontend->myprint(qq{Type 'o conf' to view configuration }.
                                      qq{edit options\n\n});
@@ -2187,7 +2200,7 @@ sub get_basic_credentials {
     return unless $proxy;
     if ($USER && $PASSWD) {
     } elsif (defined $CPAN::Config->{proxy_user} &&
-        defined $CPAN::Config->{proxy_pass}) {
+             defined $CPAN::Config->{proxy_pass}) {
         $USER = $CPAN::Config->{proxy_user};
         $PASSWD = $CPAN::Config->{proxy_pass};
     } else {
@@ -2212,6 +2225,21 @@ sub get_basic_credentials {
     return($USER,$PASSWD);
 }
 
+# mirror(): Its purpose is to deal with proxy authentication. When we
+# call SUPER::mirror, we relly call the mirror method in
+# LWP::UserAgent. LWP::UserAgent will then call
+# $self->get_basic_credentials or some equivalent and this will be
+# $self->dispatched to our own get_basic_credentials method.
+
+# Our own get_basic_credentials sets $USER and $PASSWD, two globals.
+
+# 407 stands for HTTP_PROXY_AUTHENTICATION_REQUIRED. Which means
+# although we have gone through our get_basic_credentials, the proxy
+# server refuses to connect. This could be a case where the username or
+# password has changed in the meantime, so I'm trying once again without
+# $USER and $PASSWD to give the get_basic_credentials routine another
+# chance to set $USER and $PASSWD.
+
 sub mirror {
     my($self,$url,$aslocal) = @_;
     my $result = $self->SUPER::mirror($url,$aslocal);
@@ -3411,6 +3439,11 @@ sub write_metadata_cache {
     $cache->{last_time} = $LAST_TIME;
     $cache->{DATE_OF_02} = $DATE_OF_02;
     $cache->{PROTOCOL} = PROTOCOL;
+    if ($BUILD_DIRS) {
+	$cache->{'CPAN-sitearchexp'} = $Config::Config{sitearchexp};
+	delete $CPAN::Index::BUILD_DIRS->{'*new*'};
+        $cache->{'CPAN-tested-dirs'} = $BUILD_DIRS;
+    }
     $CPAN::Frontend->myprint("Going to write $metadata_file\n");
     eval { Storable::nstore($cache, $metadata_file) };
     $CPAN::Frontend->mywarn($@) if $@; # ?? missing "\n" after $@ in mywarn ??
@@ -3471,6 +3504,12 @@ sub read_metadata_cache {
                             # does initialize to some protocol
     $LAST_TIME = $cache->{last_time};
     $DATE_OF_02 = $cache->{DATE_OF_02};
+    # Do not trust build directories of different version of Perl:
+    delete $cache->{'CPAN-tested-dirs'}
+	if exists $cache->{'CPAN-sitearchexp'}
+	    and $cache->{'CPAN-sitearchexp'} ne $Config::Config{sitearchexp};
+    $BUILD_DIRS = $cache->{'CPAN-tested-dirs'}
+	if exists $cache->{'CPAN-tested-dirs'};
     $CPAN::Frontend->myprint("  Database was generated on $DATE_OF_02\n")
 	if defined $DATE_OF_02; # An old cache may not contain DATE_OF_02
     return;
@@ -3832,6 +3871,53 @@ sub safe_chdir {
     }
 }
 
+#-> sub CPAN::Distribution::patch ;
+sub patch {
+    my ($self, $name) = (@_);
+    return unless chdir $self->{build_dir};
+    my $dir = File::Spec->catdir($CPAN::Config->{'cpan_home'}, 'patches');
+    return unless -d $dir;
+    my $file = File::Spec->catfile($dir, "diff_$name");
+    my $gzip;
+    unless (-r $file) {
+	$gzip = $CPAN::Config->{gzip};
+	$file = File::Spec->catfile($dir, "diff_$name.gz");
+	unless (-r $file and $gzip) {
+	    $gzip = $CPAN::Config->{bzip2} || 'bzip2';
+	    $file = File::Spec->catfile($dir, "diff_$name.bz2");
+	    return unless -r $file;
+	}
+    }
+    $CPAN::Frontend->myprint("Found patch in `$file'");
+    my $patch = $Config::Config{gnupatch} || 'patch';
+    my $cmd = "$patch -p1";
+    if ($gzip) {
+	$cmd = "$gzip -dc $file | $cmd";
+    } else {
+	$cmd .= " <$file";
+    }
+    local *PATCH;
+    open PATCH, "$cmd |"
+      or $CPAN::Frontend->myprint("can't open pipe from `$cmd': $!") and return;
+    local *PATCHOUT;
+    my $out = 'cpan.patching';
+    open PATCHOUT, ">$out"
+      or $CPAN::Frontend->myprint("can't open $out: $!") and return;
+    my $old = select PATCHOUT;
+    $| = 1;
+    select $old;
+    while (<PATCH>) {
+	print PATCHOUT $_;
+	chomp;
+	$CPAN::Frontend->myprint($_);		# What to do if interactive?
+    }
+    close PATCHOUT
+      or $CPAN::Frontend->myprint("can't close $out: $!");
+    close PATCH
+      or $CPAN::Frontend->myprint("errors running `$cmd': rc=$?") and return;
+    $CPAN::Frontend->myprint("Patching from `$file' successful");
+}
+
 #-> sub CPAN::Distribution::get ;
 sub get {
     my($self) = @_;
@@ -3946,6 +4032,7 @@ sub get {
         my $pragmatic_dir = $userid . '000';
         $pragmatic_dir =~ s/\W_//g;
         $pragmatic_dir++ while -d "../$pragmatic_dir";
+	$distdir = $pragmatic_dir;
         $packagedir = File::Spec->catdir($builddir,$pragmatic_dir);
         $self->debug("packagedir[$packagedir]") if $CPAN::DEBUG;
         File::Path::mkpath($packagedir);
@@ -4023,6 +4110,8 @@ WriteMakefile(NAME => q[$cf]);
             $fh->close;
         }
     }
+    $self->patch($distdir);
+    $self->safe_chdir($builddir);	# Back after patching
 
     return $self;
 }
@@ -4492,6 +4581,8 @@ or
 	local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
 	my($ret,$pid);
 	$@ = "";
+	local $ENV{PERL5LIB} = $ENV{PERL5LIB} || $ENV{PERLLIB} || "";
+	$CPAN::META->set_perl5lib;
 	if ($CPAN::Config->{inactivity_timeout}) {
 	    eval {
 		alarm $CPAN::Config->{inactivity_timeout};
@@ -4543,10 +4634,12 @@ or
       delete $self->{force_update};
       return;
     }
-    if (my @prereq = $self->unsat_prereq){
+    if (my @prereq = $self->unsat_prereq('make')){
       return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
     }
     $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
+    local $ENV{PERL5LIB} = $ENV{PERL5LIB} || $ENV{PERLLIB} || "";
+    $CPAN::META->set_perl5lib;
     if (system($system) == 0) {
 	 $CPAN::Frontend->myprint("  $system -- OK\n");
 	 $self->{'make'} = "YES";
@@ -4595,13 +4688,14 @@ of modules we are processing right now?"
 
 #-> sub CPAN::Distribution::unsat_prereq ;
 sub unsat_prereq {
-    my($self) = @_;
+    my($self, $for) = @_;
     my $prereq_pm = $self->prereq_pm or return;
     my(@need);
   NEED: while (my($need_module, $need_version) = each %$prereq_pm) {
         my $nmo = $CPAN::META->instance("CPAN::Module",$need_module);
         # we were too demanding:
         next if $nmo->uptodate;
+        next if $nmo->tested_ok and $for ne 'install';
 
         # if they have not specified a version, we accept any installed one
         if (not defined $need_version or
@@ -4682,16 +4776,101 @@ sub prereq_pm {
   return $self->{prereq_pm} = \%p;
 }
 
+#-> sub CPAN::Distribution::persistent_key ;
+sub persistent_key {	# Identify "sameness" of the Perl
+  my @keys = ($Config::Config{sitearchexp}, $^X);
+  push @keys, (-f $^X ? (stat(_))[9] : '--');	# mtime
+  my $dll = eval {OS2::DLLname()};
+  if (defined $dll) {
+    push @keys, $dll;
+    push @keys, (-f $dll ? (stat(_))[9] : '--');	# mtime
+  }
+  join "\n", @keys, '';
+}
+
+#-> sub CPAN::Distribution::persistent_tested_ok ;
+sub persistent_tested_ok {
+  my($self) = @_;
+  return unless $CPAN::Index::BUILD_DIRS and $CPAN::Config->{expire_old_builds};
+  my $dir = $CPAN::Index::BUILD_DIRS->{$self->id};
+  return unless $dir and -d $dir;
+  my $cpan_test_ok = File::Spec->catfile($dir, '.cpantok');
+  return unless -f $cpan_test_ok;
+  return if $CPAN::Config->{expire_old_builds} > 0
+	    and -M $cpan_test_ok > $CPAN::Config->{expire_old_builds};
+  local *T;
+  open T, $cpan_test_ok and <T> eq $self->persisten_key and close T
+    or return;
+  my $date = -M $cpan_test_ok;
+  eval { File::Find::find sub {
+	  -M $_ >= $date
+	    or warn("File `$File::Find::name' newer than $cpan_test_ok: "
+		    . (-M _) . " days vs. $date days\n"),
+	       die 'update'
+	}, $dir ; 1} and return $dir;
+  warn "error scanning $dir: $@" unless $@ =~ /^update\b/;
+  return;
+}
+
+#-> sub CPAN::Distribution::mark_persistent_tested_ok ;
+sub mark_persistent_tested_ok {
+  my($self) = @_;
+  my $dir = $self->{build_dir};
+  return unless -d $dir;
+  my $cpan_test_ok = File::Spec->catfile($dir, '.cpantok');
+  local *T;
+  open T, "> $cpan_test_ok" or warn("error touching $cpan_test_ok: $!\n"), return;
+  print T $self->persisten_key;		# Something very build-specific
+  close T or warn("error touching $cpan_test_ok: $!\n"), return;
+  $CPAN::Index::BUILD_DIRS ||= {};
+  $CPAN::Index::BUILD_DIRS->{'*new*'} ||= 0;
+  $CPAN::Index::BUILD_DIRS->{'*new*'}++
+    unless exists $CPAN::Index::BUILD_DIRS->{$self->id}
+      and $CPAN::Index::BUILD_DIRS->{$self->id} eq $dir;
+  $CPAN::Index::BUILD_DIRS->{$self->id} = $dir;
+  return 1;
+}
+
+#-> sub CPAN::Distribution::tested_ok ;
+sub tested_ok {
+    my($self) = @_;
+    exists $self->{'make_test'} and $self->{'make_test'} ne 'NO'
+}
+
+#-> sub CPAN::Distribution::mark_tested_ok ;
+sub mark_tested_ok {
+    my($self) = @_;
+    $self->{make} = "YES";
+    $self->{make_test} = "YES";
+    my $c;
+    foreach $c ($self->containsmods) {
+        my $obj = CPAN::Shell->expandany($c);
+        $obj->mark_tested_ok();
+    }
+}
+
 #-> sub CPAN::Distribution::test ;
 sub test {
-    my($self) = @_;
+    my($self, $for) = @_;
+    my $tested_dir = $self->persistent_tested_ok;
+    if ($tested_dir and not $self->{'force_update'}) {
+	 $self->{'build_dir'} = $tested_dir;
+	 $CPAN::Frontend->myprint("Skipping test for " . $self->id . ": test was successful in $tested_dir\n");
+	 $CPAN::META->is_tested($self->{'build_dir'});
+	 $self->mark_tested_ok();
+	 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;
+	 return;
+    }
     $self->make;
     if ($CPAN::Signal){
       delete $self->{force_update};
       return;
     }
     $CPAN::Frontend->myprint("Running make test\n");
-    if (my @prereq = $self->unsat_prereq){
+    if (my @prereq = $self->unsat_prereq($for or 'test')){
       return 1 if $self->follow_prereqs(@prereq); # signal success to the queuerunner
     }
   EXCUSE: {
@@ -4723,13 +4902,14 @@ sub test {
         return;
     }
 
-    local $ENV{PERL5LIB} = $ENV{PERL5LIB} || "";
+    local $ENV{PERL5LIB} = $ENV{PERL5LIB} || $ENV{PERLLIB} || "";
     $CPAN::META->set_perl5lib;
     my $system = join " ", $CPAN::Config->{'make'}, "test";
     if (system($system) == 0) {
 	 $CPAN::Frontend->myprint("  $system -- OK\n");
 	 $CPAN::META->is_tested($self->{'build_dir'});
-	 $self->{make_test} = "YES";
+	 $self->mark_tested_ok();
+	 $self->mark_persistent_tested_ok();
     } else {
 	 $self->{make_test} = "NO";
          $self->{badtestcnt}++;
@@ -4790,7 +4970,7 @@ make clean did not succeed, marking dire
 #-> sub CPAN::Distribution::install ;
 sub install {
     my($self) = @_;
-    $self->test;
+    $self->test('install');
     if ($CPAN::Signal){
       delete $self->{force_update};
       return;
@@ -5102,6 +5282,8 @@ explicitly a file $s.
         }
     }
 
+    $self->mark_tested_ok() if $meth eq "test" and not %fail;
+
     # recap with less noise
     if ( $meth eq "install" ) {
 	if (%fail) {
@@ -5175,6 +5357,19 @@ sub uptodate {
     return 1;
 }
 
+#-> sub CPAN::Bundle::mark_tested_ok ;
+sub mark_tested_ok {
+    my($self) = @_;
+    $self->{make_test_all} = "YES";
+}
+
+#-> sub CPAN::Module::tested_ok ;
+sub tested_ok {
+    my($self) = @_;
+    exists $self->{make_test_all} and $self->{make_test_all} eq "YES";
+}
+
+
 #-> sub CPAN::Bundle::readme ;
 sub readme  {
     my($self) = @_;
@@ -5427,7 +5622,7 @@ sub cpan_file {
                 }
                 return "Contact Author $fullname <$email>";
             } else {
-                return "UserID $userid";
+                return "Contact Author $userid (Email address not available)";
             }
         } else {
             return "N/A";
@@ -5522,6 +5717,16 @@ sub uptodate {
     }
     return;
 }
+#-> sub CPAN::Module::mark_tested_ok ;
+sub mark_tested_ok {
+    my($self) = @_;
+    $self->{make_test_dist} = "YES";
+}
+#-> sub CPAN::Module::tested_ok ;
+sub tested_ok {
+    my($self) = @_;
+    exists $self->{make_test_dist} and $self->{make_test_dist} eq "YES";
+}
 #-> sub CPAN::Module::install ;
 sub install {
     my($self) = @_;
@@ -6751,6 +6956,9 @@ defined:
   cpan_home          local directory reserved for this package
   dontload_hash      anonymous hash: modules in the keys will not be
                      loaded by the CPAN::has_inst() routine
+  expire_old_builds  Timeout in days; after this time the module is rebuild
+		     even if it was successfully build, and the build directory
+		     is still present.  -1 means 'never rebuild'.
   gzip		     location of external program gzip
   histfile           file to maintain history between sessions
   histsize           maximum number of lines to keep in histfile
