summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/dev.multi-source-support-v2.patch
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/dev.multi-source-support-v2.patch
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/dev.multi-source-support-v2.patch')
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.patch757
1 files changed, 757 insertions, 0 deletions
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);
+ }
+
+