summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2016-01-06 04:20:51 +0000
committerNorbert Preining <preining@logic.at>2016-01-06 04:20:51 +0000
commite2f5e5a2e07cb0b8cbbfa906ffea944f21e0efc3 (patch)
treea8e359c1cae37a90b6e6f32515ca7103153d5008
parentbac22ce1f385ca8e3fea32f2164cbe1dd56393bc (diff)
TLUtils::install_packages: replace long code with TLPDB::install_package
git-svn-id: svn://tug.org/texlive/trunk@39288 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm91
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;