summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2011-04-27 16:01:23 +0000
committerNorbert Preining <preining@logic.at>2011-04-27 16:01:23 +0000
commite6fdf875e91bf1013e861b2ef46db6b43dda1a61 (patch)
treeb311ece82cb3182efd6b434f88ef8f672145a6fd /Master/tlpkg/dev
parent73cbc642103524865daca10dcc65aa47907dc8dd (diff)
add various new dev patches
git-svn-id: svn://tug.org/texlive/trunk@22220 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/dev')
-rw-r--r--Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README20
-rw-r--r--Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch1516
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.README169
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.patch757
4 files changed, 2462 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README
new file mode 100644
index 00000000000..5392fb9ce9d
--- /dev/null
+++ b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.README
@@ -0,0 +1,20 @@
+merge-tlmedia-into-tlpdb-and-get-rid-of-it
+
+purpose of this patch is to get rid of TLMedia again, as it was an
+interesting idea but created only much pain due to duplications
+of variables, as we always had to use the tlpdb also directly.
+
+This patch moves the two genuine functions from TLMedia
+ install_package
+ remove_package
+and related/needed functions into TLPDB.
+
+In this course also the naming of the various variables has changed, now
+there is only
+ remotetlpdb
+ subsuming the former tlmediatlpdb, tlmediasrc
+ localtlpdb
+ subsuming the former localtlmedia, localtlpdb
+
+
+
diff --git a/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch
new file mode 100644
index 00000000000..ad89630bbed
--- /dev/null
+++ b/Master/tlpkg/dev/dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it.patch
@@ -0,0 +1,1516 @@
+Index: tlpkg/TeXLive/TLPDB.pm
+===================================================================
+--- tlpkg/TeXLive/TLPDB.pm (revision 22215)
++++ tlpkg/TeXLive/TLPDB.pm (working copy)
+@@ -36,11 +36,12 @@
+ $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 @@
+ $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,7 +70,10 @@
+ $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 @@
+ 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 @@
+ };
+ $_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 @@
+
+ =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 @@
+ }
+ 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 @@
+
+ =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 @@
+
+ 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 @@
+ 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 @@
+ 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 @@
+
+ =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 @@
+ 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 @@
+ 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,11 +1075,461 @@
+ 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;
++ print "LOCATION = $root\n";
++ # 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
++
+ =item C<< $tlpdb->option($key [, $val]) >>
+ =item C<< $tlpdb->setting($key [, $val]) >>
+
+@@ -1080,7 +1570,7 @@
+ }
+ }
+ $pkg->depends(@newdeps);
+- $self->{'tlps'}{$pkgname} = $pkg;
++ $self->add_tlpobj($pkg);
+ }
+
+ sub _option_value {
+Index: texmf/scripts/texlive/tlmgr.pl
+===================================================================
+--- texmf/scripts/texlive/tlmgr.pl (revision 22215)
++++ texmf/scripts/texlive/tlmgr.pl (working copy)
+@@ -77,7 +77,6 @@
+ use strict;
+
+ use TeXLive::TLConfig;
+-use TeXLive::TLMedia;
+ use TeXLive::TLPDB;
+ use TeXLive::TLPOBJ;
+ use TeXLive::TLUtils;
+@@ -92,10 +91,8 @@
+ 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 @@
+ $::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 @@
+ 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 @@
+ 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 @@
+ 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 @@
+ @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 @@
+ # - 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 @@
+ 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 @@
+ init_local_db();
+ if ($opts{"global"}) {
+ init_tlmedia();
+- $tlpdb = $tlmediasrc->tlpdb;
++ $tlpdb = $remotetlpdb;
+ } else {
+ $tlpdb = $localtlpdb;
+ }
+@@ -1409,8 +1405,8 @@
+ 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 @@
+ 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 @@
+ }
+ 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 @@
+ #
+ 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 @@
+ # 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 @@
+ # 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 @@
+ # 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 @@
+
+ # 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 @@
+
+ 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 @@
+ 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 @@
+ 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 @@
+ # 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 @@
+ }
+ }
+ 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 @@
+ 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 @@
+ clear_old_backups($p, $opts{"backupdir"}, $autobackup);
+ }
+ }
+- $localtlmedia->remove_package($p);
++ $localtlpdb->remove_package($p);
+ logpackage("remove: $p");
+ }
+ $currnr++;
+@@ -2572,7 +2567,7 @@
+ 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 @@
+ 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 @@
+ $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 @@
+ 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 @@
+ $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 @@
+ 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 @@
+ 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 @@
+ # 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 @@
+ # . 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 @@
+
+ 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 @@
+ 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 @@
+ 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 @@
+ 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 @@
+ }
+ 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 @@
+ } 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 @@
+ $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 @@
+ } 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 @@
+ 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 @@
+ # 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 @@
+ 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 @@
+ 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 @@
+ 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 @@
+ }
+ 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 @@
+
+ # 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 @@
+ # 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 @@
+ }
+
+
+-# 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 @@
+ 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 @@
+ 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 @@
+ # 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 @@
+ 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 @@
+ }
+
+ # 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 @@
+ &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);
+ }
+ }
+Index: texmf/scripts/texlive/tlmgrgui.pl
+===================================================================
+--- texmf/scripts/texlive/tlmgrgui.pl (revision 22210)
++++ texmf/scripts/texlive/tlmgrgui.pl (working copy)
+@@ -53,9 +53,7 @@
+ #
+ # 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 @@
+ $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 @@
+ ############# 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 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 @@
+ 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 @@
+ 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/dev/dev.multi-source-support-v2.README b/Master/tlpkg/dev/dev.multi-source-support-v2.README
new file mode 100644
index 00000000000..513b8daf5c5
--- /dev/null
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.README
@@ -0,0 +1,169 @@
+Multi source support in TeX Live v2
+-----------------------------------
+(Work in progress)
+
+[needs dev.merge-tlmedia-into-tlpdb-and-get-rid-of-it !!!! ]
+
+v2 of this patches has changed completely the idea of implementation.
+Background of the new idea is to leave the code base of tlmgr.pl itself
+as untouched as possible, and merge everything into TLPDB. TLPDBs can
+now either be a normal one as before, or a virtual one, collection
+different sources.
+
+(completely independent from generalized revisions)
+[karl: good.]
+
+1) extension of the location part in 00texlive.installation
+-----------------------------------------------------------
+
+The opt_location: line in 00texlive.installation normally gives the
+repository to be used. It can now contain a list of repositories in the
+form
+ repo1[#tag1] repo2[#tag2] ...
+
+Management of these items is thorugh
+ tlmgr repository
+action.
+ tlmgr repository list
+ tlmgr repository add repo [tag]
+ tlmgr repository remove name
+If no tag is given then internally (but not in the tlpdb) the tag
+and the repo path is the same.
+
+Removing is done by entering the tag (not the repo), but if no tags were
+given that is the same.
+
+
+If there are more than one tag, then there has to be one tagged
+ main
+which is the main repository.
+
+By default, if you start with only one entry (as before, the main),
+and add a new one, the tag "main" is automatically added to the
+previous tag to make all run smooth.
+
+THe repo at "main" is used for various settings, the main configuration
+options, etc etc. Idea is still that everyone has the main repo CTAN
+(or mirror or ...), and can add some sub-repos.
+
+Old discussion:
+
+[karl: how do these lines get added? tool, manual editing of tlpdb?]
+[norbert: tlmgr location url1 url2=tag1 url3 url4=tag2 ...
+ # sets url1, url2 with tag tag1, url3, and url4 with tag2
+ # as the list of available locations
+ # backward compatibility with former usage
+ tlmgr location add ...
+ # adds locations to the list of available locs
+ tlmgr location remove ...
+ # removes locations ...
+]
+[k2: well, there is no "location" action now, so compatibility isn't an issue.
+having this new action seems like a good idea. tlmgr option location foo
+will just become a synonm for tlmgr location add foo. yes?]
+
+2) invocation of tlmgr/installation
+-----------------------------------
+
+Normally tlmgr will install the candidate with the highest revision number.
+
+This is controlled by
+ TLPDB::virtual_candidate
+For now the policy is the highest rev number, but we can add later
+different policies.
+
+[karl: ok, given pinning below. otherwise i don't like it.]
+[norbert: Why, can you explain why you don't like that the highest revision
+ number wins?]
+[k2: because it is random, except in the one case where you want to use
+ it. that is, i understand that you want to copy a tl package, make
+ some local fixes, and install it locally, keeping track of the rev
+ number. that's fine for you. but there's no way most people are
+ going to bother with that. if mojca sets up a context repo, say,
+ those revision numbers are (should be) completely independent of tl's
+ revision numbers. therefore, all the context packages should be
+ pinned to the context repo, so the context repo always wins. without
+ pinning, it would be an unmaintainable situation.]
+
+That will be achieved by
+ tlmgr install package
+
+[FOR NOW THE FOLLOWING IS NOT IMPLEMENTED!!]
+If you want to install a package from a specific mirror you can do
+ tlmgr install package/TAG
+ (tlmgr install package/SOURCE)
+where TAG is the tag given above, and SOURCE is the full source address.
+So continuing the above example we could call
+ tlmgr install package/department
+or
+ tlmgr install package/http://server.local.uni/texlive/packages
+(maybe we don't allow the later form ...?)
+[karl: well, if it's done, then I see no reason not to support it.]
+
+done
+
+[NOT IMPLEMENTED BY NOW]
+3) pinning
+----------
+
+tlmgr will evaluate an additional config file
+ ROOT/tlpkg/pinning
+or the one given via cmdline
+ tlmgr -pins /path/to/pinning/file
+[karl: maybe it should be found in texmf-local/tlpkg? look there
+ before ROOT/tlpkg but allow both? maybe other places too. have to think
+ about it. Also, the filename should be something clearer, perhaps
+ tlpkgpins.txt.]
+[norbert: agreed, that texmf-local might be a better place. should be
+ thought out]
+
+That file contains lines
+ package:tag:pin
+where package is a package name or * (or regexp? or glob context* eg?)
+[glob is better than regexp in this case I think]
+and tag is [a-z0-9,]+ as for tags above, or *,
+and pin is an integer between 0 and 1000.
+
+Now the evaluation *which* package will be installed will be done as follows:
+
+1) create the list of candidates, i.e., all tlpobj from different sources
+ where the name matches the one to be installed
+[karl: if a package is pinned to a single source (99% case, seems to
+ me), the other sources (e.g., default ctan) won't even be considered, right?]
+
+[norbert: well, it depends. There will be a default pin value of say 500,
+ and you can give pin values lower than 500 to prefer packages from other
+ sources, or higher pin values to prefer these sources]
+
+[k2: I understand there is all this flexibility, but that's not my
+point. I envision the single most common use of this (by far) to say
+"get package foo from my special location bar", where foo is a local
+font, or tlmgr from tlcritical. In these cases, the user will set a
+single location. And then it would be a waste of time for tlmgr to even
+consider looking at the default location (tlnet) for foo. It should not
+even be a candidate.]
+
+
+2) compute the pins of all the candidates
+
+3) if there are different pins cancel those candidates with a non-maximal pin
+ (i.e., let pin_max = max { pin(candidate) : candidate in candidates },
+ and new candidates are those with pin(candidate) = pin_max)
+
+4) within all the remaining candidates choose the one with the highest
+ revision number
+
+
+========================================
+
+Consequences of the above:
+- no source: part necessary in the revisions
+- packages can be pinned to a specific source, and will not be updated
+ even if another source ships a higher version number
+- no changes to the general server infrastructure are needed
+- default installations continue as before
+- normal installations with multiple sources but without pinning will
+ simply *do*the*right*thing*, namely install the highest revision number.
+[karl: it's unclear to me that that is the right thing, in general, but
+ I can see how it is the right thing in some cases, e.g., yours, so fine.]
+[norbert: see above ... I don't see the wrong point ;-) ]
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
new file mode 100644
index 00000000000..4b4949995b3
--- /dev/null
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
@@ -0,0 +1,757 @@
+--- /src/TeX/texlive-svn/Master/tlpkg/TeXLive/TLPDB.pm 2011-04-27 17:49:03.000000000 +0900
++++ tlpkg/TeXLive/TLPDB.pm 2011-04-27 17:49:50.000000000 +0900
+@@ -6,7 +6,7 @@
+
+ package TeXLive::TLPDB;
+
+-my $svnrev = '$Revision: 22215 $';
++my $svnrev = '$Revision: 22010 $';
+ my $_modulerevision;
+ if ($svnrev =~ m/: ([0-9]+) /) {
+ $_modulerevision = $1;
+@@ -73,10 +73,17 @@
+ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
+ $tlpdb->remove_package($pkg, %options);
+
+-
+ TeXLive::TLPDB->listdir([$dir]);
+ $tlpdb->generate_listfiles([$destdir]);
+
++ $tlpdb->make_virtual;
++ $tlpdb->is_virtual;
++ $tlpdb->virtual_add_tlpdb($tlpdb, $tag);
++ $tlpdb->virtual_remove_tlpdb($tag);
++ $tlpdb->virtual_get_package($pkg, $tag);
++ $tlpdb->virtual_candidates($pkg);
++ $tlpdb->virtual_candidate($pkg);
++
+ =head1 DESCRIPTION
+
+ =cut
+@@ -160,6 +167,10 @@
+
+ sub add_tlpobj {
+ my ($self,$tlp) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot add tlpobj to a virtual tlpdb\n");
++ return 0;
++ }
+ $self->{'tlps'}{$tlp->name} = $tlp;
+ }
+
+@@ -208,6 +219,10 @@
+
+ sub remove_tlpobj {
+ my ($self,$pkg) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot remove tlpobj from a virtual tlpdb\n");
++ return 0;
++ }
+ if (defined($self->{'tlps'}{$pkg})) {
+ delete $self->{'tlps'}{$pkg};
+ } else {
+@@ -228,6 +243,10 @@
+
+ sub from_file {
+ my ($self, $path) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot initialize from file a virtual tlpdb\n");
++ return 0;
++ }
+ if (@_ != 2) {
+ die "$0: from_file needs filename for initialization";
+ }
+@@ -352,6 +371,10 @@
+
+ sub writeout {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot write out a virtual tlpdb\n");
++ return 0;
++ }
+ my $fd = (@_ ? $_[0] : STDOUT);
+ foreach (sort keys %{$self->{'tlps'}}) {
+ ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n");
+@@ -371,6 +394,10 @@
+
+ sub save {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot save a virtual tlpdb\n");
++ return 0;
++ }
+ my $path = $self->location;
+ mkdirhier(dirname($path));
+ my $tmppath = "$path.tmp";
+@@ -392,6 +419,10 @@
+
+ sub media {
+ my $self = shift ;
++ if ($self->is_virtual) {
++ tlwarn("cannot determine the media of a virtual tlpdb\n");
++ return;
++ }
+ return $self->{'media'};
+ }
+
+@@ -407,6 +438,18 @@
+
+ sub available_architectures {
+ my $self = shift;
++ my @archs;
++ if ($self->is_virtual) {
++ for my $k (keys %{$self->{'tlpdbs'}}) {
++ push @archs, $self->{'tlpdbs'}{$k}->available_architectures;
++ }
++ } else {
++ return $self->_available_architectures;
++ }
++}
++
++sub _available_architectures {
++ my $self = shift;
+ my @archs = $self->setting("available_architectures");
+ if (! @archs) {
+ # fall back to the old method checking tex\.*
+@@ -434,6 +477,10 @@
+
+ sub add_tlpcontainer {
+ my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot add tlp container to a virtual tlpdb\n");
++ return 0;
++ }
+ my @archs;
+ if (defined($archrefs)) {
+ @archs = @$archrefs;
+@@ -499,6 +546,16 @@
+
+ sub get_package {
+ my ($self,$pkg) = @_;
++ if ($self->is_virtual) {
++ my ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) = $self->virtual_candidate($pkg);
++ return $maxtlp;
++ } else {
++ return $self->_get_package($pkg);
++ }
++}
++
++sub _get_package {
++ my ($self,$pkg) = @_;
+ if (defined($self->{'tlps'}{$pkg})) {
+ my $ret = $self->{'tlps'}{$pkg};
+ return $self->{'tlps'}{$pkg};
+@@ -509,6 +566,35 @@
+
+ =pod
+
++=item C<< $tlpdb->media_of_package($pkg [, $tag]);
++
++returns the media type of the package. In the virtual case a tag can
++be given and the media of that repository is used, otherwise the
++media of the virtual candidate is given.
++
++=cut
++
++sub media_of_package {
++ my ($self, $pkg, $tag) = @_;
++ if ($self->is_virtual) {
++ if (defined($tag)) {
++ if (defined($self->{'tlpdbs'}{$tag})) {
++ return $self->{'tlpdbs'}{$tag}->media;
++ } else {
++ tlwarn ("tag $tag is not known.\n");
++ return;
++ }
++ } else {
++ my (undef,undef,undef,$maxtlpdb) = $self->virtual_candidate($pkg);
++ return $maxtlpdb->media;
++ }
++ } else {
++ return $self->media;
++ }
++}
++
++=pod
++
+ =item C<< $tlpdb->list_packages >>
+
+ The C<list_packages> function returns the list of all included packages.
+@@ -517,6 +603,15 @@
+
+ sub list_packages {
+ my $self = shift;
++ if ($self->is_virtual) {
++ return (sort keys %{$self->{'packages'}});
++ } else {
++ return $self->_list_packages;
++ }
++}
++
++sub _list_packages {
++ my $self = shift;
+ return (sort keys %{$self->{'tlps'}});
+ }
+
+@@ -625,6 +720,7 @@
+
+ =cut
+
++# TODO adapt for searching in *all* tags ???
+ sub find_file {
+ my ($self,$fn) = @_;
+ my @ret;
+@@ -858,6 +954,10 @@
+
+ sub root {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot set/edit root of a virtual tlpdb\n");
++ return 0;
++ }
+ if (@_) { $self->{'root'} = shift }
+ return $self->{'root'};
+ }
+@@ -876,7 +976,11 @@
+ =cut
+
+ sub location {
+- my $self = shift;
++ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot get location of a virtual tlpdb\n");
++ return 0;
++ }
+ return "$self->{'root'}/$InfraLocation/$DatabaseName";
+ }
+
+@@ -927,8 +1031,14 @@
+
+ sub config_src_container {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^container_split_src_files/(.*)$!) {
+ return "$1";
+ }
+@@ -948,8 +1058,14 @@
+
+ sub config_doc_container {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp) {
+ if ($d =~ m!^container_split_doc_files/(.*)$!) {
+ return "$1";
+ }
+@@ -968,8 +1084,14 @@
+
+ sub config_container_format {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^container_format/(.*)$!) {
+ return "$1";
+ }
+@@ -988,8 +1110,14 @@
+
+ sub config_release {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^release/(.*)$!) {
+ return "$1";
+ }
+@@ -1008,8 +1136,14 @@
+
+ sub config_minrelease {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^minrelease/(.*)$!) {
+ return "$1";
+ }
+@@ -1029,8 +1163,14 @@
+
+ sub config_revision {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^revision/(.*)$!) {
+ return "$1";
+ }
+@@ -1056,12 +1196,12 @@
+ sub sizes_of_packages {
+ my ($self, $opt_src, $opt_doc, @packs) = @_;
+ @packs || ( @packs = $self->list_packages() );
+- my $media = $self->media;
+ my %tlpsizes;
+ my %tlpobjs;
+ my $totalsize;
+ foreach my $p (@packs) {
+ $tlpobjs{$p} = $self->get_package($p);
++ my $media = $self->media_of_package($p);
+ if (!defined($tlpobjs{$p})) {
+ warn "STRANGE: $p not to be found in ", $self->root;
+ next;
+@@ -1085,7 +1225,7 @@
+ $size += $tlpobj->srccontainersize if $opt_src;
+ $size += $tlpobj->doccontainersize if $opt_doc;
+ } else {
+- # we have to add the respective sizes, that is checking for
++ # 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;
+@@ -1108,6 +1248,16 @@
+
+ sub install_package {
+ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
++ if ($self->is_virtual) {
++ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
++ return $maxtlpdb->install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia);
++ } else {
++ return $self->not_virtual_install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia);
++ }
++}
++
++sub not_virtual_install_package {
++ my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
+ my $fromtlpdb = $self;
+ my $ret;
+ die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
+@@ -1346,6 +1496,7 @@
+ # we are installing from local compressed files
+ # copy it to temp
+ TeXLive::TLUtils::copy($what, $tempdir);
++system("ls -al $tempdir");
+ }
+ debug("un-xzing $xzfile to $tarfile\n");
+ system("$xzdec < $xzfile_quote > $tarfile_quote");
+@@ -1548,7 +1699,12 @@
+ sub _set_value_pkg {
+ my ($self,$pkgname,$pre,$key,$value) = @_;
+ my $k = "$pre$key";
+- my $pkg = $self->{'tlps'}{$pkgname};
++ my $pkg;
++ if ($self->is_virtual) {
++ $pkg = $self->{'tlpdbs'}{'main'}->get_package($pkgname);
++ } else {
++ $pkg = $self->{'tlps'}{$pkgname};
++ }
+ my @newdeps;
+ if (!defined($pkg)) {
+ $pkg = new TeXLive::TLPOBJ;
+@@ -1586,8 +1742,14 @@
+ sub _value_pkg {
+ my ($self,$pkg,$pre,$key) = @_;
+ my $k = "$pre$key";
+- if (defined($self->{'tlps'}{$pkg})) {
+- foreach my $d ($self->{'tlps'}{$pkg}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package($pkg);
++ } else {
++ $tlp = $self->{'tlps'}{$pkg};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^$k:(.*)$!) {
+ return "$1";
+ }
+@@ -1700,7 +1862,12 @@
+ my ($self, $pre, $hr) = @_;
+ my @allowed = keys %$hr;
+ my %ret;
+- my $pkg = $self->{'tlps'}{'00texlive.installation'};
++ my $pkg;
++ if ($self->is_virtual) {
++ $pkg = $self->{'tlpdbs'}{'main'}->get_package('00texlive.installation');
++ } else {
++ $pkg = $self->{'tlps'}{'00texlive.installation'};
++ }
+ if (defined($pkg)) {
+ foreach my $d ($pkg->depends) {
+ if ($d =~ m!^$pre([^:]*):(.*)!) {
+@@ -1849,6 +2016,122 @@
+
+ =back
+
++=head1 VIRTUAL DATABASES
++
++The purpose of virtual databases is to collect several data sources
++and present them in one way. The normal functions will always return
++the best candidate for the set of functions.
++
++More docs to be written
++
++=cut
++
++#
++# packages are saved:
++# $self->{$pkgname}{$tag}{'revision'} = $rev
++# $self->{$pkgname}{$tag}{'tlp'} = $tlp
++#
++
++sub is_virtual {
++ my $self = shift;
++ if (defined($self->{'virtual'}) && $self->{'virtual'}) {
++ return 1;
++ }
++ return 0;
++}
++
++sub make_virtual {
++ my $self = shift;
++ if (!$self->is_virtual) {
++ if ($self->list_packages) {
++ tlerror("Cannot convert a initialized tlpdb to virtual for now!\n");
++ return 0;
++ }
++ $self->{'virtual'} = 1;
++ }
++ return 1;
++}
++
++sub virtual_add_tlpdb {
++ my ($self, $tlpdb, $tag) = @_;
++ if (!$self->is_virtual) {
++ tlerror("Cannot add tlpdb to a non-virtual tlpdb!\n");
++ return 0;
++ }
++ $self->{'tlpdbs'}{$tag} = $tlpdb;
++ for my $p ($tlpdb->list_packages) {
++ my $tlp = $tlpdb->get_package($p);
++ $self->{'packages'}{$p}{$tag}{'revision'} = $tlp->revision;
++ $self->{'packages'}{$p}{$tag}{'tlp'} = $tlp;
++ }
++ return 1;
++}
++
++sub virtual_remove_tlpdb {
++ my ($self, $tag) = @_;
++ if (!$self->is_virtual) {
++ tlerror("Cannot remove tlpdb from a non-virtual tlpdb!\n");
++ return 0;
++ }
++ if (!defined($self->{'tlpdbs'}{$tag})) {
++ tlwarn("TLPDB virtual_remove_tlpdb: unknown tag $tag\n");
++ return 0;
++ }
++ for my $p ($self->{'tlpdbs'}{$tag}->list_packages) {
++ delete $self->{'packages'}{$p}{$tag};
++ }
++ delete $self->{'tlpdbs'}{$tag};
++ return 1;
++}
++
++sub virtual_get_package {
++ my ($self, $pkg, $tag) = @_;
++ if (defined($self->{'packages'}{$pkg}{$tag})) {
++ return $self->{'packages'}{$pkg}{$tag}{'tlp'};
++ } else {
++ tlwarn("pkg $pkg not found in tag $tag\n");
++ return;
++ }
++}
++
++# returns a list of tag/rev
++sub virtual_candidates {
++ my ($self, $pkg) = @_;
++ if (defined($self->{'packages'}{$pkg})) {
++ my @ret = ();
++ for my $t (keys %{$self->{'packages'}{$pkg}}) {
++ push @ret, "$t/" . $self->{'packages'}{$pkg}{$t}{'revision'};
++ }
++ return @ret;
++ } else {
++ return;
++ }
++}
++
++#
++# computation of install candidates from a list of packagess
++# this can later be extended to include pinning
++sub virtual_candidate {
++ my ($self, $pkg) = @_;
++ my $maxrev = -1;
++ my $maxtag;
++ if (defined($self->{'packages'}{$pkg})) {
++ for my $t (keys %{$self->{'packages'}{$pkg}}) {
++ my $r = $self->{'packages'}{$pkg}{$t}{'revision'};
++ if ($maxrev < $r) {
++ $maxrev = $r;
++ $maxtag = $t;
++ }
++ }
++ }
++ if (defined($maxtag)) {
++ # something was found ($maxsrc, $maxrev, $maxtlp, $maxtlmedia)
++ return ($maxtag, $maxrev, $self->{'packages'}{$pkg}{$maxtag}{'tlp'},
++ $self->{'tlpdbs'}{$maxtag});
++ }
++ return(undef,undef,undef,undef);
++}
++
+ =pod
+
+ =head1 OPTIONS
+--- /src/TeX/texlive-svn/Master/texmf/scripts/texlive/tlmgr.pl 2011-04-27 17:53:53.000000000 +0900
++++ texmf/scripts/texlive/tlmgr.pl 2011-04-27 17:53:50.000000000 +0900
+@@ -480,6 +480,9 @@
+ } elsif ($action =~ m/^option$/i) {
+ action_option();
+ finish(0);
++ } elsif ($action =~ m/^repository$/i) {
++ action_repository();
++ finish(0);
+ } elsif ($action =~ m/^list$/i) {
+ action_list();
+ finish(0);
+@@ -3119,6 +3122,115 @@
+ return;
+ }
+
++# REPOSITORY
++#
++# this action manages the list of repositories
++# tlmgr repository list -> lists repositories
++# tlmgr repository add path [tag] -> add repository with optional tag
++# tlmgr repository remove [path|tag] -> removes repository or tag
++# tlmgr repository set path[#tag] [path[#tag] ...] -> sets the list
++#
++
++sub array_to_repository {
++ my %r = @_;
++ my @ret;
++ for my $k (keys %r) {
++ my $v = $r{$k};
++ if ($k eq $v) {
++ push @ret, $k;
++ } else {
++ push @ret, "$v#$k";
++ }
++ }
++ return "@ret";
++}
++sub repository_to_array {
++ my $r = shift;
++ my %r;
++ for my $rr (split ' ', $r) {
++ if ($rr =~ m/^([^#]+)#(.*)$/) {
++ $r{$2} = $1;
++ } else {
++ $r{$rr} = $rr;
++ }
++ }
++ return %r;
++}
++sub action_repository {
++ init_local_db();
++ my $what = shift @ARGV;
++ $what = "list" if !defined($what);
++ my %repos = repository_to_array($localtlpdb->option("location"));
++ if ($what =~ m/^list$/i) {
++ print "List of repositories (with tags if set):\n";
++ for my $k (keys %repos) {
++ my $v = $repos{$k};
++ print "\t$v";
++ if ($k ne $v) {
++ print " ($k)";
++ }
++ print "\n";
++ }
++ return;
++ }
++ if ($what eq "add") {
++ my $p = shift @ARGV;
++ if (!defined($p)) {
++ tlwarn("You need to give a new repository aas argument to add\n");
++ return;
++ }
++ my $t = shift @ARGV;
++ $t = $p if (!defined($t));
++ if (defined($repos{$t})) {
++ tlwarn("This repository or its tag is already defined, no action\n");
++ return;
++ }
++ # TODO more checks needed?
++ # if there was till now only *one* repository and that without
++ # a tag, we give that one the "main" tag which is necessary
++ # for proper operation!
++ my @tags = keys %repos;
++ if ($#tags == 0) {
++ # we have only one repository, check if it has the main tag
++ my $maintag = $tags[0];
++ if ($maintag ne 'main') {
++ $repos{'main'} = $repos{$maintag};
++ delete $repos{$maintag};
++ }
++ }
++ $repos{$t} = $p;
++ $localtlpdb->option("location", array_to_repository(%repos));
++ $localtlpdb->save;
++ return;
++ }
++ if ($what eq "remove") {
++ my $p = shift @ARGV;
++ if (!defined($p)) {
++ tlwarn("Which repository should be removed?\n");
++ return;
++ }
++ my $found = 0;
++ for my $k (keys %repos) {
++ if ($k eq $p || $repos{$k} eq $p) {
++ $found = 1;
++ delete $repos{$k};
++ }
++ }
++ if (!$found) {
++ tlwarn("Cannot find the repository $p\n");
++ } else {
++ $localtlpdb->option("location", array_to_repository(%repos));
++ $localtlpdb->save;
++ }
++ return;
++ }
++ if ($what eq "set") {
++ %repos = repository_to_array("@ARGV");
++ $localtlpdb->option("location", array_to_repository(%repos));
++ $localtlpdb->save;
++ }
++}
++
+
+ # OPTION
+ #
+@@ -4466,6 +4578,45 @@
+ #
+ sub init_tlmedia
+ {
++ # first check if $location contains multiple locations
++ # in this case we go to virtual mode
++ my %repos = repository_to_array($localtlpdb->option("location"));
++ my @tags = keys %repos;
++ # check if we are only one tag/repo
++ if ($#tags == 0) {
++ # go to normal mode
++ _init_tlmedia();
++ return;
++ }
++ # we are still here, so we have more tags
++
++ # check that there is a main repository
++ if (!TeXLive::TLUtils::member('main', @tags)) {
++ tldie("Cannot find main repository, you have to tag one as main!\n");
++ }
++
++ # TODO TODO
++ # - abstract the set up of a single media tlpdb
++ # - make clear how to check for a already loaded remotetlpdb
++ $remotetlpdb = TeXLive::TLPDB->new();
++ $remotetlpdb->make_virtual;
++
++ for my $t (@tags) {
++ my $tlmdb = setup_one_remotetlpdb($repos{$t});
++ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t);
++ }
++ # this "location-url" line should not be changed since GUI programs
++ # depend on it:
++ print "location-url\t$location\n" if $::machinereadable;
++ info("tlmgr: package repository $location\n");
++
++}
++
++
++
++
++sub _init_tlmedia
++{
+ if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
+ # nothing to be done
+ return;
+@@ -4479,10 +4630,28 @@
+ $location =~ s,^$TeXLiveServerURL,$mirrorbase,;
+ }
+
++ $remotetlpdb = setup_one_remotetlpdb($location);
+ # this "location-url" line should not be changed since GUI programs
+ # depend on it:
+ print "location-url\t$location\n" if $::machinereadable;
+ info("tlmgr: package repository $location\n");
++}
++
++sub setup_one_remotetlpdb
++{
++ my $location = shift;
++ my $remotetlpdb;
++
++ # TODO
++ # check if that is already loaded!!!
++
++ # choose a mirror if we are asked.
++ if ($location =~ m/^ctan$/i) {
++ $location = give_ctan_mirror();
++ } elsif ($location =~ m,^$TeXLiveServerURL,) {
++ my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base();
++ $location =~ s,^$TeXLiveServerURL,$mirrorbase,;
++ }
+
+ # if we talk about a net location try to download the hash of the tlpdb
+ # - if that is possible, check for the locally saved file and if the hash
+@@ -4628,6 +4797,8 @@
+ close($tlfh);
+ }
+ }
++
++ return($remotetlpdb);
+ }
+
+