From: Robin Barker <RMBarker@cpan.org>
Date: Wed, 30 Jan 2002 11:58:33 +0000 (+0000)
Subject: Re: Perlbug - reminder of bug(20010713.003) status
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c076f9f64d593fdf61a5436c0f8265f5dd64b488;p=p5sagit%2Fp5-mst-13.2.git

Re: Perlbug - reminder of bug(20010713.003) status
Message-Id: <200201301158.LAA14883@tempest.npl.co.uk>

p4raw-id: //depot/perl@14502
---

diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index cde8389..1ec2733 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -1095,6 +1095,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 +1155,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.});
 	    }