diff options
author | Norbert Preining <preining@logic.at> | 2011-04-27 16:01:23 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2011-04-27 16:01:23 +0000 |
commit | e6fdf875e91bf1013e861b2ef46db6b43dda1a61 (patch) | |
tree | b311ece82cb3182efd6b434f88ef8f672145a6fd /Master/tlpkg/dev/dev.multi-source-support-v2.patch | |
parent | 73cbc642103524865daca10dcc65aa47907dc8dd (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.patch | 757 |
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); + } + + |