safer update for tlmgr (make tar before removing)

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

1 files changed, 25 insertions, 14 deletions

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 44c0b1b197b..57403d7ebc0 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -512,8 +512,8 @@ sub writeout_simple {
 
 sub make_container {
   my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
-  if ($type ne "lzma") {
-    die("TLPOBJ currently supports only lzma containers");
+  if (($type ne "lzma") && ($type ne "tar")) {
+    die("TLPOBJ currently supports only plain or lzma containers");
   }
   if (!defined($containername)) {
     $containername = $self->name;
@@ -572,18 +572,25 @@ sub make_container {
   close(TMP);
   push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
   $tarname = "$containername.tar";
-  $containername = "$tarname.lzma";
+  if ($type eq "tar") {
+    $containername = $tarname;
+  } else {
+    $containername = "$tarname.lzma";
+  }
 
   # start the whole fun
   my $tar = $::progs{'tar'};
-  my $lzma = $::progs{'lzma'};
+  my $lzma;
   if (!defined($tar)) {
     tlwarn("Programs have not been set up, trying with \"tar\"!\n");
     $tar = "tar";
   }
-  if (!defined($lzma)) {
-    tlwarn("Programs have not been set up, trying with \"lzma\"!\n");
-    $lzma = "lzma";
+  if ($type eq "lzma") {
+    my $lzma = $::progs{'lzma'};
+    if (!defined($lzma)) {
+      tlwarn("Programs have not been set up, trying with \"lzma\"!\n");
+      $lzma = "lzma";
+    }
   }
   my @cmdline = ($tar, "--owner", "0", "--group", "0", "-c", "-f", "$destdir/$tarname", "--files-from=-");
   unlink("$destdir/$containername");
@@ -603,20 +610,23 @@ sub make_container {
     }
   } @files;
   close ZIP;
-  if (-r "$destdir/$tarname") {
-    system($lzma, "--force", "-z", "$destdir/$tarname");
-  } else {
-    tlwarn("Couldn't find $destdir/$tarname\n");
+  if ($type eq "lzma") {
+    if (-r "$destdir/$tarname") {
+      system($lzma, "--force", "-z", "$destdir/$tarname");
+    } else {
+      tlwarn("Couldn't find $destdir/$tarname\n");
+      return(0,0,"");
+    }
   }
   # compute the size
-  my $size = (stat "$destdir/$tarname.lzma") [7];
-  my $m = TeXLive::TLUtils::tlmd5("$destdir/$tarname.lzma");
+  my $size = (stat "$destdir/$containername") [7];
+  my $m = TeXLive::TLUtils::tlmd5("$destdir/$containername");
   # cleaning up
   unlink("$tlpobjdir/$self->{'name'}.tlpobj");
   rmdir("$tlpobjdir") if $removetlpobjdir;
   chdir($cwd);
   ddebug("Done $containername\n");
-  return($size,$m);
+  return($size,$m,"$destdir/$containername");
 }
 
 
@@ -1288,6 +1298,7 @@ is placed into the root of the installation.
 This is used to distribute packages which can be installed in any arbitrary
 texmf tree (of other distributions, too).
 
+Return values are the size, the md5sum, and the full name of the container.
 
 =item C<recompute_sizes($tltree)>