TLUtils::install_packages: replace long code with TLPDB::install_package

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

1 files changed, 1 insertions, 90 deletions

diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 8558df0809a..a5888a02a87 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -1341,96 +1341,7 @@ sub install_packages {
     foreach my $h (@::install_packages_hook) {
       &$h($n,$totalnr);
     }
-    my $real_opt_doc = $opt_doc;
-    my $container;
-    my @installfiles;
-    push @installfiles, $tlpobj->runfiles;
-    push @installfiles, $tlpobj->allbinfiles;
-    push @installfiles, $tlpobj->srcfiles if ($opt_src);
-    push @installfiles, $tlpobj->docfiles if ($real_opt_doc);
-    if ($media eq 'local_uncompressed') {
-      $container = [ $root, @installfiles ];
-    } elsif ($media eq 'local_compressed') {
-      if (-r "$root/$Archive/$package.zip") {
-        $container = "$root/$Archive/$package.zip";
-      } elsif (-r "$root/$Archive/$package.tar.xz") {
-        $container = "$root/$Archive/$package.tar.xz";
-      } else {
-        tlwarn("No package $package (.zip or .xz) in $root/$Archive\n");
-        next;
-      }
-    } elsif ($media eq 'NET') {
-      $container = "$root/$Archive/$package.$DefaultContainerExtension";
-    }
-    if (!install_package($container, $reloc, $tlpobj->containersize,
-                         $tlpobj->containermd5, \@installfiles,
-                         $totlpdb->root, $vars{'this_platform'})) {
-      # we already warn in install_package that something bad happened,
-      # so only return here
-      return 0;
-    }
-    # if we are installing from compressed media we have to fetch the respective
-    # source and doc packages $pkg.source and $pkg.doc and install them, too
-    if (($media eq 'NET') || ($media eq 'local_compressed')) {
-      # we install split containers under the following conditions:
-      # - the container were split generated
-      # - src/doc files should be installed
-      # (- the package is not already a split one (like .i386-linux))
-      # the above test has been removed since that would mean that packages
-      # with a dot like texlive.infra will never have the docfiles installed
-      # that is already happening ...bummer. But since we already check
-      # whether there are src/docfiles present at all that is fine
-      # - there are actually src/doc files present
-      if ($container_src_split && $opt_src && $tlpobj->srcfiles) {
-        my $srccontainer = $container;
-        $srccontainer =~ s/(\.tar\.xz|\.zip)$/.source$1/;
-        if (!install_package($srccontainer, $reloc, $tlpobj->srccontainersize,
-                             $tlpobj->srccontainermd5, \@installfiles,
-                             $totlpdb->root, $vars{'this_platform'})) {
-          return 0;
-        }
-      }
-      if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
-        my $doccontainer = $container;
-        $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
-        if (!install_package($doccontainer, $reloc,
-                             $tlpobj->doccontainersize,
-                             $tlpobj->doccontainermd5, \@installfiles,
-                             $totlpdb->root, $vars{'this_platform'})) {
-          return 0;
-        }
-      }
-    }
-    # we don't want to have wrong information in the tlpdb, so remove the
-    # src/doc files if they are not installed ...
-    if (!$opt_src) {
-      $tlpobj->clear_srcfiles;
-    }
-    if (!$real_opt_doc) {
-      $tlpobj->clear_docfiles;
-    }
-    # if a package is relocatable we have to cancel the reloc prefix
-    # before we save it to the local tlpdb
-    if ($tlpobj->relocated) {
-      $tlpobj->replace_reloc_prefix;
-    }
-    $totlpdb->add_tlpobj($tlpobj);
-
-    # we have to write out the tlpobj file since it is contained in the
-    # archives (.tar.xz), but at uncompressed-media install time we
-    # don't have them.
-    my $tlpod = $totlpdb->root . "/tlpkg/tlpobj";
-    mkdirhier($tlpod);
-    my $count = 0;
-    my $tlpobj_file = ">$tlpod/" . $tlpobj->name . ".tlpobj";
-    until (open(TMP, $tlpobj_file)) {
-      # The open might fail for no good reason on Windows.
-      # Try again for a while, but not forever.
-      if ($count++ == 100) { die "$0: open($tlpobj_file) failed: $!"; }
-      select (undef, undef, undef, .1);  # sleep briefly
-    }
-    $tlpobj->writeout(\*TMP);
-    close(TMP);
+    $fromtlpdb->install_package($package, $totlpdb);
     $donesize += $tlpsizes{$package};
   }
   my $totaltime = time() - $starttime;