diff options
author | Karl Berry <karl@freefriends.org> | 2012-05-09 23:18:12 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-05-09 23:18:12 +0000 |
commit | 2f8c6309e19b381472b270ff46fa23b398deafa8 (patch) | |
tree | dbef9716cd42df562e5116c104a04368f91f2940 /Build/source/texk/tests/TeXLive | |
parent | 91397bcb895499b56c6ab774fbac72ea56bdfa99 (diff) |
update check dates on imported programs, consistency
git-svn-id: svn://tug.org/texlive/trunk@26277 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/tests/TeXLive')
-rw-r--r-- | Build/source/texk/tests/TeXLive/TLUtils.pm | 125 |
1 files changed, 123 insertions, 2 deletions
diff --git a/Build/source/texk/tests/TeXLive/TLUtils.pm b/Build/source/texk/tests/TeXLive/TLUtils.pm index d204192d636..f88a2ab8212 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: 25907 $'; +my $svnrev = '$Revision: 26100 $'; my $_modulerevision; if ($svnrev =~ m/: ([0-9]+) /) { $_modulerevision = $1; @@ -100,6 +100,7 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure TeXLive::TLUtils::compare_tlpobjs($tlpA, $tlpB); TeXLive::TLUtils::compare_tlpdbs($tlpdbA, $tlpdbB); TeXLive::TLUtils::report_tlpdb_differences(\%ret); + TeXLive::TLUtils::tlnet_disabled_packages($root); TeXLive::TLUtils::mktexupd(); =head1 DESCRIPTION @@ -163,6 +164,7 @@ BEGIN { &forward_slashify &conv_to_w32_path &untar + &unpack &merge_into &give_ctan_mirror &give_ctan_mirror_base @@ -2071,12 +2073,112 @@ sub w32_remove_from_path { TeXLive::TLWinGoo::adjust_reg_path_for_texlive('remove', $bindir, $mode); } +=pod + +=item C<unpack($what, $targetdir> + +If necessary, downloads C$what>, and then unpacks it into C<$targetdir>. +Returns the name of the unpacked package (determined from the name of C<$what>) +in case of success, otherwise undefined. + +=cut + +sub unpack { + my ($what, $target) = @_; + + if (!defined($what)) { + tlwarn("TLUtils::unpack: nothing to unpack!\n"); + return; + } + + # we assume that $::progs has been set up! + my $wget = $::progs{'wget'}; + my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'}); + if (!defined($wget) || !defined($xzdec)) { + tlwarn("_install_package: programs not set up properly, strange.\n"); + return; + } + + my $type; + if ($what =~ m,\.tar(\.xz)?$,) { + $type = defined($what) ? "xz" : "tar"; + } else { + tlwarn("TLUtils::unpack: don't know how to unpack this: $what\n"); + return; + } + + my $tempdir = tl_tmpdir(); + + # we are still here, so something was handed in and we have either .tar or .tar.xz + my $fn = basename($what); + my $pkg = $fn; + $pkg =~ s/\.tar(\.xz)?$//; + my $tarfile; + my $remove_tarfile = 1; + if ($type eq "xz") { + my $xzfile = "$tempdir/$fn"; + $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; + my $xzfile_quote = $xzfile; + my $tarfile_quote = $tarfile; + my $target_quote = $target; + if (win32()) { + $xzfile =~ s!/!\\!g; + $tarfile =~ s!/!\\!g; + $target =~ s!/!\\!g; + } + $xzfile_quote = "\"$xzfile\""; + $tarfile_quote = "\"$tarfile\""; + $target_quote = "\"$target\""; + if ($what =~ m,http://|ftp://,) { + # we are installing from the NET + # download the file and put it into temp + if (!download_file($what, $xzfile) || (! -r $xzfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("did not succeed, please retry.\n"); + unlink($tarfile, $xzfile); + return; + } + } else { + # we are installing from local compressed files + # copy it to temp + TeXLive::TLUtils::copy($what, $tempdir); + } + debug("un-xzing $xzfile to $tarfile\n"); + system("$xzdec < $xzfile_quote > $tarfile_quote"); + if (! -f $tarfile) { + tlwarn("TLUtils::unpack: Unpacking $xzfile failed, please retry.\n"); + unlink($tarfile, $xzfile); + return; + } + unlink($xzfile); + } else { + $tarfile = "$tempdir/$fn"; + if ($what =~ m,http://|ftp://,) { + if (!download_file($what, $tarfile) || (! -r $tarfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("failed, please retry.\n"); + unlink($tarfile); + return; + } + } else { + $tarfile = $what; + $remove_tarfile = 0; + } + } + if (untar($tarfile, $target, $remove_tarfile)) { + return "$pkg"; + } else { + return; + } +} =pod =item C<untar($tarfile, $targetdir, $remove_tarfile)> -Unpacke C<$tarfile> in C<$targetdir> (changing directories to +Unpacks C<$tarfile> in C<$targetdir> (changing directories to C<$targetdir> and then back to the original directory). If C<$remove_tarfile> is true, unlink C<$tarfile> after unpacking. @@ -3655,6 +3757,25 @@ sub compare_tlpdbs { return %ret; } +sub tlnet_disabled_packages { + my ($root) = @_; + my $disabled_pkgs = "$root/tlpkg/dev/tlnet-disabled-packages.txt"; + my @ret; + if (-r $disabled_pkgs) { + open (DISABLED, "<$disabled_pkgs") || die "Huu, -r but cannot open: $?"; + while (<DISABLED>) { + chomp; + next if /^\s*#/; + next if /^\s*$/; + $_ =~ s/^\s*//; + $_ =~ s/\s*$//; + push @ret, $_; + } + close(DISABLED) || warn ("Cannot close tlnet-disabled-packages.txt: $?"); + } + return @ret; +} + sub report_tlpdb_differences { my $rret = shift; my %ret = %$rret; |