X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCPAN%2FTarzip.pm;h=88e8ef505f2be2808f1825cee8a5daeec1de93bc;hb=917f17002097ee577163787c18abe1a911b23f4e;hp=2d530547c4226f16afbfdd09099aef061a53d32d;hpb=e82b93481bc82235f35444c372503cc96abe405b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm
index 2d53054..88e8ef5 100644
--- a/lib/CPAN/Tarzip.pm
+++ b/lib/CPAN/Tarzip.pm
@@ -3,17 +3,22 @@ package CPAN::Tarzip;
 use strict;
 use vars qw($VERSION @ISA $BUGHUNTING);
 use CPAN::Debug;
-$VERSION = sprintf "%.2f", substr(q$Rev: 281 $,4)/100;
+use File::Basename ();
+$VERSION = sprintf "%.6f", substr(q$Rev: 1717 $,4)/1000000 + 5.4;
 # module is internal to CPAN.pm
 
 @ISA = qw(CPAN::Debug);
-$BUGHUNTING = 0; # released code must have turned off
+$BUGHUNTING ||= 0; # released code must have turned off
 
 # it's ok if file doesn't exist, it just matters if it is .gz or .bz2
 sub new {
   my($class,$file) = @_;
-  die "new called without arg" unless defined $file;
-  die "file[$file] doesn't match /\\.(bz2|gz|zip)\$/" unless $file =~ /\.(bz2|gz|zip)$/i;
+  $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
+  if (0) {
+    # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
+    $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
+        unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
+  }
   my $me = { FILE => $file };
   if (0) {
   } elsif ($file =~ /\.bz2$/i) {
@@ -23,7 +28,7 @@ sub new {
         $bzip2 = File::Which::which("bzip2");
       }
       if ($bzip2) {
-        $me->{UNGZIPPRG} = $bzip2;
+        $me->{UNGZIPPRG} = $bzip2 || "bzip2";
       } else {
         $CPAN::Frontend->mydie(qq{
 CPAN.pm needs the external program bzip2 in order to handle '$file'.
@@ -34,7 +39,7 @@ program.
     }
   } else {
     # yes, we let gzip figure it out in *any* other case
-    $me->{UNGZIPPRG} = $CPAN::Config->{gzip};
+    $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
   }
   bless $me, $class;
 }
@@ -55,7 +60,8 @@ sub gzip {
     $fhw->close;
     return 1;
   } else {
-    system("$self->{UNGZIPPRG} -c $read > $write")==0;
+    my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+    system(qq{$command -c "$read" > "$write"})==0;
   }
 }
 
@@ -77,14 +83,18 @@ sub gunzip {
     $fhw->close;
     return 1;
   } else {
-    system("$self->{UNGZIPPRG} -dc $read > $write")==0;
+    my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+    system(qq{$command -dc "$read" > "$write"})==0;
   }
 }
 
 
 sub gtest {
   my($self) = @_;
+  return $self->{GTEST} if exists $self->{GTEST};
+  defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
   my $read = $self->{FILE};
+  my $success;
   # After I had reread the documentation in zlib.h, I discovered that
   # uncompressed files do not lead to an gzerror (anymore?).
   if ( $CPAN::META->has_inst("Compress::Zlib") ) {
@@ -99,17 +109,18 @@ sub gtest {
         $buffer = "";
     }
     my $err = $gz->gzerror;
-    my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
+    $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
     if ($len == -s $read){
         $success = 0;
         CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
     }
     $gz->gzclose();
     CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
-    return $success;
   } else {
-      return system("$self->{UNGZIPPRG} -dt $read")==0;
+    my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+    $success = 0==system(qq{$command -qdt "$read"});
   }
+  return $self->{GTEST} = $success;
 }
 
 
@@ -117,17 +128,28 @@ sub TIEHANDLE {
   my($class,$file) = @_;
   my $ret;
   $class->debug("file[$file]");
-  if ($CPAN::META->has_inst("Compress::Zlib")) {
+  my $self = $class->new($file);
+  if (0) {
+  } elsif (!$self->gtest) {
+    my $fh = FileHandle->new($file)
+        or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
+    binmode $fh;
+    $self->{FH} = $fh;
+    $class->debug("via uncompressed FH");
+  } elsif ($CPAN::META->has_inst("Compress::Zlib")) {
     my $gz = Compress::Zlib::gzopen($file,"rb") or
-	die "Could not gzopen $file";
-    $ret = bless {GZ => $gz}, $class;
+	$CPAN::Frontend->mydie("Could not gzopen $file");
+    $self->{GZ} = $gz;
+    $class->debug("via Compress::Zlib");
   } else {
-    my $pipe = "$CPAN::Config->{gzip} -dc $file |";
-    my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!";
+    my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+    my $pipe = "$gzip -dc $file |";
+    my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
     binmode $fh;
-    $ret = bless {FH => $fh}, $class;
+    $self->{FH} = $fh;
+    $class->debug("via external gzip");
   }
-  $ret;
+  $self;
 }
 
 
@@ -148,7 +170,7 @@ sub READLINE {
 
 sub READ {
   my($self,$ref,$length,$offset) = @_;
-  die "read with offset not implemented" if defined $offset;
+  $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
   if (exists $self->{GZ}) {
     my $gz = $self->{GZ};
     my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
@@ -184,18 +206,13 @@ sub untar {
     $prefer=2;
   } elsif (MM->maybe_command($self->{UNGZIPPRG})
            &&
-           MM->maybe_command($CPAN::Config->{'tar'})) {
+           MM->maybe_command($CPAN::Config->{tar})) {
     # should be default until Archive::Tar handles bzip2
     $prefer = 1;
   } elsif (
-           $CPAN::META->has_inst("Archive::Tar")
+           $CPAN::META->has_usable("Archive::Tar")
            &&
            $CPAN::META->has_inst("Compress::Zlib") ) {
-    if ($file =~ /\.bz2$/) {
-      $CPAN::Frontend->mydie(qq{
-Archive::Tar lacks support for bz2. Can't continue.
-});
-    }
     $prefer = 2;
   } else {
     $CPAN::Frontend->mydie(qq{
@@ -206,25 +223,29 @@ installed. Can't continue.
   if ($prefer==1) { # 1 => external gzip+tar
     my($system);
     my $is_compressed = $self->gtest();
+    my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
     if ($is_compressed) {
-      $system = "$self->{UNGZIPPRG} -dc " .
-          "< $file | $CPAN::Config->{tar} xvf -";
+      my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+      $system = qq{$command -dc }.
+          qq{< "$file" | $tarcommand xvf -};
     } else {
-      $system = "$CPAN::Config->{tar} xvf $file";
+      $system = qq{$tarcommand xvf "$file"};
     }
     if (system($system) != 0) {
       # people find the most curious tar binaries that cannot handle
       # pipes
       if ($is_compressed) {
         (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
-        if (CPAN::Tarzip->gunzip($file, $ungzf)) {
+        $ungzf = File::Basename::basename($ungzf);
+        my $ct = CPAN::Tarzip->new($file);
+        if ($ct->gunzip($ungzf)) {
           $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
         } else {
           $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
         }
         $file = $ungzf;
       }
-      $system = "$CPAN::Config->{tar} xvf $file";
+      $system = qq{$tarcommand xvf "$file"};
       $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
       if (system($system)==0) {
         $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
@@ -236,6 +257,9 @@ installed. Can't continue.
       return 1;
     }
   } elsif ($prefer==2) { # 2 => modules
+    unless ($CPAN::META->has_usable("Archive::Tar")) {
+      $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
+    }
     my $tar = Archive::Tar->new($file,1);
     my $af; # archive file
     my @af;
@@ -265,7 +289,8 @@ installed. Can't continue.
         push @af, $af;
         return if $CPAN::Signal;
       }
-      $tar->extract(@af);
+      $tar->extract(@af) or
+          $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
     }
 
     Mac::BuildTools::convert_files([$tar->list_files], 1)
@@ -283,7 +308,8 @@ sub unzip {
     my $zip = Archive::Zip->new();
     my $status;
     $status = $zip->read($file);
-    die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
+    $CPAN::Frontend->mydie("Read of file[$file] failed\n")
+        if $status != Archive::Zip::AZ_OK();
     $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
     my @members = $zip->members();
     for my $member ( @members ) {
@@ -294,7 +320,7 @@ sub unzip {
       }
       $status = $member->extractToFileNamed( $af );
       $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
-      die "Extracting of file[$af] from zipfile[$file] failed\n" if
+      $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
           $status != Archive::Zip::AZ_OK();
       return if $CPAN::Signal;
     }
@@ -309,3 +335,11 @@ sub unzip {
 
 1;
 
+__END__
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut