Upgrade to Tie::File 0.91, from mjd.

[p5sagit/p5-mst-13.2.git] / lib / CPAN.pm

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index cde8389..1196aba 100644 (file)
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1,6 +1,6 @@
 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
 package CPAN;
-$VERSION = '1.59_56';
+$VERSION = '1.59_57';
 # $Id: CPAN.pm,v 1.385 2001/02/09 21:37:57 k Exp $
 
 # only used during development:
@@ -22,6 +22,7 @@ use Safe ();
 use Text::ParseWords ();
 use Text::Wrap;
 use File::Spec;
+use Sys::Hostname;
 no lib "."; # we need to run chdir all over and we would get at wrong
             # libraries there
 
@@ -460,19 +461,33 @@ sub checklock {
     if (-f $lockfile && -M _ > 0) {
        my $fh = FileHandle->new($lockfile) or
             $CPAN::Frontend->mydie("Could not open $lockfile: $!");
-       my $other = <$fh>;
+       my $otherpid  = <$fh>;
+       my $otherhost = <$fh>;
        $fh->close;
-       if (defined $other && $other) {
-           chomp $other;
-           return if $$==$other; # should never happen
+       if (defined $otherpid && $otherpid) {
+           chomp $otherpid;
+        }
+       if (defined $otherhost && $otherhost) {
+           chomp $otherhost;
+       }
+       my $thishost  = hostname();
+       if (defined $otherhost && defined $thishost &&
+           $otherhost ne '' && $thishost ne '' &&
+           $otherhost ne $thishost) {
+            $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n".
+                                           "reports other host $otherhost and other process $otherpid.\n".
+                                           "Cannot proceed.\n"));
+       }
+       elsif (defined $otherpid && $otherpid) {
+           return if $$ == $otherpid; # should never happen
            $CPAN::Frontend->mywarn(
                                    qq{
-There seems to be running another CPAN process ($other). Contacting...
+There seems to be running another CPAN process (pid $otherpid).  Contacting...
 });
-           if (kill 0, $other) {
+           if (kill 0, $otherpid) {
                $CPAN::Frontend->mydie(qq{Other job is running.
 You may want to kill it and delete the lockfile, maybe. On UNIX try:
-    kill $other
+    kill $otherpid
     rm $lockfile
 });
            } elsif (-w $lockfile) {
@@ -492,9 +507,9 @@ You may want to kill it and delete the lockfile, maybe. On UNIX try:
                           );
            }
        } else {
-            $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile ".
+            $CPAN::Frontend->mydie(sprintf("CPAN.pm panic: Lockfile $lockfile\n".
                                            "reports other process with ID ".
-                                           "$other. Cannot proceed.\n"));
+                                           "$otherpid. Cannot proceed.\n"));
         }
     }
     my $dotcpan = $CPAN::Config->{cpan_home};
@@ -558,6 +573,7 @@ or
        $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
     }
     $fh->print($$, "\n");
+    $fh->print(hostname(), "\n");
     $self->{LOCK} = $lockfile;
     $fh->close;
     $SIG{TERM} = sub {
@@ -1095,6 +1111,36 @@ sub init {
     1;
 }
 
+# This is a piece of repeated code that is abstracted here for
+# maintainability.  RMB
+#
+sub _configpmtest {
+    my($configpmdir, $configpmtest) = @_; 
+    if (-w $configpmtest) {
+        return $configpmtest;
+    } elsif (-w $configpmdir) {
+        #_#_# following code dumped core on me with 5.003_11, a.k.
+        my $configpm_bak = "$configpmtest.bak";
+        unlink $configpm_bak if -f $configpm_bak;
+        if( -f $configpmtest ) {       
+            if( rename $configpmtest, $configpm_bak ) {  
+                $CPAN::Frontend->mywarn(<<END)
+Old configuration file $configpmtest
+    moved to $configpm_bak
+END
+           }
+       }       
+       my $fh = FileHandle->new;
+       if ($fh->open(">$configpmtest")) {
+           $fh->print("1;\n");
+           return $configpmtest;
+       } else {
+           # Should never happen
+           Carp::confess("Cannot open >$configpmtest");
+       }
+    } else { return } 
+}
+
 #-> sub CPAN::Config::load ;
 sub load {
     my($self) = shift;
@@ -1125,39 +1171,14 @@ sub load {
        my($configpmdir) = File::Spec->catdir($path_to_cpan,"CPAN");
        my($configpmtest) = File::Spec->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");
-               }
-           }
+           $configpm = _configpmtest($configpmdir,$configpmtest); 
        }
        unless ($configpm) {
            $configpmdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN");
            File::Path::mkpath($configpmdir);
            $configpmtest = File::Spec->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 {
+           $configpm = _configpmtest($configpmdir,$configpmtest); 
+           unless ($configpm) {
                Carp::confess(qq{WARNING: CPAN.pm is unable to }.
                              qq{create a configuration file.});
            }
@@ -2265,6 +2286,9 @@ sub localize {
     # where we did get a file from
     my(@reordered,$last);
     $CPAN::Config->{urllist} ||= [];
+    unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
+        warn "Malformed urllist; ignoring.  Configuration file corrupt?\n";
+    }
     $last = $#{$CPAN::Config->{urllist}};
     if ($force & 2) { # local cpans probably out of date, don't reorder
        @reordered = (0..$last);