summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2011-04-27 22:45:29 +0000
committerNorbert Preining <preining@logic.at>2011-04-27 22:45:29 +0000
commit65c27d338ee4c4e2a62ec75d486723cf33f3c7eb (patch)
treebbe02bfad30ca1769ceb928f670967493f117d0e
parentb82296f4b89901e7b41f2ea8da56222f72a19aa3 (diff)
merge TLMedia functionality into TLPDB and get rid of TLMedia
git-svn-id: svn://tug.org/texlive/trunk@22226 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl218
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui.pl32
-rw-r--r--Master/tlpkg/TeXLive/TLMedia.pm615
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm581
4 files changed, 652 insertions, 794 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 7fed579640c..9b8089c84f3 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -77,7 +77,6 @@ use Getopt::Long qw(:config no_autoabbrev permute);
use strict;
use TeXLive::TLConfig;
-use TeXLive::TLMedia;
use TeXLive::TLPDB;
use TeXLive::TLPOBJ;
use TeXLive::TLUtils;
@@ -92,10 +91,8 @@ binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");
our %config; # hash of config settings from config file
-our $tlmediasrc; # media from which we install/update
-our $tlmediatlpdb;
+our $remotetlpdb;
our $location; # location from which the new packages come
-our $localtlmedia; # local installation which we are munging
our $localtlpdb; # local installation which we are munging
# flags for machine-readable form
@@ -412,7 +409,6 @@ sub give_version {
$::version_string .= "\nTLUtils: " . TeXLive::TLUtils->module_revision();
$::version_string .= "\nTLPOBJ: " . TeXLive::TLPOBJ->module_revision();
$::version_string .= "\nTLPDB: " . TeXLive::TLPDB->module_revision();
- $::version_string .= "\nTLMedia: " . TeXLive::TLMedia->module_revision();
$::version_string .= "\nTLPaper: " . TeXLive::TLPaper->module_revision();
$::version_string .= "\nTLWinGoo: " . TeXLive::TLWinGoo->module_revision();
$::version_string .= "\n";
@@ -830,7 +826,7 @@ sub action_remove {
my $foo = 0;
info ("remove $pkg\n");
if (!$opts{"dry-run"}) {
- $foo = $localtlmedia->remove_package($pkg);
+ $foo = $localtlpdb->remove_package($pkg);
logpackage("remove: $pkg");
}
if ($foo) {
@@ -851,7 +847,7 @@ sub action_remove {
if (!defined($already_removed{$pkg})) {
info ("remove $pkg\n");
if (!$opts{"dry-run"}) {
- if ($localtlmedia->remove_package($pkg)) {
+ if ($localtlpdb->remove_package($pkg)) {
# removal was successful
logpackage("remove: $pkg");
$already_removed{$pkg} = 1;
@@ -942,11 +938,11 @@ sub action_show {
my $tlp = $localtlpdb->get_package($pkg);
my $installed = 0;
if (!$tlp) {
- if (!$tlmediatlpdb) {
+ if (!$remotetlpdb) {
init_tlmedia();
}
- $tlp = $tlmediatlpdb->get_package($pkg);
- $tlpdb = $tlmediatlpdb;
+ $tlp = $remotetlpdb->get_package($pkg);
+ $tlpdb = $remotetlpdb;
} else {
$installed = 1;
}
@@ -956,10 +952,10 @@ sub action_show {
@colls = $localtlpdb->needed_by($pkg);
if (!@colls) {
# not referenced in the local tlpdb, so try the remote here, too
- if (!$tlmediatlpdb) {
+ if (!$remotetlpdb) {
init_tlmedia();
}
- @colls = $tlmediatlpdb->needed_by($pkg);
+ @colls = $remotetlpdb->needed_by($pkg);
}
}
# some packages might depend on other packages, so do not
@@ -1101,7 +1097,7 @@ sub action_path {
# - if non-admin
# --> ignore opt_w32_multi_user and do user path adjustment
if (!$opts{"w32mode"}) {
- $winadminmode = $localtlmedia->tlpdb->option("w32_multi_user");
+ $winadminmode = $localtlpdb->option("w32_multi_user");
if (!TeXLive::TLWinGoo::admin()) {
if ($winadminmode) {
tlwarn("The TLPDB specifies system wide path adjustments\nbut you don't have admin privileges.\nFor user path adjustment please use\n\t--w32mode user\n");
@@ -1139,29 +1135,29 @@ sub action_path {
if ($what =~ m/^add$/i) {
if (win32()) {
TeXLive::TLUtils::w32_add_to_path(
- $localtlmedia->location . "/bin/win32",
+ $localtlpdb->root . "/bin/win32",
$winadminmode);
TeXLive::TLWinGoo::broadcast_env();
} else {
- TeXLive::TLUtils::add_symlinks($localtlmedia->tlpdb->root,
- $localtlmedia->platform(),
- $localtlmedia->tlpdb->option("sys_bin"),
- $localtlmedia->tlpdb->option("sys_man"),
- $localtlmedia->tlpdb->option("sys_info"));
+ TeXLive::TLUtils::add_symlinks($localtlpdb->root,
+ $localtlpdb->platform(),
+ $localtlpdb->option("sys_bin"),
+ $localtlpdb->option("sys_man"),
+ $localtlpdb->option("sys_info"));
}
} elsif ($what =~ m/^remove$/i) {
if (win32()) {
TeXLive::TLUtils::w32_remove_from_path(
- $localtlmedia->location . "/bin/win32",
+ $localtlpdb->root . "/bin/win32",
$winadminmode);
TeXLive::TLWinGoo::broadcast_env();
} else {
# remove symlinks
- TeXLive::TLUtils::remove_symlinks($localtlmedia->tlpdb->root,
- $localtlmedia->platform(),
- $localtlmedia->tlpdb->option("sys_bin"),
- $localtlmedia->tlpdb->option("sys_man"),
- $localtlmedia->tlpdb->option("sys_info"));
+ TeXLive::TLUtils::remove_symlinks($localtlpdb->root,
+ $localtlpdb->platform(),
+ $localtlpdb->option("sys_bin"),
+ $localtlpdb->option("sys_man"),
+ $localtlpdb->option("sys_info"));
}
} else {
# that should not happen
@@ -1251,7 +1247,7 @@ sub action_search {
init_local_db();
if ($opts{"global"}) {
init_tlmedia();
- $tlpdb = $tlmediasrc->tlpdb;
+ $tlpdb = $remotetlpdb;
} else {
$tlpdb = $localtlpdb;
}
@@ -1409,8 +1405,8 @@ sub restore_one_package {
tlwarn("Cannot read $restore_file, no action taken\n");
return;
}
- $localtlmedia->remove_package($pkg);
- TeXLive::TLMedia->_install_package($restore_file , 0, [] ,$localtlpdb);
+ $localtlpdb->remove_package($pkg);
+ TeXLive::TLPDB->_install_package($restore_file , 0, [] ,$localtlpdb);
logpackage("restore: $pkg ($rev)");
# now we have to read the .tlpobj file and add it to the DB
my $tlpobj = TeXLive::TLPOBJ->new;
@@ -1713,18 +1709,17 @@ sub write_w32_updater {
my ($restart_tlmgr, $ref_files_to_be_removed, @w32_updated) = @_;
my @infra_files_to_be_removed = @$ref_files_to_be_removed;
# TODO do something with these files TODO
- my $media = $tlmediasrc->media;
- my $mediatlpdb = $tlmediasrc->tlpdb;
+ my $media = $remotetlpdb->media;
# we have to download/copy also the src/doc files if necessary!
- my $container_src_split = $mediatlpdb->config_src_container;
- my $container_doc_split = $mediatlpdb->config_doc_container;
+ my $container_src_split = $remotetlpdb->config_src_container;
+ my $container_doc_split = $remotetlpdb->config_doc_container;
# get options about src/doc splitting from $totlpdb
# TT: should we use local options to decide about install of doc & src?
my $opt_src = $localtlpdb->option("install_srcfiles");
my $opt_doc = $localtlpdb->option("install_docfiles");
my $root = $localtlpdb->root;
my $temp = "$root/temp";
- my $repo = $mediatlpdb->root . "/$Archive";
+ my $repo = $remotetlpdb->root . "/$Archive";
TeXLive::TLUtils::mkdirhier($temp);
tlwarn("Backup option not implemented for infrastructure update.\n") if ($opts{"backup"});
if ($media eq 'local_uncompressed') {
@@ -1734,7 +1729,7 @@ sub write_w32_updater {
}
my (@upd_tar, @upd_tlpobj, @upd_info, @rst_tar, @rst_tlpobj, @rst_info);
foreach my $pkg (@w32_updated) {
- my $mediatlp = $mediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
my $localtlp = $localtlpdb->get_package($pkg);
my $oldrev = $localtlp->revision;
my $newrev = $mediatlp->revision;
@@ -1913,15 +1908,15 @@ sub auto_remove_install_force_packages {
#
my @all_schmscolls = ();
for my $p ($localtlpdb->schemes) {
- push (@all_schmscolls, $p) if defined($tlmediatlpdb->get_package($p));
+ push (@all_schmscolls, $p) if defined($remotetlpdb->get_package($p));
}
for my $p ($localtlpdb->collections) {
- push (@all_schmscolls, $p) if defined($tlmediatlpdb->get_package($p));
+ push (@all_schmscolls, $p) if defined($remotetlpdb->get_package($p));
}
my @localexpansion_full =
$localtlpdb->expand_dependencies($localtlpdb, @all_schmscolls);
my @remoteexpansion_full =
- $tlmediatlpdb->expand_dependencies($localtlpdb, @all_schmscolls);
+ $remotetlpdb->expand_dependencies($localtlpdb, @all_schmscolls);
# compute new/remove/forcerm based on the full expansions
for my $p (@remoteexpansion_full) {
@@ -1942,7 +1937,7 @@ sub auto_remove_install_force_packages {
# intersection, don't check A\B and B\A
next if $newpkgs_full{$p};
next if $removals_full{$p};
- next if ($tlmediatlpdb->get_package($p)->category ne "Collection");
+ next if ($remotetlpdb->get_package($p)->category ne "Collection");
my $tlp = $localtlpdb->get_package($p);
if (!defined($tlp)) {
if ($opts{"reinstall-forcibly-removed"}) {
@@ -1956,7 +1951,7 @@ sub auto_remove_install_force_packages {
# forcibly removed. Again, expand those against the remote tlpdb
# and remove the expanded packages from the list of localexpansion.
my @pkgs_from_forcerm_colls =
- $tlmediatlpdb->expand_dependencies($localtlpdb, keys %forcermpkgs_full);
+ $remotetlpdb->expand_dependencies($localtlpdb, keys %forcermpkgs_full);
#
# the package in @pkgs_from_forcerm_colls would be auto-installed, so
# check for that:
@@ -2033,7 +2028,7 @@ sub auto_remove_install_force_packages {
# tlmgr update --no-depends-at-all foo
# will absolutely only update foo not even taking .ARCH into account
#
-# TLMedia->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever
+# TLPDB->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever
# anymore. That has all to be done by hand.
#
sub machine_line {
@@ -2083,7 +2078,7 @@ sub action_update {
# check for updates to tlmgr and die unless either --force or --list or --self
# is given
- my @critical = check_for_critical_updates($localtlpdb, $tlmediatlpdb);
+ my @critical = check_for_critical_updates($localtlpdb, $remotetlpdb);
my $dry_run_cont = $opts{"dry-run"} && ($opts{"dry-run"} < 0);
if ( !$dry_run_cont && !$opts{"self"} && @critical) {
critical_updates_warning();
@@ -2185,11 +2180,11 @@ sub action_update {
if (!($opts{"self"} && @critical) || ($opts{"self"} && $opts{"list"})) {
# update all .ARCH dependencies, too, unless $opts{"no-depends-at-all"}:
- @todo = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo)
+ @todo = $remotetlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo)
unless $opts{"no-depends-at-all"};
#
# update general deps unless $opts{"no-depends"}:
- @todo = $tlmediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo)
+ @todo = $remotetlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo)
unless $opts{"no-depends"};
#
# filter out critical packages
@@ -2298,7 +2293,7 @@ sub action_update {
next;
}
# install new packages
- my $mediatlp = $tlmediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
tlwarn("\nShould not happen: $pkg not found in $location");
next;
@@ -2308,7 +2303,7 @@ sub action_update {
next;
}
my $rev = $tlp->revision;
- my $mediatlp = $tlmediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
debug("$pkg cannot be found in $location\n");
next;
@@ -2360,7 +2355,7 @@ sub action_update {
# get something wrong back, namely the total size of all packages
my %sizes;
if (@alltodo) {
- %sizes = %{$tlmediatlpdb->sizes_of_packages(
+ %sizes = %{$remotetlpdb->sizes_of_packages(
$localtlpdb->option("install_srcfiles"),
$localtlpdb->option("install_docfiles"), @alltodo)};
} else {
@@ -2394,7 +2389,7 @@ sub action_update {
}
}
for my $p (@updated, @new) {
- my $pkg = $tlmediatlpdb->get_package($p);
+ my $pkg = $remotetlpdb->get_package($p);
tlwarn("Should not happen: $p not found in $location\n") if (!$pkg);
next;
for my $f ($pkg->all_files) {
@@ -2438,7 +2433,7 @@ sub action_update {
info("not removing $p due to -no-auto-remove (removed on server)\n");
} else {
&ddebug("removing package $p\n");
- my $pkg = $localtlmedia->tlpdb->get_package($p);
+ my $pkg = $localtlpdb->get_package($p);
if (! $pkg) {
# This happened when a collection was removed by the user,
# and then renamed on the server, e.g., collection-langarab ->
@@ -2476,7 +2471,7 @@ sub action_update {
clear_old_backups($p, $opts{"backupdir"}, $autobackup);
}
}
- $localtlmedia->remove_package($p);
+ $localtlpdb->remove_package($p);
logpackage("remove: $p");
}
$currnr++;
@@ -2572,7 +2567,7 @@ sub action_update {
my $unwind_package;
my $remove_unwind_container = 0;
my $rev = $tlp->revision;
- my $mediatlp = $tlmediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
debug("$pkg cannot be found in $location\n");
next;
@@ -2666,10 +2661,10 @@ sub action_update {
if ($pkg =~ m/$CriticalPackagesRegexp/) {
debug("Not removing critical package $pkg\n");
} else {
- $localtlmedia->remove_package($pkg,
+ $localtlpdb->remove_package($pkg,
"remove-warn-files" => \%do_warn_on_move);
}
- if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
+ if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
# installation succeeded because we got a reference
logpackage("update: $pkg ($rev -> $mediarev)");
unlink($unwind_package) if $remove_unwind_container;
@@ -2713,8 +2708,8 @@ sub action_update {
$remove_unwind_container = 1;
$unwind_package = $newname;
}
- my $instret = TeXLive::TLMedia->_install_package("$unwind_package", 0,
- [], $localtlpdb);
+ my $instret = TeXLive::TLPDB->_install_package("$unwind_package", 0,
+ [], $localtlpdb);
if ($instret) {
# now we have to include the tlpobj
my $tlpobj = TeXLive::TLPOBJ->new;
@@ -2740,7 +2735,7 @@ sub action_update {
unless $::machinereadable;
} else {
# install new packages
- my $mediatlp = $tlmediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
tlwarn("\nShould not happen: $pkg not found in $location");
next;
@@ -2768,7 +2763,7 @@ sub action_update {
$currnr++;
$donesize += $sizes{$pkg};
next if ($opts{"dry-run"} || $opts{"list"});
- if ($tlmediasrc->install_package($pkg, $localtlpdb)) {
+ if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
# installation succeeded because we got a reference
logpackage("auto-install new: $pkg ($mediarev)");
$nrupdated++;
@@ -2797,11 +2792,11 @@ sub action_update {
my $newtlp;
if ($updated{$pkg}) {
$oldtlp = $localtlpdb->get_package($pkg);
- $newtlp = $tlmediatlpdb->get_package($pkg);
+ $newtlp = $remotetlpdb->get_package($pkg);
} else {
# update failed but we could introduce new files, that
# should be removed now as a part of restoring backup
- $oldtlp = $tlmediatlpdb->get_package($pkg);
+ $oldtlp = $remotetlpdb->get_package($pkg);
$newtlp = $localtlpdb->get_package($pkg);
}
die ("That shouldn't happen: $pkg not found in tlpdb") if !defined($newtlp);
@@ -2897,8 +2892,8 @@ sub action_update {
if ($opts{"dry-run"} && !$opts{"list"} && $restart_tlmgr) {
$opts{"self"} = 0;
$opts{"dry-run"} = -1;
- $localtlmedia = undef;
- $tlmediatlpdb = undef;
+ $localtlpdb = undef;
+ $remotetlpdb = undef;
info ("Restarting tlmgr to complete update ...\n");
action_update();
return;
@@ -2908,7 +2903,7 @@ sub action_update {
# warn if nothing is updated.
if (!(@new || @updated)) {
info("tlmgr: no updates available\n");
- if ($tlmediasrc->media ne "NET"
+ if ($remotetlpdb->media ne "NET"
&& !$opts{"dry-run"}
&& !$opts{"repository"}
) {
@@ -2948,18 +2943,18 @@ sub action_update {
# . it does not care for whether a package seems to be installed or
# not (that is the --reinstall)
#
-# TLMedia->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever
+# TLPDB->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever
# anymore! That has all to be done by hand.
#
sub action_install {
init_local_db(1);
return if !check_on_writable();
- # initialize the TLMedia from $location
+ # initialize the TLPDB from $location
$opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
init_tlmedia();
# check for updates to tlmgr itself, and die unless --force is given
- if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) {
+ if (check_for_critical_updates( $localtlpdb, $remotetlpdb)) {
critical_updates_warning();
if ($opts{"force"}) {
tlwarn("Continuing due to --force\n");
@@ -2978,13 +2973,13 @@ sub action_install {
my @packs = @ARGV;
# first expand the .ARCH dependencies unless $opts{"no-depends-at-all"}
- @packs = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"};
+ @packs = $remotetlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"};
# now expand all others unless $opts{"no-depends"}
# if $opts{"reinstall"} do not collection->collection dependencies
if ($opts{"reinstall"}) {
- @packs = $tlmediatlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"};
+ @packs = $remotetlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"};
} else {
- @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"};
+ @packs = $remotetlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"};
}
#
# installation order of packages:
@@ -3013,7 +3008,7 @@ sub action_install {
my @todo;
for my $pkg (@inst_packs, @inst_colls, @inst_schemes) {
my $pkgrev = 0;
- my $mediatlp = $tlmediatlpdb->get_package($pkg);
+ my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
tlwarn("package $pkg not present in package repository.\n");
next;
@@ -3036,7 +3031,7 @@ sub action_install {
return if (!@todo);
my $currnr = 1;
- my %sizes = %{$tlmediatlpdb->sizes_of_packages(
+ my %sizes = %{$remotetlpdb->sizes_of_packages(
$localtlpdb->option("install_srcfiles"),
$localtlpdb->option("install_docfiles"), @todo)};
defined($sizes{'__TOTAL__'}) || ($sizes{'__TOTAL__'} = 0);
@@ -3067,7 +3062,7 @@ sub action_install {
info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg [${kb}k]\n");
}
if (!$opts{"dry-run"}) {
- $tlmediasrc->install_package($pkg, $localtlpdb);
+ $remotetlpdb->install_package($pkg, $localtlpdb);
logpackage("${re}install: $pkg");
}
$donesize += $sizes{$pkg};
@@ -3098,18 +3093,18 @@ sub action_list {
}
my $tlm;
if ($opts{"only-installed"}) {
- $tlm = $localtlmedia;
+ $tlm = $localtlpdb;
} else {
init_tlmedia();
- $tlm = $tlmediasrc;
+ $tlm = $remotetlpdb;
}
my @whattolist;
if ($what =~ m/^collection/i) {
- @whattolist = $tlm->tlpdb->collections;
+ @whattolist = $tlm->collections;
} elsif ($what =~ m/^scheme/i) {
- @whattolist = $tlm->tlpdb->schemes;
+ @whattolist = $tlm->schemes;
} else {
- @whattolist = $tlm->tlpdb->list_packages;
+ @whattolist = $tlm->list_packages;
}
foreach (@whattolist) {
next if ($_ =~ m/^00texlive/);
@@ -3118,7 +3113,7 @@ sub action_list {
} else {
print " ";
}
- my $foo = $tlm->tlpdb->get_package($_)->shortdesc;
+ my $foo = $tlm->get_package($_)->shortdesc;
print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n";
}
return;
@@ -3311,12 +3306,11 @@ sub action_platform {
$what || ($what = "list");
if ($what =~ m/^list$/i) {
# list the available platforms
- # initialize the TLMedia from $location
+ # initialize the TLPDB from $location
init_tlmedia();
- my $mediatlpdb = $tlmediasrc->tlpdb;
my @already_installed_arch = $localtlpdb->available_architectures;
print "Available platforms:\n";
- foreach my $a ($mediatlpdb->available_architectures) {
+ foreach my $a ($remotetlpdb->available_architectures) {
if (member($a,@already_installed_arch)) {
print "(i) $a\n";
} else {
@@ -3329,9 +3323,8 @@ sub action_platform {
} elsif ($what =~ m/^add$/i) {
return if !check_on_writable();
init_tlmedia();
- my $mediatlpdb = $tlmediasrc->tlpdb;
my @already_installed_arch = $localtlpdb->available_architectures;
- my @available_arch = $mediatlpdb->available_architectures;
+ my @available_arch = $remotetlpdb->available_architectures;
my @todoarchs;
foreach my $a (@ARGV) {
if (TeXLive::TLUtils::member($a, @already_installed_arch)) {
@@ -3351,9 +3344,9 @@ sub action_platform {
if ($dep =~ m/^(.*)\.ARCH$/) {
# we have to install something
foreach my $a (@todoarchs) {
- if ($tlmediatlpdb->get_package("$pkg.$a")) {
+ if ($remotetlpdb->get_package("$pkg.$a")) {
info("install: $pkg.$a\n");
- $tlmediasrc->install_package("$pkg.$a", $localtlpdb)
+ $remotetlpdb->install_package("$pkg.$a", $localtlpdb)
if (!$opts{"dry-run"});
}
}
@@ -3364,7 +3357,7 @@ sub action_platform {
# install the necessary w32 stuff
for my $p (@extra_w32_packs) {
info("install: $p\n");
- $tlmediasrc->install_package($p, $localtlpdb) if (!$opts{"dry-run"});
+ $remotetlpdb->install_package($p, $localtlpdb) if (!$opts{"dry-run"});
}
}
# update the option("available_architectures") list of installed archs
@@ -3378,7 +3371,7 @@ sub action_platform {
return if !check_on_writable();
my @already_installed_arch = $localtlpdb->available_architectures;
my @todoarchs;
- my $currentarch = $localtlmedia->platform();
+ my $currentarch = $localtlpdb->platform();
foreach my $a (@ARGV) {
if (!TeXLive::TLUtils::member($a, @already_installed_arch)) {
print "Platform $a not installed, use 'tlmgr platform list'!\n";
@@ -3404,7 +3397,7 @@ sub action_platform {
foreach my $a (@todoarchs) {
if ($localtlpdb->get_package("$pkg.$a")) {
info("remove: $pkg.$a\n");
- $localtlmedia->remove_package("$pkg.$a") if (!$opts{"dry-run"});
+ $localtlpdb->remove_package("$pkg.$a") if (!$opts{"dry-run"});
}
}
}
@@ -3413,7 +3406,7 @@ sub action_platform {
if (TeXLive::TLUtils::member('win32', @todoarchs)) {
for my $p (@extra_w32_packs) {
info("remove: $p\n");
- $localtlmedia->remove_package($p) if (!$opts{"dry-run"});
+ $localtlpdb->remove_package($p) if (!$opts{"dry-run"});
}
}
if (!$opts{"dry-run"}) {
@@ -3629,11 +3622,11 @@ sub action_uninstall {
}
print ("Ok, removing the whole installation:\n");
init_local_db();
- TeXLive::TLUtils::remove_symlinks($localtlmedia->tlpdb->root,
- $localtlmedia->platform(),
- $localtlmedia->tlpdb->option("sys_bin"),
- $localtlmedia->tlpdb->option("sys_man"),
- $localtlmedia->tlpdb->option("sys_info"));
+ TeXLive::TLUtils::remove_symlinks($localtlpdb->root,
+ $localtlpdb->platform(),
+ $localtlpdb->option("sys_bin"),
+ $localtlpdb->option("sys_man"),
+ $localtlpdb->option("sys_info"));
# now do remove the rest
system("rm", "-rf", "$Master/texmf-dist");
system("rm", "-rf", "$Master/texmf-doc");
@@ -3845,7 +3838,7 @@ sub check_files {
# if we are on W32, return (no find). We need -use-svn only for
# checking the live repository on tug, which is not w32.
- my $arch = $localtlmedia->platform();
+ my $arch = $localtlpdb->platform();
return $ret if $arch eq "win32";
# check that all files in the trees are covered.
@@ -4427,15 +4420,12 @@ sub init_local_db {
# if the localtlpdb is already defined do simply return here already
# to make sure that the settings in the local tlpdb do not overwrite
# stuff changed via the GUI
- return if defined $localtlmedia;
return if defined $localtlpdb;
- $localtlmedia = TeXLive::TLMedia->new ( $Master );
- die("cannot setup TLMedia in $Master") unless (defined($localtlmedia));
- $localtlpdb = $localtlmedia->tlpdb;
- die("cannot find tlpdb in $Master") unless (defined($localtlpdb));
+ $localtlpdb = TeXLive::TLPDB->new ( root => $Master );
+ die("cannot setup TLPDB in $Master") unless (defined($localtlpdb));
# setup the programs, for w32 we need the shipped wget/xz etc, so we
# pass the location of these files to setup_programs.
- if (!setup_programs("$Master/tlpkg/installer", $localtlmedia->platform)) {
+ if (!setup_programs("$Master/tlpkg/installer", $localtlpdb->platform)) {
tlwarn("Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n");
if (defined($should_i_die) && $should_i_die) {
finish(1);
@@ -4471,12 +4461,12 @@ sub init_local_db {
}
-# initialize the global $tlmediasrc object, or die.
+# initialize the global $remotetlpdb object, or die.
# uses the global $location.
#
sub init_tlmedia
{
- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) {
+ if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
# nothing to be done
return;
}
@@ -4531,8 +4521,8 @@ http://tug.org/texlive/doc/install-tl.html
END_NO_INTERNET
# above text duplicated in install-tl
- $tlmediasrc = TeXLive::TLMedia->new(-location => $location,
- -tlpdbfile => $loc_copy_of_remote_tlpdb);
+ $remotetlpdb = TeXLive::TLPDB->new(root => $location,
+ tlpdbfile => $loc_copy_of_remote_tlpdb);
$local_copy_tlpdb_used = 1;
} else {
ddebug("found remote digest: $rem_digest\n");
@@ -4540,19 +4530,17 @@ END_NO_INTERNET
ddebug("rem_copy_digest = $rem_copy_digest\n");
if ($rem_copy_digest eq $rem_digest) {
debug("md5 of local copy identical with remote hash\n");
- $tlmediasrc = TeXLive::TLMedia->new(-location => $location,
- -tlpdbfile => $loc_copy_of_remote_tlpdb);
+ $remotetlpdb = TeXLive::TLPDB->new(root => $location,
+ tlpdbfile => $loc_copy_of_remote_tlpdb);
$local_copy_tlpdb_used = 1;
}
}
}
}
if (!$local_copy_tlpdb_used) {
- # $tlmediasrc is a global variable
- $tlmediasrc = TeXLive::TLMedia->new(-location => $location);
+ $remotetlpdb = TeXLive::TLPDB->new(root => $location);
}
- die($loadmediasrcerror . $location) unless defined($tlmediasrc);
- $tlmediatlpdb = $tlmediasrc->tlpdb;
+ die($loadmediasrcerror . $location) unless defined($remotetlpdb);
# we allow a range of years to be specified by the remote tlpdb
# for which it might work.
# the lower limit is TLPDB->config_minrelease
@@ -4563,10 +4551,10 @@ END_NO_INTERNET
# might use
# release/2009-foobar
# If it should work for 2009 and 2010, please use
- # release/2010-foobar
# minrelease/2009-foobar
- my $texlive_release = $tlmediatlpdb->config_release;
- my $texlive_minrelease = $tlmediatlpdb->config_minrelease;
+ # release/2010-foobar
+ my $texlive_release = $remotetlpdb->config_release;
+ my $texlive_minrelease = $remotetlpdb->config_minrelease;
if (!defined($texlive_release)) {
tldie "The installation repository does not specify a release year for which it was prepared, bailing out.\n";
}
@@ -4595,7 +4583,7 @@ do not include the version of the local installation
END_BADRANGE
}
} else {
- # $texlive_release not defined, so only one year is valid
+ # $texlive_minrelease not defined, so only one year is valid
if ($texlive_release_year != $TeXLive::TLConfig::ReleaseYear) {
tldie <<END_BADYEAR
$0: The TeX Live versions of the local installation
@@ -4608,7 +4596,7 @@ END_BADYEAR
}
# check for being frozen
- if ($tlmediatlpdb->option("frozen")) {
+ if ($remotetlpdb->option("frozen")) {
my $frozen_msg = <<FROZEN;
TeX Live $TeXLive::TLConfig::ReleaseYear is frozen forever and will no
longer be updated. This happens in preparation for a new release.
@@ -4636,7 +4624,7 @@ FROZEN
&debug("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n");
} else {
&debug("writing out tlpdb to $loc_copy_of_remote_tlpdb\n");
- $tlmediatlpdb->writeout($tlfh);
+ $remotetlpdb->writeout($tlfh);
close($tlfh);
}
}
diff --git a/Master/texmf/scripts/texlive/tlmgrgui.pl b/Master/texmf/scripts/texlive/tlmgrgui.pl
index 29355a6119a..9b6c146e020 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui.pl
@@ -53,9 +53,7 @@ my $mode_expert = $config{"gui-expertmode"};
#
# stuff defined in tlmgr.pl that needs to be our-ed
our $Master;
-our $tlmediatlpdb;
-our $tlmediasrc;
-our $localtlmedia;
+our $remotetlpdb;
our $localtlpdb;
our $location;
our %opts;
@@ -692,10 +690,10 @@ sub show_extended_info {
$tf->Label(-text => $Packages{$p}{'secondary'}),
-sticky => "nw");
}
- if ($tlmediatlpdb) {
+ if ($remotetlpdb) {
my @colls;
if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") {
- @colls = $tlmediatlpdb->needed_by($tlp->name);
+ @colls = $remotetlpdb->needed_by($tlp->name);
}
@colls = grep {m;^collection-;} @colls;
if (@colls) {
@@ -958,12 +956,12 @@ sub MatchesFilters {
############# ARCH HANDLING #####################
sub init_archs {
- if (!defined($tlmediatlpdb)) {
+ if (!defined($remotetlpdb)) {
@archsavail = $localtlpdb->available_architectures;
} else {
- @archsavail = $tlmediatlpdb->available_architectures;
+ @archsavail = $remotetlpdb->available_architectures;
}
- $currentarch = $localtlmedia->platform();
+ $currentarch = $localtlpdb->platform();
@archsinstalled = $localtlpdb->available_architectures;
foreach my $a (@archsavail) {
$archs{$a} = 0;
@@ -1562,26 +1560,24 @@ sub setup_location {
sub init_install_media {
my $newroot = $location;
- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) {
+ if (defined($remotetlpdb) && ($remotetlpdb->root eq $newroot)) {
# nothing to be done
} else {
$mw->Busy(-recurse => 1);
info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n");
- $tlmediasrc = TeXLive::TLMedia->new($newroot);
+ $remotetlpdb = TeXLive::TLPDB->new(root => $newroot);
info(__("Completed") . ".\n");
$mw->Unbusy;
- if (!defined($tlmediasrc)) {
+ if (!defined($remotetlpdb)) {
# something went badly wrong, maybe the newroot is wrong?
$mw->Dialog(-title => __("Warning"),
-text => __("Could not load the TeX Live Database from %s\nIf you want to install or update packages, please try with a different package repository!\n\nFor configuration and removal you don\'t have to do anything.", $newroot),
-buttons => [ __("Ok") ])->Show;
- $tlmediatlpdb = undef;
- $tlmediasrc = undef;
+ $remotetlpdb = undef;
update_list_remote();
update_grid();
update_loaded_location_string("none");
} else {
- $tlmediatlpdb = $tlmediasrc->tlpdb;
update_list_remote();
update_grid();
update_loaded_location_string($location);
@@ -1871,15 +1867,15 @@ sub update_list_remote {
delete $Packages{$p}{'remoterevision'};
delete $Packages{$p}{'remotecatalogueversion'};
}
- if (defined($tlmediatlpdb)) {
- for my $p ($tlmediatlpdb->list_packages()) {
+ if (defined($remotetlpdb)) {
+ for my $p ($remotetlpdb->list_packages()) {
# skip 00texlive packages
next if ($p =~ m!^00texlive!);
if ($p =~ m;\.;) {
push @do_later_media, $p;
next;
}
- my $tlp = $tlmediatlpdb->get_package($p);
+ my $tlp = $remotetlpdb->get_package($p);
populate_Packages("remote", $tlp);
}
}
@@ -1890,7 +1886,7 @@ sub update_list_remote {
tlerror("very strange, above it matched and now not anymore?!?! $p\n");
next;
}
- my $tlp = $tlmediatlpdb->get_package($p);
+ my $tlp = $remotetlpdb->get_package($p);
if (!defined($Packages{$mp})) {
populate_Packages("remote", $tlp);
} else {
diff --git a/Master/tlpkg/TeXLive/TLMedia.pm b/Master/tlpkg/TeXLive/TLMedia.pm
deleted file mode 100644
index 2c3be124b4b..00000000000
--- a/Master/tlpkg/TeXLive/TLMedia.pm
+++ /dev/null
@@ -1,615 +0,0 @@
-# $Id$
-# TeXLive::TLMedia.pm - module for accessing TeX Live Media
-# Copyright 2008, 2009, 2010 Norbert Preining
-# This file is licensed under the GNU General Public License version 2
-# or any later version.
-
-package TeXLive::TLMedia;
-
-my $svnrev = '$Revision$';
-my $_modulerevision;
-if ($svnrev =~ m/: ([0-9]+) /) {
- $_modulerevision = $1;
-} else {
- $_modulerevision = "unknown";
-}
-sub module_revision {
- return $_modulerevision;
-}
-
-
-use TeXLive::TLConfig;
-use TeXLive::TLUtils qw(copy win32 dirname mkdirhier basename download_file
- merge_into debug ddebug info tlwarn log);
-use TeXLive::TLPDB;
-use TeXLive::TLWinGoo;
-
-sub new
-{
- my ($class, @args) = @_;
- # 0 elements -> -1
- # 1 arg -> 0
- # even args -> uneven
- my $location;
- my %params;
- my $self = { };
- my $tlpdbfile;
- if ($#args % 2) {
- # even number of arguments, the first must be the location
- %params = @args;
- $location = $params{'-location'};
- $tlpdbfile = $params{'-tlpdbfile'};
- } else {
- # odd number of arguments
- $location = shift @args;
- }
- my $media;
- # of no argument is given we assume NET and default URL
- if (!defined($location)) {
- return;
- }
- # no default by itself ...
- # $location = "$TeXLiveURL" unless (defined($location));
- # do media autodetection
- if ($location =~ m,http://|ftp://,) {
- $media = 'NET';
- } else {
- if ($location =~ m,file://*(.*)$,) {
- $location = "/$1";
- }
- if (-d "$location/texmf/web2c") {
- $media = 'local_uncompressed';
- } elsif (-d "$location/$Archive") {
- $media = 'local_compressed';
- } else {
- # we cannot find the right type, return undefined, that should
- # make people notice
- return;
- }
- }
- my $tlpdb;
- if (defined($tlpdbfile)) {
- # we got the tlpdb file for a specific location
- debug("Loading TLPDB from $tlpdbfile for $location ...\n");
- $tlpdb = TeXLive::TLPDB->new;
- if ($tlpdb->from_file($tlpdbfile)) {
- # found a positive number of packages
- $tlpdb->root($location);
- } else {
- # couldn't read from tlpdb
- return(undef);
- }
- } else {
- debug("Loading $location/$InfraLocation/$DatabaseName ...\n");
- $tlpdb = TeXLive::TLPDB->new(root => $location);
- return(undef) unless defined($tlpdb);
- }
- my (@all_c, @std_c, @lang_c, @lang_doc_c);
- my (@schemes);
- my %revs;
- foreach my $pkg ($tlpdb->list_packages) {
- my $tlpobj = $tlpdb->{'tlps'}{$pkg};
- $revs{$tlpobj->name} = $tlpobj->revision;
- if ($tlpobj->category eq "Collection") {
- push @all_c, $pkg;
- if ($pkg =~ /collection-lang/) {
- push @lang_c, $pkg;
- } elsif ($pkg =~ /documentation/) {
- if ($pkg =~ /documentation-base/) {
- push @std_c, $pkg;
- } else {
- push @lang_doc_c, $pkg;
- }
- } else {
- push @std_c, $pkg;
- }
- } elsif ($tlpobj->category eq "Scheme") {
- push @schemes, $pkg;
- }
- }
- my (@systems);
- @systems = $tlpdb->available_architectures;
- $self->{'media'} = $media;
- $self->{'location'} = $location;
- $self->{'tlpdb'} = $tlpdb;
- $self->{'release'} = $tlpdb->config_release;
- @{ $self->{'all_collections'} } = @all_c;
- @{ $self->{'std_collections'} } = @std_c;
- @{ $self->{'lang_collections'} } = @lang_c;
- @{ $self->{'lang_doc_collections'} } = @lang_doc_c;
- @{ $self->{'schemes'} } = @schemes;
- @{ $self->{'systems'} } = @systems;
- %{ $self->{'pkgrevs'} } = %revs;
- bless $self, $class;
- return $self;
-}
-
-# returns a scalar (0) on error
-# returns a reference to a hash with actions on success
-sub install_package {
- my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
- my $fromtlpdb = $self->tlpdb;
- my $ret;
- die("TLMedia not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
- my $tlpobj = $fromtlpdb->get_package($pkg);
- if (!defined($tlpobj)) {
- if (defined($fallbackmedia)) {
- if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
- debug("installed $pkg from fallback\n");
- return $ret;
- } else {
- tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
- return 0;
- }
- } else {
- tlwarn("$0: Cannot find package $pkg\n");
- return 0;
- }
- } else {
- my $container_src_split = $fromtlpdb->config_src_container;
- my $container_doc_split = $fromtlpdb->config_doc_container;
- # get options about src/doc splitting from $totlpdb
- my $opt_src = $totlpdb->option("install_srcfiles");
- my $opt_doc = $totlpdb->option("install_docfiles");
- my $real_opt_doc = $opt_doc;
- my $reloc = 1 if $tlpobj->relocated;
- my $container;
- my @installfiles;
- my $location = $self->location;
- # make sure that there is no terminal / in $location, otherwise we
- # will get double // somewhere
- $location =~ s!/$!!;
- foreach ($tlpobj->runfiles) {
- # s!^!$location/!;
- push @installfiles, $_;
- }
- foreach ($tlpobj->allbinfiles) {
- # s!^!$location/!;
- push @installfiles, $_;
- }
- if ($opt_src) {
- foreach ($tlpobj->srcfiles) {
- # s!^!$location/!;
- push @installfiles, $_;
- }
- }
- if ($real_opt_doc) {
- foreach ($tlpobj->docfiles) {
- # s!^!$location/!;
- push @installfiles, $_;
- }
- }
- my $media = $self->media;
- if ($media eq 'local_uncompressed') {
- $container = \@installfiles;
- } elsif ($media eq 'local_compressed') {
- if (-r "$location/$Archive/$pkg.zip") {
- $container = "$location/$Archive/$pkg.zip";
- } elsif (-r "$location/$Archive/$pkg.tar.xz") {
- $container = "$location/$Archive/$pkg.tar.xz";
- } else {
- tlwarn("Cannot find a package $pkg (.zip or .xz) in $location/$Archive\n");
- next;
- }
- } elsif (&media eq 'NET') {
- $container = "$location/$Archive/$pkg.$DefaultContainerExtension";
- }
- $self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
- || return(0);
- # if we are installing from local_compressed or NET 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 because it would mean that
- # texlive.infra.doc.tar.xz
- # will never be installed, and we do already check that there
- # are at all src/doc files, which in split packages of the form
- # foo.ARCH are not present. And if they are present, than that is fine,
- # too (bin-foobar.win32.doc.tar.xz)
- # - 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/;
- $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb)
- || return(0);
- }
- if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
- my $doccontainer = $container;
- $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
- $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb)
- || return(0);
- }
- #
- # if we installed from NET/local_compressed and we got a relocatable container
- # make sure that the stray texmf-dist/tlpkg directory is removed
- # in USER MODE that should NOT be done because we keep the information
- # there, but for now do it unconditionally
- if ($tlpobj->relocated) {
- my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
- my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
- my $tlpod = $tlpkgdir . "/tlpobj";
- TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
- # we try to remove the tlpkg directory, that will succeed only
- # if it is empty. So in normal installations it won't be, but
- # if we are installing a relocated package it is texmf-dist/tlpkg
- # which will be (hopefully) empty
- rmdir($tlpkgdir) if (-d "$tlpkgdir");
- }
- }
- # 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
- # and unset the relocated setting
- # before we save it to the local tlpdb
- if ($tlpobj->relocated) {
- $tlpobj->cancel_reloc_prefix;
- $tlpobj->relocated(0);
- }
- # we have to write out the tlpobj file since it is contained in the
- # archives (.tar.xz) but at DVD install time we don't have them
- my $tlpod = $totlpdb->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);
- $totlpdb->add_tlpobj($tlpobj);
- $totlpdb->save;
- # compute the return value
- TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
- if (!$nopostinstall) {
- # 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,
- $totlpdb->option("file_assocs"),
- $totlpdb->option("desktop_integration"),
- $totlpdb->option("desktop_integration"),
- $totlpdb->option("post_code"));
- }
- }
- return 1;
-}
-
-#
-# _install_package
-# actually does the installation work
-# returns 1 on success and 0 on error
-#
-sub _install_package {
- my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
-
- my $media = $self->media;
- my $target = $totlpdb->root;
- my $tempdir = "$target/temp";
-
- my @filelist = @$filelistref;
-
- # we assume that $::progs has been set up!
- my $wget = $::progs{'wget'};
- my $xzdec = $::progs{'xzdec'};
- if (!defined($wget) || !defined($xzdec)) {
- tlwarn("_install_package: programs not set up properly, strange.\n");
- return(0);
- }
-
- if (ref $what) {
- # we are getting a ref to a list of files, so install from DVD
- my $location = $self->location;
- foreach my $file (@$what) {
- # @what is taken, not @filelist!
- # is this still needed?
- my $dn=dirname($file);
- mkdirhier("$target/$dn");
- copy "$location/$file", "$target/$dn";
- }
- # 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;
- $xzfile_quote = "\"$xzfile\"";
- $tarfile =~ s!/!\\!g;
- $tarfile_quote = "\"$tarfile\"";
- $target =~ s!/!\\!g;
- $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
- 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 $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;
- } else {
- tlwarn("_install_package: Don't know how to install $what\n");
- return(0);
- }
-}
-
-#
-# remove_package removes a single package with all files (including the
-# # tlpobj files) and the entry from the tlpdb.
-sub remove_package {
- my ($self, $pkg, %opts) = @_;
- my $localtlpdb = $self->tlpdb;
- my $tlp = $localtlpdb->get_package($pkg);
- if (!defined($tlp)) {
- tlwarn ("$pkg: package not present, cannot remove\n");
- } else {
- my $currentarch = $self->platform();
- if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") {
- log ("Not removing $pkg, it is essential!\n");
- return 0;
- }
- # we have to chdir to $localtlpdb->root
- my $Master = $localtlpdb->root;
- chdir ($Master) || die "chdir($Master) failed: $!";
- my @files = $tlp->all_files;
- # also remove the .tlpobj file
- push @files, "tlpkg/tlpobj/$pkg.tlpobj";
- # and the ones from src/doc splitting
- if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
- push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
- }
- if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
- push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
- }
- #
- # some packages might be relocated, thus having the RELOC prefix
- # in user mode we just remove the prefix, in normal mode we
- # replace it with texmf-dist
- # since we don't have user mode
- if ($tlp->relocated) {
- for (@files) {
- s:^$RelocPrefix/:$RelocTree/:;
- }
- }
- #
- # we want to check that a file is only listed in one package, so
- # in case that a file to be removed is listed in another package
- # we will warn and *not* remove it
- my %allfiles;
- for my $p ($localtlpdb->list_packages) {
- next if ($p eq $pkg); # we have to skip the to be removed package
- for my $f ($localtlpdb->get_package($p)->all_files) {
- $allfiles{$f} = $p;
- }
- }
- my @goodfiles = ();
- my @badfiles = ();
- my @debugfiles = ();
- for my $f (@files) {
- # in usermode we have to add texmf-dist again for comparison
- if (defined($allfiles{$f})) {
- # this file should be removed but is mentioned somewhere, too
- # take into account if we got a warn list
- if (defined($opts{'remove-warn-files'})) {
- my %a = %{$opts{'remove-warn-files'}};
- if (defined($a{$f})) {
- push @badfiles, $f;
- } else {
- # NO NOTHING HERE!!!
- # DON'T PUSH IT ON @goodfiles, it will be removed, which we do
- # NOT want. We only want to supress the warning!
- push @debugfiles, $f;
- }
- } else {
- push @badfiles, $f;
- }
- } else {
- push @goodfiles, $f;
- }
- }
- if ($#debugfiles >= 0) {
- debug("The following files will not be removed due to the removal of $pkg.\n");
- debug("But we do not warn on it because they are moved to other packages.\n");
- for my $f (@debugfiles) {
- debug(" $f - $allfiles{$f}\n");
- }
- }
- if ($#badfiles >= 0) {
- # warn the user
- tlwarn("The following files should be removed due to the removal of $pkg,\n");
- tlwarn("but are part of another package, too.\n");
- for my $f (@badfiles) {
- tlwarn(" $f - $allfiles{$f}\n");
- }
- }
- #
- # Run only the postaction code thing now since afterwards the
- # files will be gone ...
- if (defined($opts{'nopostinstall'}) && $opts{'nopostinstall'}) {
- &TeXLive::TLUtils::do_postaction("remove", $tlp,
- 0, # option_file_assocs,
- 0, # option_desktop_integration, menu part
- 0, # option_desktop_integration, desktop part
- $localtlpdb->option("post_code"));
- }
- #
- my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
- # now do the removal
- for my $entry (@goodfiles) {
- unlink $entry;
- }
- for my $d (@removals) {
- rmdir $d;
- }
- $localtlpdb->remove_package($pkg);
- TeXLive::TLUtils::announce_execute_actions("disable", $tlp);
- # should we save at each removal???
- # advantage: the tlpdb actually reflects what is installed
- # disadvantage: removing a collection calls the save routine several times
- # still I consider it better that the tlpdb is in a consistent state
- $localtlpdb->save;
- #
- # 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() && !$localtlpdb->option("w32_multi_user")) {
- non_admin();
- }
- #
- # Run the post installation code in the postaction tlpsrc entries
- # the postaction code part cannot be evaluated now since the
- # files are already removed.
- # Again, desktop integration maps to desktop and menu links
- if (!$nopostinstall) {
- &TeXLive::TLUtils::do_postaction("remove", $tlp,
- $localtlpdb->option("file_assocs"),
- $localtlpdb->option("desktop_integration"),
- $localtlpdb->option("desktop_integration"),
- 0);
- }
- }
- return 1;
-}
-
-
-# member access functions
-#
-sub media { my $self = shift ; return $self->{'media'}; }
-sub location { my $self = shift ; return $self->{'location'}; }
-sub tlpdb { my $self = shift ; return $self->{'tlpdb'}; }
-sub release { my $self = shift ; return $self->{'release'}; }
-sub all_collections { my $self = shift; return @{ $self->{'all_collections'} }; }
-sub std_collections { my $self = shift; return @{ $self->{'std_collections'} }; }
-sub lang_collections { my $self = shift; return @{ $self->{'lang_collections'} }; }
-sub lang_doc_collections { my $self = shift; return @{ $self->{'lang_doc_collections'} }; }
-sub schemes { my $self = shift; return @{ $self->{'schemes'} }; }
-sub systems { my $self = shift; return @{ $self->{'systems'} }; }
-
-# deduce the platform of the referenced media as follows:
-# - if the $tlpdb->setting("platform") is there it overrides the detected
-# setting
-# - if it is not there call TLUtils::platform()
-sub platform {
- # try to deduce the platform
- my $self = shift;
- my $tlpdb = $self->tlpdb;
- if (defined($tlpdb)) {
- my $ret = $tlpdb->setting("platform");
- return $ret if defined $ret;
- }
- # the platform setting wasn't found in the tlpdb, try TLUtils::platform
- return TeXLive::TLUtils::platform();
-}
-
-1;
-__END__
-
-
-=head1 NAME
-
-C<TeXLive::TLMedia> -- TeX Live Media module
-
-=head1 SYNOPSIS
-
- use TeXLive::TLMedia;
-
- my $tlneo = TeXLive::TLMedia->new('http://www.ctan.org/mirror/tl/');
- my $tlcd = TeXLive::TLMedia->new('/mnt/tl-cd/');
- my $tldvd = TeXLive::TLMedia->new('/mnt/tl-dvd/');
-
-=head1 DESCRIPTION
-
-missing
-
-=head1 MEMBER ACCESS FUNCTIONS
-
-scalars: media, location, tlpdb, release
-lists: all_collections, std_collections, lang_collections, lang_doc_collections,
-schemes, systems
-
-=head1 SEE ALSO
-
-The modules L<TeXLive::TLConfig>, L<TeXLive::TLUtils>, L<TeXLive::TLPOBJ>,
-L<TeXLive::TLPDB>, L<TeXLive::TLTREE>.
-
-=head1 AUTHORS AND COPYRIGHT
-
-This script and its documentation were written for the TeX Live
-distribution (L<http://tug.org/texlive>) and both are licensed under the
-GNU General Public License Version 2 or later.
-
-=cut
-
-### Local Variables:
-### perl-indent-level: 2
-### tab-width: 2
-### indent-tabs-mode: nil
-### End:
-# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 010888ae0da..c8d7b4b0ea4 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -36,11 +36,12 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$tlpdb->writeout;
$tlpdb->writeout(FILEHANDLE);
$tlpdb->save;
+ $tlpdb->media;
$tlpdb->available_architectures();
$tlpdb->add_tlpcontainer($pkg, $ziploc [, $archrefs [, $dest ]] );
$tlpdb->add_tlpobj($tlpobj);
$tlpdb->needed_by($pkg);
- $tlpdb->remove_package($pkg);
+ $tlpdb->remove_tlpobj($pkg);
$tlpdb->get_package("packagename");
$tlpdb->list_packages;
$tlpdb->expand_dependencies(["-only-arch",] $totlpdb, @list);
@@ -55,6 +56,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$tlpdb->language_lua_lines;
$tlpdb->package_revision("packagename");
$tlpdb->location;
+ $tlpdb->platform;
$tlpdb->config_src_container;
$tlpdb->config_doc_container;
$tlpdb->config_container_format;
@@ -68,6 +70,9 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$tlpdb->settings;
$tlpdb->setting($key, [$value]);
$tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
+ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
+ $tlpdb->remove_package($pkg, %options);
+
TeXLive::TLPDB->listdir([$dir]);
$tlpdb->generate_listfiles([$destdir]);
@@ -79,8 +84,8 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
$DatabaseName $MetaCategoriesRegexp $Archive
%TLPDBOptions %TLPDBSettings);
-use TeXLive::TLUtils qw(dirname mkdirhier member win32 info debug ddebug
- tlwarn);
+use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
+ tlwarn basename download_file merge_into);
use TeXLive::TLPOBJ;
use Cwd 'abs_path';
@@ -116,6 +121,15 @@ sub new {
};
$_listdir = $params{'listdir'} if defined($params{'listdir'});
bless $self, $class;
+ if (defined($params{'tlpdbfile'})) {
+ my $nr_packages_read
+ = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+ if ($nr_packages_read == 0) {
+ # that is bad, we didn't read anything, so return undef.
+ return undef;
+ }
+ return $self;
+ }
if (defined($self->{'root'})) {
my $nr_packages_read
= $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
@@ -185,14 +199,14 @@ sub needed_by {
=pod
-=item C<< $tlpdb->remove_package($pkg) >>
+=item C<< $tlpdb->remove_tlpobj($pkg) >>
Remove the package named C<$pkg> from the tlpdb. Gives a warning if the
package is not present
=cut
-sub remove_package {
+sub remove_tlpobj {
my ($self,$pkg) = @_;
if (defined($self->{'tlps'}{$pkg})) {
delete $self->{'tlps'}{$pkg};
@@ -228,6 +242,27 @@ sub from_file {
}
my $retfh;
my $tlpdbfile;
+ # do media detection
+ my $rootpath = $self->root;
+ if ($rootpath =~ m,http://|ftp://,) {
+ $media = 'NET';
+ } else {
+ if ($rootpath =~ m,file://*(.*)$,) {
+ $rootpath = "/$1";
+ }
+ if (-d "$rootpath/texmf/web2c") {
+ $media = 'local_uncompressed';
+ } elsif (-d "$rootpath/$Archive") {
+ $media = 'local_compressed';
+ } else {
+ # we cannot find the right type, return undefined, that should
+ # make people notice
+ return 0;
+ }
+ }
+ $self->{'media'} = $media;
+ #
+ # actually load the TLPDB
if ($path =~ m;^((http|ftp)://|file:\/\/*);) {
debug("TLPDB.pm: trying to initialize from $path\n");
# if we have xzdec available we try the xz file
@@ -349,6 +384,19 @@ sub save {
=pod
+=item C<< $tlpdb->media >>
+
+Returns the media code the respective installation resides on.
+
+=cut
+
+sub media {
+ my $self = shift ;
+ return $self->{'media'};
+}
+
+=pod
+
=item C<< $tlpdb->available_architectures >>
The C<available_architectures> functions returns the list of available
@@ -640,10 +688,11 @@ package named in the first argument.
sub package_revision {
my ($self,$pkg) = @_;
- if (defined($self->{'tlps'}{$pkg})) {
- return($self->{'tlps'}{$pkg}->revision);
+ my $tlp = $self->get_package($pkg);
+ if (defined($tlp)) {
+ return $tlp->revision;
} else {
- return(undef);
+ return;
}
}
@@ -661,9 +710,9 @@ available architectures as packages with revision number -1.
sub generate_packagelist {
my $self = shift;
my $fd = (@_ ? $_[0] : STDOUT);
- foreach (sort keys %{$self->{'tlps'}}) {
- print $fd $self->{'tlps'}{$_}->name, " ",
- $self->{'tlps'}{$_}->revision, "\n";
+ foreach (sort $self->list_packages) {
+ print $fd $self->get_package($_)->name, " ",
+ $self->get_package($_)->revision, "\n";
}
foreach ($self->available_architectures) {
print $fd "$_ -1\n";
@@ -686,8 +735,8 @@ sub generate_listfiles {
if (not(defined($destdir))) {
$destdir = TeXLive::TLPDB->listdir;
}
- foreach (sort keys %{$self->{'tlps'}}) {
- $tlp = $self->{'tlps'}{$_};
+ foreach (sort $self->list_package) {
+ $tlp = $self->get_package($_);
$self->_generate_listfile($tlp, $destdir);
}
}
@@ -833,6 +882,27 @@ sub location {
=pod
+=item C<< $tlpdb->platform >>
+
+returns the platform of this installation.
+
+=cut
+
+# deduce the platform of the referenced media as follows:
+# - if the $tlpdb->setting("platform") is there it overrides the detected
+# setting
+# - if it is not there call TLUtils::platform()
+sub platform {
+ # try to deduce the platform
+ my $self = shift;
+ my $ret = $self->setting("platform");
+ return $ret if defined $ret;
+ # the platform setting wasn't found in the tlpdb, try TLUtils::platform
+ return TeXLive::TLUtils::platform();
+}
+
+=pod
+
=item C<< $tlpdb->listdir >>
The function C<listdir> allows to read and set the packages variable
@@ -986,21 +1056,7 @@ which contains the total size of all packages under discussion.
sub sizes_of_packages {
my ($self, $opt_src, $opt_doc, @packs) = @_;
@packs || ( @packs = $self->list_packages() );
- my $root = $self->root;
- my $media;
- if ($root =~ m!^(ctan$|(http|ftp)://)!i) {
- $media = 'NET';
- } else {
- $root =~ s!file://*!/!i;
- $root = abs_path($root);
- if (-d "$root/$Archive") {
- $media = 'local_compressed';
- } elsif (-d "$root/texmf/web2c") {
- $media = 'local_uncompressed';
- } else {
- die "$0: that should not happen, no proper location found!";
- }
- }
+ my $media = $self->media;
my %tlpsizes;
my %tlpobjs;
my $totalsize;
@@ -1010,23 +1066,7 @@ sub sizes_of_packages {
warn "STRANGE: $p not to be found in ", $self->root;
next;
}
- if ($media ne 'local_uncompressed') {
- # we use the container size as the measuring unit since probably
- # downloading will be the limiting factor
- $tlpsizes{$p} = $tlpobjs{$p}->containersize;
- $tlpsizes{$p} += $tlpobjs{$p}->srccontainersize if $opt_src;
- $tlpsizes{$p} += $tlpobjs{$p}->doccontainersize if $opt_doc;
- } else {
- # we have to add the respective sizes, that is checking for
- # installation of src and doc file
- $tlpsizes{$p} = $tlpobjs{$p}->runsize;
- $tlpsizes{$p} += $tlpobjs{$p}->srcsize if $opt_src;
- $tlpsizes{$p} += $tlpobjs{$p}->docsize if $opt_doc;
- my %foo = %{$tlpobjs{$p}->binsize};
- for my $k (keys %foo) { $tlpsizes{$p} += $foo{$k}; }
- # all the packages sizes are in blocks, so transfer that to bytes
- $tlpsizes{$p} *= $TeXLive::TLConfig::BlockSize;
- }
+ $tlpsizes{$p} = $self->size_of_one_package($media, $tlpobjs{$p}, $opt_src, $opt_doc);
$totalsize += $tlpsizes{$p};
}
if ($totalsize) {
@@ -1035,7 +1075,456 @@ sub sizes_of_packages {
return \%tlpsizes;
}
+sub size_of_one_package {
+ my ($self, $media, $tlpobj, $opt_src, $opt_doc) = @_;
+ my $size = 0;
+ if ($media ne 'local_uncompressed') {
+ # we use the container size as the measuring unit since probably
+ # downloading will be the limiting factor
+ $size = $tlpobj->containersize;
+ $size += $tlpobj->srccontainersize if $opt_src;
+ $size += $tlpobj->doccontainersize if $opt_doc;
+ } else {
+ # we have to add the respective sizes, that is checking for
+ # installation of src and doc file
+ $size = $tlpobj->runsize;
+ $size += $tlpobj->srcsize if $opt_src;
+ $size += $tlpobj->docsize if $opt_doc;
+ my %foo = %{$tlpobj->binsize};
+ for my $k (keys %foo) { $size += $foo{$k}; }
+ # all the packages sizes are in blocks, so transfer that to bytes
+ $size *= $TeXLive::TLConfig::BlockSize;
+ }
+ return $size;
+}
+
+=pod
+=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >>
+
+Installs the package $pkg into $dest_tlpdb.
+
+=cut
+
+sub install_package {
+ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
+ my $fromtlpdb = $self;
+ my $ret;
+ die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
+ my $tlpobj = $fromtlpdb->get_package($pkg);
+ if (!defined($tlpobj)) {
+ if (defined($fallbackmedia)) {
+ if ($ret = $fallbackmedia->install_package($pkg,$totlpdb, $nopostinstall)) {
+ debug("installed $pkg from fallback\n");
+ return $ret;
+ } else {
+ tlwarn("$0: Cannot find package $pkg (in fallback, either)\n");
+ return 0;
+ }
+ } else {
+ tlwarn("$0: Cannot find package $pkg\n");
+ return 0;
+ }
+ } else {
+ my $container_src_split = $fromtlpdb->config_src_container;
+ my $container_doc_split = $fromtlpdb->config_doc_container;
+ # get options about src/doc splitting from $totlpdb
+ my $opt_src = $totlpdb->option("install_srcfiles");
+ my $opt_doc = $totlpdb->option("install_docfiles");
+ my $real_opt_doc = $opt_doc;
+ my $reloc = 1 if $tlpobj->relocated;
+ my $container;
+ my @installfiles;
+ my $root = $self->root;
+ # make sure that there is no terminal / in $root, otherwise we
+ # will get double // somewhere
+ $root =~ s!/$!!;
+ foreach ($tlpobj->runfiles) {
+ # s!^!$root/!;
+ push @installfiles, $_;
+ }
+ foreach ($tlpobj->allbinfiles) {
+ # s!^!$root/!;
+ push @installfiles, $_;
+ }
+ if ($opt_src) {
+ foreach ($tlpobj->srcfiles) {
+ # s!^!$root/!;
+ push @installfiles, $_;
+ }
+ }
+ if ($real_opt_doc) {
+ foreach ($tlpobj->docfiles) {
+ # s!^!$root/!;
+ push @installfiles, $_;
+ }
+ }
+ my $media = $self->media;
+ if ($media eq 'local_uncompressed') {
+ $container = \@installfiles;
+ } elsif ($media eq 'local_compressed') {
+ if (-r "$root/$Archive/$pkg.zip") {
+ $container = "$root/$Archive/$pkg.zip";
+ } elsif (-r "$root/$Archive/$pkg.tar.xz") {
+ $container = "$root/$Archive/$pkg.tar.xz";
+ } else {
+ tlwarn("Cannot find a package $pkg (.zip or .xz) in $root/$Archive\n");
+ next;
+ }
+ } elsif (&media eq 'NET') {
+ $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
+ }
+ $self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
+ || return(0);
+ # if we are installing from local_compressed or NET 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 because it would mean that
+ # texlive.infra.doc.tar.xz
+ # will never be installed, and we do already check that there
+ # are at all src/doc files, which in split packages of the form
+ # foo.ARCH are not present. And if they are present, than that is fine,
+ # too (bin-foobar.win32.doc.tar.xz)
+ # - 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/;
+ $self->_install_package ($srccontainer, $reloc, \@installfiles, $totlpdb)
+ || return(0);
+ }
+ if ($container_doc_split && $real_opt_doc && $tlpobj->docfiles) {
+ my $doccontainer = $container;
+ $doccontainer =~ s/(\.tar\.xz|\.zip)$/.doc$1/;
+ $self->_install_package ($doccontainer, $reloc, \@installfiles, $totlpdb)
+ || return(0);
+ }
+ #
+ # if we installed from NET/local_compressed and we got a relocatable container
+ # make sure that the stray texmf-dist/tlpkg directory is removed
+ # in USER MODE that should NOT be done because we keep the information
+ # there, but for now do it unconditionally
+ if ($tlpobj->relocated) {
+ my $reloctree = $totlpdb->root . "/" . $TeXLive::TLConfig::RelocTree;
+ my $tlpkgdir = $reloctree . "/" . $TeXLive::TLConfig::InfraLocation;
+ my $tlpod = $tlpkgdir . "/tlpobj";
+ TeXLive::TLUtils::rmtree($tlpod) if (-d $tlpod);
+ # we try to remove the tlpkg directory, that will succeed only
+ # if it is empty. So in normal installations it won't be, but
+ # if we are installing a relocated package it is texmf-dist/tlpkg
+ # which will be (hopefully) empty
+ rmdir($tlpkgdir) if (-d "$tlpkgdir");
+ }
+ }
+ # 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
+ # and unset the relocated setting
+ # before we save it to the local tlpdb
+ if ($tlpobj->relocated) {
+ $tlpobj->cancel_reloc_prefix;
+ $tlpobj->relocated(0);
+ }
+ # we have to write out the tlpobj file since it is contained in the
+ # archives (.tar.xz) but at DVD install time we don't have them
+ my $tlpod = $totlpdb->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);
+ $totlpdb->add_tlpobj($tlpobj);
+ $totlpdb->save;
+ # compute the return value
+ TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
+ if (!$nopostinstall) {
+ # 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,
+ $totlpdb->option("file_assocs"),
+ $totlpdb->option("desktop_integration"),
+ $totlpdb->option("desktop_integration"),
+ $totlpdb->option("post_code"));
+ }
+ }
+ return 1;
+}
+
+#
+# _install_package
+# actually does the installation work
+# returns 1 on success and 0 on error
+#
+sub _install_package {
+ my ($self, $what, $reloc, $filelistref, $totlpdb) = @_;
+
+ my $media = $self->media;
+ my $target = $totlpdb->root;
+ my $tempdir = "$target/temp";
+
+ my @filelist = @$filelistref;
+
+ # we assume that $::progs has been set up!
+ my $wget = $::progs{'wget'};
+ my $xzdec = $::progs{'xzdec'};
+ if (!defined($wget) || !defined($xzdec)) {
+ tlwarn("_install_package: programs not set up properly, strange.\n");
+ return(0);
+ }
+
+ if (ref $what) {
+ # we are getting a ref to a list of files, so install from DVD
+ my $root = $self->root;
+ foreach my $file (@$what) {
+ # @what is taken, not @filelist!
+ # is this still needed?
+ my $dn=dirname($file);
+ mkdirhier("$target/$dn");
+ TeXLive::TLUtils::copy "$root/$file", "$target/$dn";
+ }
+ # 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;
+ $xzfile_quote = "\"$xzfile\"";
+ $tarfile =~ s!/!\\!g;
+ $tarfile_quote = "\"$tarfile\"";
+ $target =~ s!/!\\!g;
+ $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 $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;
+ } else {
+ tlwarn("_install_package: Don't know how to install $what\n");
+ return(0);
+ }
+}
+
+=pod
+
+=item << $tlpdb->remove_package($pkg, %options) >>
+
+removes a single pacakge with all the files and the entry in the db.
+
+=cut
+
+#
+# remove_package removes a single package with all files (including the
+# # tlpobj files) and the entry from the tlpdb.
+sub remove_package {
+ my ($self, $pkg, %opts) = @_;
+ my $localtlpdb = $self;
+ my $tlp = $localtlpdb->get_package($pkg);
+ if (!defined($tlp)) {
+ tlwarn ("$pkg: package not present, cannot remove\n");
+ } else {
+ my $currentarch = $self->platform();
+ if ($pkg eq "texlive.infra" || $pkg eq "texlive.infra.$currentarch") {
+ log ("Not removing $pkg, it is essential!\n");
+ return 0;
+ }
+ # we have to chdir to $localtlpdb->root
+ my $Master = $localtlpdb->root;
+ chdir ($Master) || die "chdir($Master) failed: $!";
+ my @files = $tlp->all_files;
+ # also remove the .tlpobj file
+ push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+ # and the ones from src/doc splitting
+ if (-r "tlpkg/tlpobj/$pkg.source.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.source.tlpobj";
+ }
+ if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+ }
+ #
+ # some packages might be relocated, thus having the RELOC prefix
+ # in user mode we just remove the prefix, in normal mode we
+ # replace it with texmf-dist
+ # since we don't have user mode
+ if ($tlp->relocated) {
+ for (@files) {
+ s:^$RelocPrefix/:$RelocTree/:;
+ }
+ }
+ #
+ # we want to check that a file is only listed in one package, so
+ # in case that a file to be removed is listed in another package
+ # we will warn and *not* remove it
+ my %allfiles;
+ for my $p ($localtlpdb->list_packages) {
+ next if ($p eq $pkg); # we have to skip the to be removed package
+ for my $f ($localtlpdb->get_package($p)->all_files) {
+ $allfiles{$f} = $p;
+ }
+ }
+ my @goodfiles = ();
+ my @badfiles = ();
+ my @debugfiles = ();
+ for my $f (@files) {
+ # in usermode we have to add texmf-dist again for comparison
+ if (defined($allfiles{$f})) {
+ # this file should be removed but is mentioned somewhere, too
+ # take into account if we got a warn list
+ if (defined($opts{'remove-warn-files'})) {
+ my %a = %{$opts{'remove-warn-files'}};
+ if (defined($a{$f})) {
+ push @badfiles, $f;
+ } else {
+ # NO NOTHING HERE!!!
+ # DON'T PUSH IT ON @goodfiles, it will be removed, which we do
+ # NOT want. We only want to supress the warning!
+ push @debugfiles, $f;
+ }
+ } else {
+ push @badfiles, $f;
+ }
+ } else {
+ push @goodfiles, $f;
+ }
+ }
+ if ($#debugfiles >= 0) {
+ debug("The following files will not be removed due to the removal of $pkg.\n");
+ debug("But we do not warn on it because they are moved to other packages.\n");
+ for my $f (@debugfiles) {
+ debug(" $f - $allfiles{$f}\n");
+ }
+ }
+ if ($#badfiles >= 0) {
+ # warn the user
+ tlwarn("The following files should be removed due to the removal of $pkg,\n");
+ tlwarn("but are part of another package, too.\n");
+ for my $f (@badfiles) {
+ tlwarn(" $f - $allfiles{$f}\n");
+ }
+ }
+ #
+ # Run only the postaction code thing now since afterwards the
+ # files will be gone ...
+ if (defined($opts{'nopostinstall'}) && $opts{'nopostinstall'}) {
+ &TeXLive::TLUtils::do_postaction("remove", $tlp,
+ 0, # option_file_assocs,
+ 0, # option_desktop_integration, menu part
+ 0, # option_desktop_integration, desktop part
+ $localtlpdb->option("post_code"));
+ }
+ #
+ my @removals = &TeXLive::TLUtils::removed_dirs (@goodfiles);
+ # now do the removal
+ for my $entry (@goodfiles) {
+ unlink $entry;
+ }
+ for my $d (@removals) {
+ rmdir $d;
+ }
+ $localtlpdb->remove_tlpobj($pkg);
+ TeXLive::TLUtils::announce_execute_actions("disable", $tlp);
+ # should we save at each removal???
+ # advantage: the tlpdb actually reflects what is installed
+ # disadvantage: removing a collection calls the save routine several times
+ # still I consider it better that the tlpdb is in a consistent state
+ $localtlpdb->save;
+ #
+ # 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() && !$localtlpdb->option("w32_multi_user")) {
+ non_admin();
+ }
+ #
+ # Run the post installation code in the postaction tlpsrc entries
+ # the postaction code part cannot be evaluated now since the
+ # files are already removed.
+ # Again, desktop integration maps to desktop and menu links
+ if (!$nopostinstall) {
+ &TeXLive::TLUtils::do_postaction("remove", $tlp,
+ $localtlpdb->option("file_assocs"),
+ $localtlpdb->option("desktop_integration"),
+ $localtlpdb->option("desktop_integration"),
+ 0);
+ }
+ }
+ return 1;
+}
=pod
@@ -1080,7 +1569,7 @@ sub _set_value_pkg {
}
}
$pkg->depends(@newdeps);
- $self->{'tlps'}{$pkgname} = $pkg;
+ $self->add_tlpobj($pkg);
}
sub _option_value {