[PATCH] lib/CPAN.pm: Init $netrcfile, untar to work with cygnus tar

[p5pRT]

Migrated from rt.perl.org#862 (status was 'resolved')

Searchable as RT862$

[p5pRT]

From aichner@ecf.teradyne.com

  tar (GNU tar) 1.12
  Copyright (C) 1988, 92, 93, 94, 95, 96, 97 Free Software Foundation, Inc.
  This is free software; see the source for copying conditions. There is NO
  warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  Written by John Gilmore and Jay Fenlason.

  gzip 1.2.4 (18 Aug 93)
  Compilation options​:
  DIRENT UTIME STDC_HEADERS HAVE_UNISTD_H ASMV

untar fails with following error​:

//E/cygnus/cygwin-b20/H-i586-cygwin32/bin/tar.EXE​: Cannot execute remote shell​: No such file or directory
[main] E​:\cygnus\cygwin-b20\H-i586-cygwin32\bin\tar.EXE 1000 (0) handle_exceptions​: Exception​: STATUS_ACCESS_VIOLATION
[main] tar 1000 (0) handle_exceptions​: Dumping stack trace to tar.EXE.core
Couldn't untar D​:\Users\AichnerAd\.cpan\sources\authors\id\B\BB\BBIRTH\Win32-SerialPort-0.150.tar
cpan>

This is beacause Cygnus tar cannot handle DOS filenames including
drive letters.

So
tar xvf D​:\Users\AichnerAd\.cpan\sources\authors\id\B\BB\BBIRTH\Win32-SerialPort-0.150.tar
fails, while following would work​:

tar xvf //D/Users/AichnerAd/.cpan/sources/authors/id/B/BB/BBIRTH/Win32-SerialPort-0.150.tar

My proposed fix tries the gzip - tar pipe irregardless of OS and runs
commands separately if that fails.

Could someone please test this under MSwin32 with a tar uncapable of
piping?

Regards,

Adrian

1999-06-13 Adrian Aichner <aichner@​ecf.teradyne.com>

  * CPAN.pm (hosthardest)​: Initialize $netrcfile with $netrc->netrc.
  (untar)​: Attempt piping gzip output to tar irregardless of
  $OSNAME. Run commands separately in case of error.

Inline Patch

diff -u c:\perl\5.00557\lib\CPAN.pm.orig c:\perl\5.00557\lib\CPAN.pm
--- c:\perl\5.00557\lib\CPAN.pm.orig	Sun Jun 13 14:51:30 1999
+++ c:\perl\5.00557\lib\CPAN.pm	Sun Jun 13 14:51:30 1999
@@ -2241,12 +2241,12 @@
 	    next;
 	}
 	my($host,$dir,$getfile) = ($1,$2,$3);
-	my($netrcfile,$fh);
 	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($netrcfile) = $netrc->netrc;
 	my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
 	my $targetfile = File::Basename::basename($aslocal);
 	my(@dialog);
@@ -2259,7 +2259,7 @@
 	     "get $getfile $targetfile",
 	     "quit"
 	    );
-	if (! $netrc->netrc) {
+	if (! $netrcfile) {
 	    CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
 	} elsif ($netrc->hasdefault || $netrc->contains($host)) {
 	    CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
@@ -4261,47 +4261,48 @@
   if (MM->maybe_command($CPAN::Config->{'gzip'})
       &&
       MM->maybe_command($CPAN::Config->{'tar'})) {
-    if ($^O =~ /win/i) { # irgggh
-	# people find the most curious tar binaries that cannot handle
-	# pipes
-	my $system = "$CPAN::Config->{'gzip'} --decompress $file";
-	if (system($system)==0) {
-	    $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
-	} else {
-	    $CPAN::Frontend->mydie(
-				   qq{Couldn\'t uncompress $file\n}
-				  );
-	}
-	$file =~ s/\.gz$//;
-	$system = "$CPAN::Config->{tar} xvf $file";
-	if (system($system)==0) {
-	    $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
-	} else {
-	    $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
-	}
-	return 1;
+    my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
+      "< $file | $CPAN::Config->{tar} xvf -";
+    if (system($system) != 0) { # irgggh
+      # people find the most curious tar binaries that cannot handle
+      # pipes
+      my $system = "$CPAN::Config->{'gzip'} --decompress $file";
+      if (system($system)==0) {
+	$CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+      } else {
+	$CPAN::Frontend->mydie(
+			       qq{Couldn\'t uncompress $file\n}
+			      );
+      }
+      $file =~ s/\.gz$//;
+      $system = "$CPAN::Config->{tar} xvf $file";
+      $CPAN::Frontend->myprint(qq{USING TAR:$system:\n});
+      if (system($system)==0) {
+	$CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+      } else {
+	$CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+      }
+      return 1;
     } else {
-	my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
-	    "< $file | $CPAN::Config->{tar} xvf -";
-	return system($system) == 0;
+      return 1;
     }
   } elsif ($CPAN::META->has_inst("Archive::Tar")
-      &&
-      $CPAN::META->has_inst("Compress::Zlib") ) {
+	   &&
+	   $CPAN::META->has_inst("Compress::Zlib") ) {
     my $tar = Archive::Tar->new($file,1);
     $tar->extract($tar->list_files); # I'm pretty sure we have nothing
                                      # that isn't compressed
-
+    
     ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
-        if ($^O eq 'MacOS');
-
+      if ($^O eq 'MacOS');
+    
     return 1;
   } else {
     $CPAN::Frontend->mydie(qq{
-CPAN.pm needs either both external programs tar and gzip installed or
-both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
-is available. Can\'t continue.
-});
+      CPAN.pm needs either both external programs tar and gzip installed or
+	both the modules Archive::Tar and Compress::Zlib. Neither prerequisite
+	  is available. Can\'t continue.
+	});
   }
 }
 

-- 

  Adrian Aichner Teradyne GmbH, European Design Center
  Integra Test Division Telephone +49/89/41861(0)-208
  Dingolfinger Strasse 2 Fax +49/89/41861-217 (What is a Fax?)
  D-81673 MUENCHEN E-mail adrian.aichner@​teradyne.com