diff options
author | Karl Berry <karl@freefriends.org> | 2016-05-16 20:39:37 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2016-05-16 20:39:37 +0000 |
commit | 62cb8e2e5c8cf4533efd107473ab4caad5ad0aff (patch) | |
tree | a07a7345d3daa033bb454cf7227d1156eba5c3b2 /Build/source/texk/tests/TeXLive | |
parent | 10b890688b4c4cf33d2644957238c4e437fa8e7f (diff) |
sync
git-svn-id: svn://tug.org/texlive/trunk@41205 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests/TeXLive')
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLUtils.pm | 105 |
1 files changed, 68 insertions, 37 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm index 432011f09e0..ce56842e4ad 100644 --- a/Build/source/texk/tests/TeXLive/TLUtils.pm +++ b/Build/source/texk/tests/TeXLive/TLUtils.pm @@ -5,7 +5,7 @@ package TeXLive::TLUtils; -my $svnrev = '$Revision: 40652 $'; +my $svnrev = '$Revision: 41175 $'; my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown"; sub module_revision { return $_modulerevision; } @@ -31,8 +31,9 @@ C<TeXLive::TLUtils> -- utilities used in TeX Live infrastructure TeXLive::TLUtils::getenv($string); TeXLive::TLUtils::which($string); - TeXLive::TLUtils::get_system_tmpdir(); + TeXLive::TLUtils::initialize_global_tmpdir(); TeXLive::TLUtils::tl_tmpdir(); + TeXLive::TLUtils::tl_tmpfile(); TeXLive::TLUtils::xchdir($dir); TeXLive::TLUtils::wsystem($msg,@args); TeXLive::TLUtils::xsystem(@args); @@ -123,7 +124,7 @@ BEGIN { &unix &getenv &which - &get_system_tmpdir + &initialize_global_tmpdir &dirname &basename &dirname_and_basename @@ -190,6 +191,7 @@ BEGIN { use Cwd; use Getopt::Long; use File::Temp; +use File::Copy qw//; use TeXLive::TLConfig; @@ -453,20 +455,17 @@ sub which { return 0; } -=item C<get_system_tmpdir> +=item C<initialize_global_tmpdir();> -Evaluate the environment variables C<TMPDIR>, C<TMP>, and C<TEMP> in -order to find the system temporary directory. +Initializes a directory for all temporary files. This uses C<File::Temp> +and thus honors various env variables like C<TMPDIR>, C<TMP>, and C<TEMP>. =cut -sub get_system_tmpdir { - my $systmp=0; - $systmp||=getenv 'TMPDIR'; - $systmp||=getenv 'TMP'; - $systmp||=getenv 'TEMP'; - $systmp||='/tmp'; - return "$systmp"; +sub initialize_global_tmpdir { + $::tl_tmpdir = File::Temp::tempdir(CLEANUP => 1); + debug("tl_tempdir: creating global tempdir $::tl_tmpdir\n"); + return ($::tl_tmpdir); } =item C<tl_tmpdir> @@ -477,9 +476,28 @@ is terminated. =cut sub tl_tmpdir { - return (File::Temp::tempdir(CLEANUP => 1)); + initialize_global_tmpdir() if (!defined($::tl_tmpdir)); + my $tmp = File::Temp::tempdir(DIR => $::tl_tmpdir, CLEANUP => 1); + debug("tl_tempdir: creating tempdir $tmp\n"); + return ($tmp); } +=item C<tl_tmpfile> + +Create a temporary file which is removed when the program +is terminated. Returns file handle and file name. +Arguments are passed on to C<File::Temp::tempfile>. + +=cut + +sub tl_tmpfile { + initialize_global_tmpdir() if (!defined($::tl_tmpdir)); + my ($fh, $fn) = File::Temp::tempfile(@_, DIR => $::tl_tmpdir, UNLINK => 1); + debug("tl_tempfile: creating tempfile $fn\n"); + return ($fh, $fn); +} + + =item C<xchdir($dir)> C<chdir($dir)> or die. @@ -1337,9 +1355,10 @@ sub install_packages { foreach my $h (@::install_packages_hook) { &$h($n,$totalnr); } - # TODO TODO - # we do NOT check the return value!!! - $fromtlpdb->install_package($package, $totlpdb); + # return false if something went wrong + if (!$fromtlpdb->install_package($package, $totlpdb)) { + return 0; + } $donesize += $tlpsizes{$package}; } my $totaltime = time() - $starttime; @@ -1954,7 +1973,8 @@ not agree. If a check argument is not given, that check is not performed. sub check_file { my ($xzfile, $checksum, $checksize) = @_; - if ($checksum) { + # only run checksum tests if we can actually compute the checksum + if ($checksum && $::checksum_method) { my $tlchecksum = TeXLive::TLCrypto::tlchecksum($xzfile); if ($tlchecksum ne $checksum) { tlwarn("TLUtils::check_file: removing $xzfile, checksums differ:\n"); @@ -2042,7 +2062,9 @@ sub unpack { # if the file is now not present, we can use it if (! -r $xzfile) { # try download the file and put it into temp - download_file($what, $xzfile); + if (!download_file($what, $xzfile)) { + return(0, "downloading did not succeed"); + } # remove false downloads check_file($xzfile, $checksum, $size); if ( ! -r $xzfile ) { @@ -2365,6 +2387,13 @@ sub download_file { tlwarn ("download_file: Programs not set up, trying literal wget\n"); $wget = "wget"; } + # + # create output dir if necessary + my $par; + if ($dest ne "|") { + $par = dirname($dest); + mkdirhier ($par) unless -d "$par"; + } my $url; if ($relpath =~ m;^file://*(.*)$;) { my $filetoopen = "/$1"; @@ -2375,7 +2404,6 @@ sub download_file { # opening to a pipe always succeeds, so we return immediately return \*RETFH; } else { - my $par = dirname ($dest); if (-r $filetoopen) { copy ($filetoopen, $par); return 1; @@ -2625,7 +2653,7 @@ sub check_for_old_updmap_cfg { my $nn = "$oldupd.DISABLED"; if (-r $nn) { my $fh; - ($fh, $nn) = File::Temp::tempfile( + ($fh, $nn) = tl_tmpfile( "updmap.cfg.DISABLED.XXXXXX", DIR => "$tmfsysconf/web2c"); } print "Renaming old config file from @@ -2725,6 +2753,7 @@ sub _create_config_files { $tlpdblinesref, @postlines) = @_; my $root = $tlpdb->root; my @lines = (); + my $usermode = $tlpdb->setting( "usertree" ); if (-r "$root/$headfile") { # we might be in user mode and do *not* want that the generation # of the configuration file just boils out. @@ -2733,11 +2762,7 @@ sub _create_config_files { @lines = <INFILE>; close (INFILE); } else { - tlwarn("TLUtils::_create_config_files: $root/$headfile missing!\n"); - # TODO - # if we allow tlmgr generate to generate language.* file in usermode - # we need to remove the die here! - die ("Giving up."); + die ("Giving up.") if (!$usermode); } push @lines, @$tlpdblinesref; if (defined($localconf) && -r $localconf) { @@ -2753,17 +2778,19 @@ sub _create_config_files { if (@postlines) { push @lines, @postlines; } - if ($#lines >= 0) { - open(OUTFILE,">$dest") - or die("Cannot open $dest for writing: $!"); + if ($usermode && -e $dest) { + tlwarn("Updating $dest, backup copy in $dest.backup\n"); + File::Copy::copy($dest, "$dest.backup"); + } + open(OUTFILE,">$dest") + or die("Cannot open $dest for writing: $!"); - if (!$keepfirstline) { - print OUTFILE $cc; - printf OUTFILE " Generated by %s on %s\n", "$0", scalar localtime; - } - print OUTFILE @lines; - close(OUTFILE) || warn "close(>$dest) failed: $!"; + if (!$keepfirstline) { + print OUTFILE $cc; + printf OUTFILE " Generated by %s on %s\n", "$0", scalar localtime; } + print OUTFILE @lines; + close(OUTFILE) || warn "close(>$dest) failed: $!"; } sub parse_AddHyphen_line { @@ -3180,7 +3207,11 @@ Uses C<tlwarn> to issue a warning, then exits with exit code 1. sub tldie { tlwarn(@_); - exit(1); + if ($::gui_mode) { + Tk::exit(1); + } else { + exit(1); + } } =item C<debug_hash ($label, hash))> @@ -3610,7 +3641,7 @@ sub download_to_temp_or_file { my $url = shift; my ($url_fh, $url_file); if ($url =~ m,^(http|ftp|file)://,) { - ($url_fh, $url_file) = File::Temp::tempfile(UNLINK => 1); + ($url_fh, $url_file) = tl_tmpfile(); # now $url_fh filehandle is open, the file created # TLUtils::download_file will just overwrite what is there # on windows that doesn't work, so we close the fh immediately |