From e2f5e5a2e07cb0b8cbbfa906ffea944f21e0efc3 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 6 Jan 2016 04:20:51 +0000 Subject: TLUtils::install_packages: replace long code with TLPDB::install_package git-svn-id: svn://tug.org/texlive/trunk@39288 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLUtils.pm | 91 +---------------------------------------- 1 file changed, 1 insertion(+), 90 deletions(-) (limited to 'Master/tlpkg') 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; -- cgit v1.2.3