diff options
author | Karl Berry <karl@freefriends.org> | 2008-11-12 01:42:17 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2008-11-12 01:42:17 +0000 |
commit | a59da517d583ed0ae1bdafedd5c8d37c6d9e0965 (patch) | |
tree | 80d8bbee9a0ba8837d53dfd1cc347f34af4a92a5 | |
parent | e0fa36719ae8b943d0c515ccc2a4f1e2670cc614 (diff) |
* TeXLive/TLMedia.pm (install_package): call untar; debugging msg wording.
* TeXLive/TLUtils.pm (untar): new fn, so we have the tar invocation in
one place, and use just the generic "xf", no -C, so hopefully it will
work everywhere.
(_install_package): call it.
(Cwd): use.
(copy): do not die "...\n", we want line number info.
git-svn-id: svn://tug.org/texlive/trunk@11263 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r-- | Master/tlpkg/TeXLive/TLMedia.pm | 26 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 84 |
2 files changed, 66 insertions, 44 deletions
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm index 218987dbcb3..7102bbf2766 100644 --- a/Master/tlpkg/TeXLive/TLMedia.pm +++ b/Master/tlpkg/TeXLive/TLMedia.pm @@ -84,7 +84,6 @@ sub new return $self; } -# # returns a scalar (0) on error # returns a reference to a hash with actions on success sub install_package { @@ -96,7 +95,7 @@ sub install_package { if (!defined($tlpobj)) { if (defined($fallbackmedia)) { if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) { - debug("installed $pkg from fallback"); + debug("installed $pkg from fallback\n"); return $ret; } else { tlwarn("$0: Cannot find package $pkg (in fallback, either)\n"); @@ -119,7 +118,7 @@ sub install_package { $real_opt_doc = 1; } foreach my $h (@::install_packages_hook) { - &$h("install: $package"); + &$h("install: $pkg"); } my $container; my @installfiles; @@ -234,8 +233,7 @@ sub _install_package { # we assume that $::progs has been set up! my $wget = $::progs{'wget'}; my $lzmadec = $::progs{'lzmadec'}; - my $tar = $::progs{'tar'}; - if (!defined($wget) || !defined($lzmadec) || !defined($tar)) { + if (!defined($wget) || !defined($lzmadec)) { tlwarn("_install_package: programs not set up properly, strange.\n"); return(0); } @@ -293,10 +291,10 @@ sub _install_package { # copy it to temp copy($what, "$target/temp"); } - debug("Un-lzmaing $lzmafile to $tarfile\n"); + debug("un-lzmaing $lzmafile to $tarfile\n"); system("$lzmadec < $lzmafile_quote > $tarfile_quote"); if (! -f $tarfile) { - tlwarn("Unpacking $lzmafile did not succeed, please retry!\n"); + tlwarn("_install_package: Unpacking $lzmafile failed, please retry.\n"); unlink($tarfile, $lzmafile); return(0); } @@ -307,7 +305,7 @@ sub _install_package { if (!download_file($what, $tarfile) || (! -r $tarfile)) { tlwarn("Downloading \n"); tlwarn(" $what\n"); - tlwarn("did not succeed, please retry!\n"); + tlwarn("failed, please retry.\n"); unlink($tarfile); return(0); } @@ -316,17 +314,9 @@ sub _install_package { $remove_tarfile = 0; } } - debug("Unpacking $tarfile\n"); - if (system($tar,"-x","-C",$target,"-f",$tarfile) != 0) { - tlwarn("Untarring $tarfile did not succeed, please retry!\n"); - unlink($tarfile) if $remove_tarfile; - return(0); - } - # we are still here, so success! - unlink($tarfile) if $remove_tarfile; - return(1); + return TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile); } else { - tlwarn("Don't know how to install $what!\n"); + tlwarn("_install_package: Don't know how to install $what\n"); return(0); } } diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 9f1f6b5ed30..34e01d5bb07 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -5,7 +5,6 @@ # This file is licensed under the GNU General Public License version 2 # or any later version. - package TeXLive::TLUtils; =pod @@ -70,7 +69,6 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure =cut - BEGIN { use Exporter (); use vars qw( @ISA @EXPORT_OK @EXPORT); @@ -105,6 +103,7 @@ BEGIN { &member "ewords &conv_to_w32_path + &untar &setup_programs &download_file &merge_into @@ -118,12 +117,12 @@ BEGIN { process_logging_options win32); } - -use TeXLive::TLConfig; -use Getopt::Long; +use Cwd; use Digest::MD5; +use Getopt::Long; -$::opt_verbosity = 0; +use TeXLive::TLConfig; +$::opt_verbosity = 0; # see process_logging_options =pod @@ -706,7 +705,6 @@ sub copy { my $dirmode=0755; my $blocksize=2048; - $infile =~ s!^file://*!/!i; $filename=basename "$infile"; if ($filemode) { @@ -722,13 +720,13 @@ sub copy { if (-l "$infile") { symlink readlink "$infile", "$destdir/$filename"; } else { - open IN, "$infile" or die "Can't open '$infile': $!\n"; + open (IN, $infile) || die "open($infile) failed: $!"; binmode IN; $mode=(-x "$infile")? oct("0777"):oct("0666"); $mode-=umask; - open OUT, ">$outfile" or die "Can't open '$outfile': $!\n"; + open (OUT, ">$outfile") || die "open(>$outfile) failed: $!"; binmode OUT; chmod $mode, "$outfile"; @@ -873,10 +871,10 @@ sub install_packages { } $totlpdb->save; } - + =pod -=item C<install_package($what, $size, $filelistref, $target, $platform)> +=item C<install_package($what, $size, $md5, $filelistref, $target, $platform)> This function installs the files given in @$filelistref from C<$what> into C<$target>. @@ -894,10 +892,9 @@ downloaded from the net and piped through C<lzmadec> and C<tar>. If $what ends with C<.tar.lzma> (but does not start with C<http://> or C<ftp://>, but possibly with C<file:/>) it is assumed to be a readable -file on the system and is -piped through C<lzmadec> and C<tar> in the very same way. +file on the system and is likewise piped through C<lzmadec> and C<tar>. -In both of the last cases currently the list C<$@filelistref> currently +In both of these cases currently the list C<$@filelistref> currently is not taken into account (should be fixed!). =cut @@ -910,8 +907,7 @@ sub install_package { # we assume that $::progs has been set up! my $wget = $::progs{'wget'}; my $lzmadec = $::progs{'lzmadec'}; - my $tar = $::progs{'tar'}; - if (!defined($wget) || !defined($lzmadec) || !defined($tar)) { + if (!defined($wget) || !defined($lzmadec)) { die "install_package: programs not set up properly, strange"; } if (ref $what) { @@ -936,7 +932,6 @@ sub install_package { my $tarfile = "$target/temp/$fn"; $tarfile =~ s/\.lzma$//; my $lzmafile_quote = $lzmafile; my $tarfile_quote = $tarfile; - my $target_quote = $target; if (win32()) { $lzmafile =~ s!/!\\!g; $tarfile =~ s!/!\\!g; @@ -944,7 +939,6 @@ sub install_package { } $lzmafile_quote = "\"$lzmafile\""; $tarfile_quote = "\"$tarfile\""; - $target_quote = "\"$target\""; my $gotfiledone = 0; if (-r $lzmafile) { # check that the downloaded file is not partial @@ -1012,16 +1006,54 @@ sub install_package { if (! -f $tarfile) { die "Unpacking $lzmafile did not succeed, please retry"; } - debug("unpacking $tarfile\n"); - system($tar,"-x","-C",$target,"-f",$tarfile); - unlink($tarfile); - debug("keeping $lzmafile for restarting ...\n"); - # unlink($lzmafile); + TeXLive::TLUtils::untar($tarfile, $target, 1); } else { - die "Don't know how to install $what!\n"; + die "sorry, don't know how to install $what"; } } + +=pod + +=item C<untar($tarfile,$targetdir, $remove_tarfile)> + +Unpacked 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. + +Assumes the global C<$::progs{"tar"}> has been set up. + +=cut + +# return 1 if success, 0 if failure. +sub untar { + my ($tarfile, $targetdir, $remove_tarfile) = @_; + my $ret; + + my $tar = $::progs{'tar'}; # assume it's been set up + + # don't use the -C option to tar since Solaris tar et al. don't support it. + # don't use system("cd ... && $tar ...") since that opens us up to + # quoting issues. + # so fall back on chdir in Perl. + # + debug("unpacking $tarfile in $targetdir\n"); + my $cwd = cwd(); + chdir($targetdir) || die "chdir($targetdir) failed: $!"; + + if (system($tar, "xf", $tarfile) != 0) { + tlwarn("untarring $tarfile failed, please retry\n"); + $ret = 0; + } else { + $ret = 1; + } + unlink($tarfile) if $remove_tarfile; + + chdir($cwd) || die "chdir($cwd) failed: $!"; + return $ret; +} + + =pod =item C<setup_programs( $bindir, $platform )> @@ -1756,9 +1788,9 @@ sub give_ctan_mirror } sub tlmd5 { - my $file = shift; + my ($file) = @_; if (-r $file) { - open(FILE, $file) or die "Can't open '$file': $!"; + open(FILE, $file) || die "open($file) failed: $!"; binmode(FILE); return Digest::MD5->new->addfile(*FILE)->hexdigest; close(FILE); |