use unified system_pipe for decompressing instead of repeating code

git-svn-id: svn://tug.org/texlive/trunk@47984 c570f23f-e606-0410-a88d-b1316a301751

3 files changed, 47 insertions, 36 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 0670a64c6f8..78cbe489323 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -99,7 +99,7 @@ use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
 use TeXLive::TLCrypto;
 use TeXLive::TLPOBJ;
 use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
-                        tlwarn basename download_file merge_into tldie);
+                        tlwarn basename download_file merge_into tldie system_pipe);
 use TeXLive::TLWinGoo;
 
 use Cwd 'abs_path';
@@ -316,11 +316,6 @@ sub from_file {
     ($tlpdbfh, $tlpdbfile) = TeXLive::TLUtils::tl_tmpfile();
     # same as above
     close($tlpdbfh);
-    my $tlpdbfile_quote = $tlpdbfile;
-    if (win32()) {
-      $tlpdbfile =~ s!/!\\!g;
-    }
-    $tlpdbfile_quote = "\"$tlpdbfile\"";
     # if we have xz available we try the xz file
     my $xz_succeeded = 0 ;
     my $compressorextension = "<UNSET>";
@@ -328,12 +323,7 @@ sub from_file {
       # we first try the xz compressed file
       my ($xzfh, $xzfile) = TeXLive::TLUtils::tl_tmpfile();
       close($xzfh);
-      my $xzfile_quote = $xzfile;
-      if (win32()) {
-        $xzfile  =~ s!/!\\!g;
-      }
-      $xzfile_quote = "\"$xzfile\"";
-      my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces($::progs{$DecompressorProgram{$DefaultCompressorFormat}});
+      my $decompressor = $::progs{$DecompressorProgram{$DefaultCompressorFormat}};
       $compressorextension = $CompressorExtension{$DefaultCompressorFormat};
       my @decompressorArgs = @{$DecompressorArgs{$DefaultCompressorFormat}};
       debug("trying to download $path.$compressorextension to $xzfile\n");
@@ -345,12 +335,10 @@ sub from_file {
         # xz *hopefully* returns 0 on success and anything else on failure
         # we don't have to negate since not zero means error in the shell
         # and thus in perl true
-        if (system("$decompressor @decompressorArgs <$xzfile_quote >$tlpdbfile_quote")) {
+        if (!system_pipe($decompressor, $xzfile, $tlpdbfile, 1, @decompressorArgs)) {
           debug("$decompressor $xzfile failed, trying plain file\n");
-          # to be sure we unlink the xz file and the tlpdbfile
-          unlink($xzfile);
+          unlink($xzfile); # the above command only removes in case of success
         } else {
-          unlink($xzfile);
           $xz_succeeded = 1;
           debug("found the uncompressed $DefaultCompressorFormat file\n");
         }
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index a0f3f10d675..32160a2c811 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -732,7 +732,11 @@ sub make_container {
   
     # compress it.
     if (-r "$destdir/$tarname") {
-      system($compressor, @compressorargs, "$destdir/$tarname");
+      # system return 0 on success
+      if (system($compressor, @compressorargs, "$destdir/$tarname")) {
+        tlwarn("$0: Couldn't compress $destdir/$tarname\n");
+        return (0,0, "");
+      }
     } else {
       tlwarn("$0: Couldn't find $destdir/$tarname to run $compressor\n");
       return (0, 0, "");
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 46ac201c031..da59eb99bdd 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -39,6 +39,7 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure
   TeXLive::TLUtils::wsystem($msg,@args);
   TeXLive::TLUtils::xsystem(@args);
   TeXLive::TLUtils::run_cmd($cmd);
+  TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @extraargs);
 
 =head2 File utilities
 
@@ -177,6 +178,7 @@ BEGIN {
     &wsystem
     &xsystem
     &run_cmd
+    &system_pipe
     &announce_execute_actions
     &add_symlinks
     &remove_symlinks
@@ -202,7 +204,7 @@ BEGIN {
   );
   @EXPORT = qw(setup_programs download_file process_logging_options
                tldie tlwarn info log debug ddebug dddebug debug_hash
-               win32 xchdir xsystem run_cmd sort_archs);
+               win32 xchdir xsystem run_cmd system_pipe sort_archs);
 }
 
 use Cwd;
@@ -623,6 +625,37 @@ sub run_cmd {
   return ($output,$retval);
 }
 
+=item C<system_pipe($prog, $infile, $outfile, $removeIn, @extraargs)>
+
+Runs C<$prog> with C<@extraargs> redirecting stdin from C<$infile>, stdout to C<$outfile>.
+Removes C<$infile> if C<$removeIn> is true.
+
+=cut
+
+sub system_pipe {
+  my ($prog, $infile, $outfile, $removeIn, @extraargs) = @_;
+  
+  my $progQuote = quotify_path_with_spaces($prog);
+  if (win32()) {
+    $infile =~ s!/!\\!g;
+    $outfile =~ s!/!\\!g;
+  }
+  my $infileQuote = "\"$infile\"";
+  my $outfileQuote = "\"$outfile\"";
+  debug("TLUtils::system_pipe: calling $progQuote @extraargs < $infileQuote > $outfileQuote\n");
+  my $retval = system("$progQuote @extraargs < $infileQuote > $outfileQuote");
+  if ($retval != 0) {
+    $retval /= 256 if $retval > 0;
+    debug("TLUtils::system_pipe: system exit code = $retval\n");
+    return 0;
+  } else {
+    if ($removeIn) {
+      debug("TLUtils::system_pipe: removing $infile\n");
+      unlink($infile);
+    }
+    return 1;
+  }
+}
 
 =back
 
@@ -2154,8 +2187,7 @@ sub unpack {
   }
 
   # only check the necessary compressor program
-  my $decompressor = TeXLive::TLUtils::quotify_path_with_spaces(
-                                        $::progs{$DecompressorProgram{$type}});
+  my $decompressor = $::progs{$DecompressorProgram{$type}};
   my @decompressorArgs = @{$DecompressorArgs{$type}};
   if (!defined($decompressor)) {
     return (0, "programs not set up properly");
@@ -2169,17 +2201,6 @@ sub unpack {
   my $containerfile = "$tempdir/$fn";
   my $tarfile = "$tempdir/$fn"; 
   $tarfile =~ s/\.$compressorextension$//;
-  my $containerfile_quote;
-  my $tarfile_quote;
-  my $target_quote;
-  if (win32()) {
-    $containerfile =~ s!/!\\!g;
-    $tarfile =~ s!/!\\!g;
-    $target =~ s!/!\\!g;
-  }
-  $containerfile_quote = "\"$containerfile\"";
-  $tarfile_quote = "\"$tarfile\"";
-  $target_quote = "\"$target\"";
   if ($what =~ m,^(https?|ftp)://, || $what =~ m!$SshURIRegex!) {
     # we are installing from the NET
     # check for the presence of $what in $tempdir
@@ -2210,14 +2231,12 @@ sub unpack {
     # we can remove it afterwards
     $remove_containerfile = 1;
   }
-  debug("decompressing $containerfile to $tarfile\n");
-  debug("calling $decompressor @decompressorArgs < $containerfile_quote > $tarfile_quote\n");
-  system("$decompressor @decompressorArgs < $containerfile_quote > $tarfile_quote");
-  if (! -f $tarfile) {
+  if (!system_pipe($decompressor, $containerfile, $tarfile, $remove_container, @decompressorArgs)
+      ||
+      ! -f $tarfile) {
     unlink($tarfile, $containerfile);
     return(0, "Decompressing $containerfile failed");
   }
-  unlink($containerfile) if $remove_containerfile;
   if (untar($tarfile, $target, 1)) {
     return (1, "$pkg");
   } else {