tlmgr install --file /path/to/some/file.tar.xz

tlmgr install --file http://some.url/path/file.tar.xz


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

2 files changed, 221 insertions, 72 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 7722c0fdf2b..72bf5390204 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -72,6 +72,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
   $tlpdb->install_package($pkg, $dest_tlpdb);
   $tlpdb->remove_package($pkg, %options);
+  $tlpdb->install_package_files($file [, $file ]);
 
   TeXLive::TLPDB->listdir([$dir]);
   $tlpdb->generate_listfiles([$destdir]);
@@ -1299,6 +1300,105 @@ sub size_of_one_package {
 
 =pod
 
+=item C<< $tlpdb->install_package_files($f [, $f]) >>
+
+Install a package from a package file, i.e. a .tar.xz.
+Returns the number of packages actually installed successfully.
+
+=cut
+
+sub install_package_files {
+  my ($self, @files) = @_;
+
+  my $ret = 0;
+
+  my $opt_src = $self->option("install_srcfiles");
+  my $opt_doc = $self->option("install_docfiles");
+
+  for my $f (@files) {
+
+    # - create a tmp directory
+    my $tmpdir = TeXLive::TLUtils::tl_tmpdir();
+    # - unpack everything there
+    if (!TeXLive::TLUtils::unpack($f, $tmpdir)) {
+      tlwarn("TLPDB::install_package_files: couldn't install $f\n");
+      next;
+    }
+    # we are  still here, so the files have been unpacked properly
+    # we need now to find the tlpobj in $tmpdir/tlpkg/tlpobj/
+    my ($tlpobjfile, $anotherfile) = <$tmpdir/tlpkg/tlpobj/*.tlpobj>;
+    if (defined($anotherfile)) {
+      # we found several tlpobj files, that is not allowed, stop
+      tlwarn("TLPDB::install_package_files: several tlpobj files in $what in tlpkg/tlpobj/, stopping!\n");
+      next;
+    }
+    # - read the tlpobj from there
+    my $tlpobj = TeXLive::TLPOBJ->new;
+    $tlpobj->from_file($tlpobjfile);
+    # we didn't die in this process, so that seems to be a proper tlpobj
+    # (btw, why didn't I work on proper return values!?!)
+
+    #
+    # we are now ready for installation
+    # if this package existed before, remove it from the tlpdb
+    if ($self->get_package($tlpobj->name)) {
+      $self->remove_package($tlpobj->name);
+    }
+
+    # code partially from TLPDB->not_virtual_install_package!!!
+    my @installfiles = ();
+    my $reloc = 1 if $tlpobj->relocated;
+    foreach ($tlpobj->runfiles) { push @installfiles, $_; };
+    foreach ($tlpobj->allbinfiles) { push @installfiles, $_; };
+    if ($opt_src) { foreach ($tlpobj->srcfiles) { push @installfiles, $_; } }
+    if ($opt_doc) { foreach ($tlpobj->docfiles) { push @installfiles, $_; } }
+    # 
+    # remove the RELOC prefix, but do NOT replace it with RelocTree
+    @installfiles = map { s!^$TeXLive::TLConfig::RelocPrefix/!!; $_; } @installfiles;
+    # if the first argument of _install_package is scalar, it is the
+    # place from where files should be installed
+    if (!_install_package ($tmpdir, \@installfiles, $reloc, \@installfiles, $self)) {
+      tlwarn("TLPDB::install_package_files: couldn't install $what!\n"); 
+      next;
+    }
+    if ($tlpobj->relocated) {
+      $tlpobj->cancel_reloc_prefix;
+      $tlpobj->relocated(0);
+    }
+    my $tlpod = $self->root . "/tlpkg/tlpobj";
+    mkdirhier( $tlpod );
+    open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or
+      die("Cannot open tlpobj file for ".$tlpobj->name);
+    $tlpobj->writeout(\*TMP);
+    close(TMP);
+    $self->add_tlpobj($tlpobj);
+    $self->save;
+    TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
+    # do the postinstallation actions
+    #
+    # Run the post installation code in the postaction tlpsrc entries
+    # in case we are on w32 and the admin did install for himself only
+    # we switch off admin mode
+    if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+      non_admin();
+    }
+    # for now desktop_integration maps to both installation
+    # of desktop shortcuts and menu items, but we can split them later
+    &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+      $self->option("file_assocs"),
+      $self->option("desktop_integration"),
+      $self->option("desktop_integration"),
+      $self->option("post_code"));
+
+    # remember that we installed this package correctly
+    $ret++;
+  }
+  return $ret;
+}
+
+
+=pod
+
 =item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >>
 
 Installs the package $pkg into $dest_tlpdb.
@@ -1487,7 +1587,6 @@ sub not_virtual_install_package {
 sub _install_package {
   my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
 
-  my $media = $self->media;
   my $target = $totlpdb->root;
   my $tempdir = "$target/temp";
 
@@ -1502,8 +1601,19 @@ sub _install_package {
   }
 
   if (ref $what) {
-    # we are getting a ref to a list of files, so install from DVD
-    my $root = $self->root;
+    # determine the root from where we install
+    # if the first argument $self is a string, then it should be the
+    # root from where to install the files, otherwise it should be 
+    # a TLPDB object (installation from DVD)
+    my $root;
+    if (!ref($self)) {
+      $root = $self;
+    } else {
+      $root = $self->root;
+    }
+    # if we are installing a reloc, add the RelocTree to the target
+    $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
+
     foreach my $file (@$what) {
       # @what is taken, not @filelist!
       # is this still needed?
@@ -1514,78 +1624,16 @@ sub _install_package {
     # we always assume that copy will work
     return(1);
   } elsif ($what =~ m,\.tar(\.xz)?$,) {
-    my $type = defined($1) ? "xz" : "tar";
-      
     $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc;
-
-    # this is the case when we install from local_compressed or the NET, or a backup
-    #
-    # in all other cases we create temp files .tar.xz (or use the present
-    # one), xzdec them, and then call tar
-
-    my $fn = basename($what);
-    my $pkg = $fn;
-    $pkg =~ s/\.tar(\.xz)?$//;
-    mkdirhier("$tempdir");
-    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(0);
-        }
-      } 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("_install_package: Unpacking $xzfile failed, please retry.\n");
-        unlink($tarfile, $xzfile);
-        return(0);
-      }
-      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(0);
-        }
-      } else {
-        $tarfile = $what;
-        $remove_tarfile = 0;
-      }
+    my $pkg = TeXLive::TLUtils::unpack($what, $target);
+    if (!$pkg) {
+      tlwarn("TLPDB::_install_package: couldn't unpack $what to $target\n");
+      return(0);
     }
-    my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile);
     # remove the $pkg.tlpobj, we recreate it anyway again
     unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") 
       if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj");
-    return $ret;
+    return(1);
   } else {
     tlwarn("_install_package: Don't know how to install $what\n");
     return(0);
@@ -1596,7 +1644,7 @@ sub _install_package {
 
 =item << $tlpdb->remove_package($pkg, %options) >>
 
-removes a single pacakge with all the files and the entry in the db.
+removes a single package with all the files and the entry in the db.
 
 =cut
 
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index ee004737b29..9565d56bead 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -164,6 +164,7 @@ BEGIN {
     &forward_slashify
     &conv_to_w32_path
     &untar
+    &unpack
     &merge_into
     &give_ctan_mirror
     &give_ctan_mirror_base
@@ -2072,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.