path: root/Master/tlpkg/dev/dev.multi-source-support-v2.patch

Index: tlpkg/TeXLive/TLPDB.pm
===================================================================
--- tlpkg/TeXLive/TLPDB.pm	(revision 22247)
+++ tlpkg/TeXLive/TLPDB.pm	(working copy)
@@ -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,9 @@
 
 sub media { 
   my $self = shift ; 
+  if ($self->is_virtual) {
+    return "virtual";
+  }
   return $self->{'media'};
 }
 
@@ -407,6 +437,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 +476,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 +545,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 +565,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 +602,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 +719,7 @@
 
 =cut
 
+# TODO adapt for searching in *all* tags ???
 sub find_file {
   my ($self,$fn) = @_;
   my @ret;
@@ -858,6 +953,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 +975,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 +1030,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 +1057,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 +1083,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 +1109,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 +1135,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 +1162,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 +1195,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 +1224,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 +1247,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));
@@ -1547,7 +1696,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;
@@ -1585,8 +1739,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";
       }
@@ -1699,7 +1859,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([^:]*):(.*)!) {
@@ -1848,6 +2013,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
Index: texmf/scripts/texlive/tlmgr.pl
===================================================================
--- texmf/scripts/texlive/tlmgr.pl	(revision 22247)
+++ texmf/scripts/texlive/tlmgr.pl	(working copy)
@@ -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);
@@ -1937,7 +1940,12 @@
     # intersection, don't check A\B and B\A
     next if $newpkgs_full{$p};
     next if $removals_full{$p};
-    next if ($remotetlpdb->get_package($p)->category ne "Collection");
+    my $remotetlp = $remotetlpdb->get_package($p);
+    if (!defined($remotetlp)) {
+      tlwarn("Strange, $p mentioned but not found anywhere!\n");
+      next;
+    }
+    next if ($remotetlp->category ne "Collection");
     my $tlp = $localtlpdb->get_package($p);
     if (!defined($tlp)) {
       if ($opts{"reinstall-forcibly-removed"}) {
@@ -2904,6 +2912,7 @@
   if (!(@new || @updated)) {
     info("tlmgr: no updates available\n");
     if ($remotetlpdb->media ne "NET"
+        && $remotetlpdb->media ne "virtual"
         && !$opts{"dry-run"}
         && !$opts{"repository"}
        ) {
@@ -3119,7 +3128,116 @@
   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
 #
 sub action_option {
@@ -4466,6 +4584,47 @@
 #
 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;
+
+  my $locstr = $repos{'main'};
+  for my $t (@tags) {
+    my $tlmdb = setup_one_remotetlpdb($repos{$t});
+    $remotetlpdb->virtual_add_tlpdb($tlmdb, $t);
+    $locstr .= " $repos{$t}" if ($t ne 'main');
+  }
+  # this "location-url" line should not be changed since GUI programs
+  # depend on it:
+  print "location-url\t$locstr\n" if $::machinereadable;
+  info("tlmgr: package repository $locstr\n");
+
+}
+
+
+
+
+sub _init_tlmedia
+{
   if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
     # nothing to be done
     return;
@@ -4479,11 +4638,29 @@
     $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
   #   agrees load the local copy if present instead of the remote one,
@@ -4628,6 +4805,8 @@
       close($tlfh);
     }
   }
+
+  return($remotetlpdb);
 }