texlive[47984] Master/tlpkg/TeXLive: use unified system_pipe for
commits+preining at tug.org
commits+preining at tug.org
Mon Jun 11 08:32:20 CEST 2018
Revision: 47984
http://tug.org/svn/texlive?view=revision&revision=47984
Author: preining
Date: 2018-06-11 08:32:20 +0200 (Mon, 11 Jun 2018)
Log Message:
-----------
use unified system_pipe for decompressing instead of repeating code
Modified Paths:
--------------
trunk/Master/tlpkg/TeXLive/TLPDB.pm
trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
trunk/Master/tlpkg/TeXLive/TLUtils.pm
Modified: trunk/Master/tlpkg/TeXLive/TLPDB.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPDB.pm 2018-06-11 06:26:38 UTC (rev 47983)
+++ trunk/Master/tlpkg/TeXLive/TLPDB.pm 2018-06-11 06:32:20 UTC (rev 47984)
@@ -99,7 +99,7 @@
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 @@
($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 @@
# 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 @@
# 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");
}
Modified: trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPOBJ.pm 2018-06-11 06:26:38 UTC (rev 47983)
+++ trunk/Master/tlpkg/TeXLive/TLPOBJ.pm 2018-06-11 06:32:20 UTC (rev 47984)
@@ -732,7 +732,11 @@
# 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, "");
Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm 2018-06-11 06:26:38 UTC (rev 47983)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm 2018-06-11 06:32:20 UTC (rev 47984)
@@ -39,6 +39,7 @@
TeXLive::TLUtils::wsystem($msg, at 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 @@
&wsystem
&xsystem
&run_cmd
+ &system_pipe
&announce_execute_actions
&add_symlinks
&remove_symlinks
@@ -202,7 +204,7 @@
);
@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,7 +625,38 @@
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
=head2 File utilities
@@ -2154,8 +2187,7 @@
}
# 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 @@
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 @@
# 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 {
More information about the tex-live-commits
mailing list