update dev.multi-source-support for

	tlmgr install foobar@repo-tag


git-svn-id: svn://tug.org/texlive/trunk@22413 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 754 insertions, 511 deletions

diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
index 1e01217d56a..f0396eb217f 100644
--- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
@@ -1,485 +1,13 @@
-Index: texmf/scripts/texlive/tlmgr.pl
-===================================================================
---- texmf/scripts/texlive/tlmgr.pl	(revision 22399)
-+++ texmf/scripts/texlive/tlmgr.pl	(working copy)
-@@ -124,6 +124,7 @@
-     "package-logfile" => "=s",
-     "persistent-downloads" => "!",
-     "no-execute-actions" => 1,
-+    "pin-file" => "=s",
-     "pause" => 1,
-     "print-platform|print-arch" => 1,
-     "version" => 1,
-@@ -480,6 +481,12 @@
-   } elsif ($action =~ m/^option$/i) {
-     action_option();
-     finish(0);
-+  } elsif ($action =~ m/^repository$/i) {
-+    action_repository();
-+    finish(0);
-+  } elsif ($action =~ m/^candidates$/i) {
-+    action_candidates();
-+    finish(0);
-   } elsif ($action =~ m/^list$/i) {
-     action_list();
-     finish(0);
-@@ -1941,7 +1948,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"}) {
-@@ -2042,12 +2054,15 @@
-     $ret = 1;
-     shift;
-   }
--  my ($pkg, $flag, $lrev, $rrev, @args) = @_;
-+  my ($pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag) = @_;
-   $lrev ||= "-";
-   $rrev ||= "-";
-   $flag ||= "?";
--  my $str = "$pkg\t$flag\t$lrev\t$rrev\t";
--  $str .= join("\t", @args) if (@args);
-+  $size ||= "-";
-+  $runtime ||= "-";
-+  $esttot ||= "-";
-+  $tag ||= "-";
-+  my $str = join("\t", $pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag);
-   $str .= "\n";
-   return($str) if $ret;
-   print $str;
-@@ -2571,19 +2586,32 @@
-       my $unwind_package;
-       my $remove_unwind_container = 0;
-       my $rev = $tlp->revision;
--      my $mediatlp = $remotetlpdb->get_package($pkg);
-+      my $mediatlp;
-+      my $maxtag;
-+      if ($remotetlpdb->is_virtual) {
-+        ($maxtag, undef, $mediatlp, undef) = 
-+          $remotetlpdb->virtual_candidate($pkg);
-+      } else {
-+        $mediatlp = $remotetlpdb->get_package($pkg);
-+      }
-       if (!defined($mediatlp)) {
-         debug("$pkg cannot be found in $location\n");
-         next;
-       }
-       my $mediarev = $mediatlp->revision;
-+      my $mediarevstr = $mediarev;
-+      my @addargs = ();
-+      if ($remotetlpdb->is_virtual) {
-+        push @addargs, $maxtag;
-+        $mediarevstr .= "\@$maxtag";
-+      }
-       $nrupdated++;
-       if ($opts{"list"}) {
-         if ($::machinereadable) {
--          machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
-+          machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, "-", "-", @addargs);
-         } else {
-           my $kb = int($sizes{$pkg} / 1024) + 1;
--          info("$pkg [${kb}k]: local: $rev, source: $mediarev (update)\n");
-+          info("$pkg [${kb}k]: local: $rev, source: $mediarevstr (update)\n");
-         }
-         $updated{$pkg} = 1;
-         next;
-@@ -2624,10 +2652,10 @@
-       }
-       
-       if ($::machinereadable) {
--        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot);
-+        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot, @addargs);
-       } else {
-         my $kb = int ($sizes{$pkg} / 1024) + 1;
--        info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarev)");
-+        info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarevstr)");
-       }
-       $donesize += $sizes{$pkg};
-       $currnr++;
-@@ -2670,7 +2698,7 @@
-       }
-       if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
-         # installation succeeded because we got a reference
--        logpackage("update: $pkg ($rev -> $mediarev)");
-+        logpackage("update: $pkg ($rev -> $mediarevstr)");
-         unlink($unwind_package) if $remove_unwind_container;
-         # remember successful update
-         $updated{$pkg} = 1;
-@@ -2698,7 +2726,7 @@
-         # now in fact we should do some cleanup, removing files and
-         # dirs from the new package before re-installing the old one.
-         # TODO
--        logpackage("failed update: $pkg ($rev -> $mediarev)");
-+        logpackage("failed update: $pkg ($rev -> $mediarevstr)");
-         tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n");
-         if (win32()) {
-           # w32 is notorious for not releasing a file immediately
-@@ -2739,12 +2767,25 @@
-             unless $::machinereadable;
-       } else {
-         # install new packages
--        my $mediatlp = $remotetlpdb->get_package($pkg);
-+        my $mediatlp;
-+        my $maxtag;
-+        if ($remotetlpdb->is_virtual) {
-+          ($maxtag, undef, $mediatlp, undef) = 
-+            $remotetlpdb->virtual_candidate($pkg);
-+        } else {
-+          $mediatlp = $remotetlpdb->get_package($pkg);
-+        }
-         if (!defined($mediatlp)) {
-           tlwarn("\nShould not happen: $pkg not found in $location");
-           next;
-         }
-         my $mediarev = $mediatlp->revision;
-+        my $mediarevstr;
-+        my @addargs;
-+        if ($remotetlpdb->is_virtual) {
-+          $mediarevstr = "$mediarev\@$maxtag";
-+          push @addargs, $maxtag;
-+        }
-         my ($estrem, $esttot);
-         if (!$opts{"list"}) {
-           ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
-@@ -2754,14 +2795,16 @@
-           my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg});
-           if (!$opts{"list"}) {
-             push @maargs, $estrem, $esttot;
-+          } else {
-+            push @maargs, undef, undef;
-           }
--          machine_line(@maargs);
-+          machine_line(@maargs, @addargs);
-         } else {
-           my $kb = int($sizes{$pkg} / 1024) + 1;
-           if ($opts{"list"}) {
--            info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n");
-+            info("$pkg [${kb}k]: local: <absent>, source: $mediarevstr (auto-install)\n");
-           } else {
--            info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg [${kb}k]\n");
-+            info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg ($mediarevstr) [${kb}k]\n");
-           }
-         }
-         $currnr++;
-@@ -2769,7 +2812,7 @@
-         next if ($opts{"dry-run"} || $opts{"list"});
-         if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
-           # installation succeeded because we got a reference
--          logpackage("auto-install new: $pkg ($mediarev)");
-+          logpackage("auto-install new: $pkg ($mediarevstr)");
-           $nrupdated++;
-         } else {
-           tlwarn("$0: couldn't install new package $pkg\n");
-@@ -2908,6 +2951,7 @@
-   if (!(@new || @updated)) {
-     info("tlmgr: no updates available\n");
-     if ($remotetlpdb->media ne "NET"
-+        && $remotetlpdb->media ne "virtual"
-         && !$opts{"dry-run"}
-         && !$opts{"repository"}
-        ) {
-@@ -3123,7 +3167,150 @@
-   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;
-+    return;
-+  }
-+  # we are still here, unknown command to repository
-+  tlwarn("tlmgr: unknown directive to tlmgr repository: $what\n");
-+  return;
-+}
-+
-+sub action_candidates {
-+  my $what = shift @ARGV;
-+  if (!defined($what)) {
-+    tlwarn("tlmgr: action candidates needs a package name as argument\n");
-+    return;
-+  }
-+  init_local_db();
-+  init_tlmedia();
-+  my @cand = $remotetlpdb->candidates($what);
-+  if (@cand) {
-+    my $first = shift @cand;
-+    if (defined($first)) {
-+      my ($t,$r) = split(/\//, $first, 2);
-+      print "Install candidate for $what from $t ($r)\n";
-+    } else {
-+      print "No install candidate for $what found.\n";
-+    }
-+    # already shifted away the first element
-+    if ($#cand >= 0) {
-+      print "Other repositories providing this package:\n";
-+      for my $a (@cand) {
-+        my ($t,$r) = split(/\//, $a, 2);
-+        print "$t ($r)\n";
-+      }
-+    }
-+  } else {
-+    print "Package $what not found.\n";
-+  }
-+  return;
-+}
-+
- #  OPTION
- #
- sub action_option {
-@@ -4470,6 +4657,74 @@
- #
- 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 %repos = repository_to_array($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'};
-+  my $tlmdb = setup_one_remotetlpdb($locstr);
-+  $remotetlpdb->virtual_add_tlpdb($tlmdb, "main");
-+  for my $t (@tags) {
-+    if ($t ne 'main') {
-+      my $tlmdb = setup_one_remotetlpdb($repos{$t});
-+      $remotetlpdb->virtual_add_tlpdb($tlmdb, $t);
-+      $locstr .= " $repos{$t}";
-+    }
-+  }
-+
-+  # now check/setup pinning
-+  # TODO for now no default pinning file!
-+  if ($opts{"pin-file"}) {
-+    my @pins = read_pinning_file($opts{"pin-file"});
-+    if (@pins) {
-+      $remotetlpdb->virtual_pinning(@pins);
-+    }
-+  } else {
-+    # check for pinning file in TEXMFLOCAL/tlpkg/pinning.txt
-+    chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
-+    debug("trying to load pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
-+    if (-r "$TEXMFLOCAL/tlpkg/pinning.txt") {
-+      my @pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning.txt");
-+      if (@pins) {
-+        info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
-+        $remotetlpdb->virtual_pinning(@pins);
-+      }
-+    }
-+  }
-+
-+
-+  # 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;
-@@ -4483,11 +4738,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,
-@@ -4632,8 +4905,30 @@
-       close($tlfh);
-     }
-   }
-+
-+  return($remotetlpdb);
- }
- 
-+sub read_pinning_file {
-+  my $pf = shift;
-+  my @pins;
-+  my $pfh;
-+  if (!open($pfh, "<$pf")) {
-+    tlwarn("Pinning file $pf cannot be read: $!\n");
-+    return;
-+  }
-+  debug("Reading pinning file $pf\n");
-+  while (my $l = TeXLive::TLUtils::get_full_line($pfh)) {
-+    chomp($l);
-+    # comments and empty lines are allowed
-+    next if ($l =~ m/^\s*#/);
-+    next if ($l =~ m/^\s*$/);
-+    my ($a, $b) = split(/:/, $l);
-+    push @pins, $remotetlpdb->make_pin_data_from_line($l);
-+  }
-+  close($pfh);
-+  return @pins;
-+}
- 
- 
- # finish handles the -pause option (wait for input from stdin),
 Index: tlpkg/TeXLive/TLPDB.pm
 ===================================================================
---- tlpkg/TeXLive/TLPDB.pm	(revision 22399)
+--- tlpkg/TeXLive/TLPDB.pm	(revision 22412)
 +++ tlpkg/TeXLive/TLPDB.pm	(working copy)
-@@ -73,17 +73,27 @@
-   $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
+@@ -70,20 +70,30 @@
+   $tlpdb->settings;
+   $tlpdb->setting($key, [$value]);
+   $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]);
+-  $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb);
++  $tlpdb->install_package($pkg, $dest_tlpdb);
    $tlpdb->remove_package($pkg, %options);
  
 -
@@ -604,24 +132,37 @@ Index: tlpkg/TeXLive/TLPDB.pm
    my @archs;
    if (defined($archrefs)) {
      @archs = @$archrefs;
-@@ -497,6 +546,16 @@
+@@ -496,6 +545,29 @@
+ =cut
  
  sub get_package {
-   my ($self,$pkg) = @_;
++  my ($self,$pkg,$tag) = @_;
 +  if ($self->is_virtual) {
-+    my ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) = $self->virtual_candidate($pkg);
-+    return $maxtlp;
++    if (defined($tag)) {
++      if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
++        return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
++      } else {
++        tlwarn("package $pkg not found in repository $tag\n");
++        return;
++      }
++    } else {
++      $tag = $self->{'packages'}{$pkg}{'target'};
++      if (defined($tag)) {
++        return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
++      } else {
++        return;
++      }
++    }
 +  } else {
 +    return $self->_get_package($pkg);
 +  }
 +}
 +
 +sub _get_package {
-+  my ($self,$pkg) = @_;
+   my ($self,$pkg) = @_;
    if (defined($self->{'tlps'}{$pkg})) {
    my $ret = $self->{'tlps'}{$pkg};
-     return $self->{'tlps'}{$pkg};
-@@ -507,6 +566,35 @@
+@@ -507,6 +579,35 @@
  
  =pod
  
@@ -657,7 +198,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
  =item C<< $tlpdb->list_packages >>
  
  The C<list_packages> function returns the list of all included packages.
-@@ -515,6 +603,15 @@
+@@ -515,6 +616,15 @@
  
  sub list_packages {
    my $self = shift;
@@ -673,7 +214,72 @@ Index: tlpkg/TeXLive/TLPDB.pm
    return (sort keys %{$self->{'tlps'}});
  }
  
-@@ -623,6 +720,7 @@
+@@ -532,6 +642,11 @@
+ The next (or first) argument is the target TLPDB, then a list of
+ packages.
+ 
++In the virtual case, 
++if a package name is tagged with C<@repository-tag> then all the
++dependencies will still be expanded between all included databases.
++Only in case of .ARCH dependencies the repository-tag is sticky.
++
+ We return the closure of the package list with respect to the depends
+ operator. (Sorry, that was for mathematicians.)
+ 
+@@ -555,7 +670,8 @@
+   my %install = ();
+   my @archs = $totlpdb->available_architectures;
+   for my $p (@_) {
+-    $install{$p} = 1;
++    my ($pp, $aa) = split('@', $p);
++    $install{$pp} = (defined($aa) ? $aa : 0);;
+   }
+   my $changed = 1;
+   while ($changed) {
+@@ -564,7 +680,7 @@
+     ddebug("pre_select = @pre_select\n");
+     for my $p (@pre_select) {
+       next if ($p =~ m/^00texlive/);
+-      my $pkg = $self->get_package($p);
++      my $pkg = $self->get_package($p, ($install{$p}?$install{$p}:undef));
+       if (!defined($pkg)) {
+         debug("W: $p is mentioned somewhere but not available, disabling\n");
+         $install{$p} = 0;
+@@ -590,16 +706,19 @@
+         if ($p_dep =~ m/^(.*)\.ARCH$/) {
+           my $foo = "$1";
+           foreach $a (@archs) {
+-            $install{"$foo.$a"} = 1 if defined($self->get_package("$foo.$a"));
++            # install .ARCH packages from the same sub repository as the
++            # main packages
++            $install{"$foo.$a"} = $install{$foo}
++              if defined($self->get_package("$foo.$a"));
+           }
+         } elsif ($p_dep =~ m/^(.*)\.win32$/) {
+           # a win32 package should *only* be installed if we are installing
+           # the win32 arch
+           if (grep(/^win32$/,@archs)) {
+-            $install{$p_dep} = 1;
++            $install{$p_dep} = 0;
+           }
+         } else {
+-          $install{$p_dep} = 1 unless $only_arch;
++          $install{$p_dep} = 0 unless $only_arch;
+         }
+       }
+     }
+@@ -611,7 +730,9 @@
+       $changed = 1;
+     }
+   }
+-  return(keys %install);
++  # create return list
++  return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install; 
++  #return(keys %install);
+ }
+ 
+ =pod
+@@ -623,6 +744,7 @@
  
  =cut
  
@@ -681,7 +287,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
  sub find_file {
    my ($self,$fn) = @_;
    my @ret;
-@@ -856,6 +954,10 @@
+@@ -856,6 +978,10 @@
  
  sub root {
    my $self = shift;
@@ -692,7 +298,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
    if (@_) { $self->{'root'} = shift }
    return $self->{'root'};
  }
-@@ -874,7 +976,11 @@
+@@ -874,7 +1000,11 @@
  =cut
  
  sub location {
@@ -705,7 +311,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
    return "$self->{'root'}/$InfraLocation/$DatabaseName";
  }
  
-@@ -925,8 +1031,14 @@
+@@ -925,8 +1055,14 @@
  
  sub config_src_container {
    my $self = shift;
@@ -722,7 +328,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^container_split_src_files/(.*)$!) {
          return "$1";
        }
-@@ -946,8 +1058,14 @@
+@@ -946,8 +1082,14 @@
  
  sub config_doc_container {
    my $self = shift;
@@ -739,7 +345,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^container_split_doc_files/(.*)$!) {
          return "$1";
        }
-@@ -966,8 +1084,14 @@
+@@ -966,8 +1108,14 @@
  
  sub config_container_format {
    my $self = shift;
@@ -756,7 +362,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^container_format/(.*)$!) {
          return "$1";
        }
-@@ -986,8 +1110,14 @@
+@@ -986,8 +1134,14 @@
  
  sub config_release {
    my $self = shift;
@@ -773,7 +379,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^release/(.*)$!) {
          return "$1";
        }
-@@ -1006,8 +1136,14 @@
+@@ -1006,8 +1160,14 @@
  
  sub config_minrelease {
    my $self = shift;
@@ -790,7 +396,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^minrelease/(.*)$!) {
          return "$1";
        }
-@@ -1027,8 +1163,14 @@
+@@ -1027,8 +1187,14 @@
  
  sub config_revision {
    my $self = shift;
@@ -807,7 +413,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^revision/(.*)$!) {
          return "$1";
        }
-@@ -1054,12 +1196,12 @@
+@@ -1054,12 +1220,12 @@
  sub sizes_of_packages {
    my ($self, $opt_src, $opt_doc, @packs) = @_;
    @packs || ( @packs = $self->list_packages() );
@@ -821,7 +427,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
      if (!defined($tlpobjs{$p})) {
        warn "STRANGE: $p not to be found in ", $self->root;
        next;
-@@ -1083,7 +1225,7 @@
+@@ -1083,7 +1249,7 @@
      $size += $tlpobj->srccontainersize if $opt_src;
      $size += $tlpobj->doccontainersize if $opt_doc;
    } else {
@@ -830,24 +436,68 @@ Index: tlpkg/TeXLive/TLPDB.pm
      # installation of src and doc file
      $size  = $tlpobj->runsize;
      $size += $tlpobj->srcsize if $opt_src;
-@@ -1106,6 +1248,16 @@
+@@ -1098,31 +1264,46 @@
+ 
+ =pod
+ 
+-=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >>
++=item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >>
+ 
+ Installs the package $pkg into $dest_tlpdb.
++If C<$tag> is present and the tlpdb is virtual, tries to install $pkg
++from the repository tagged with $tag.
+ 
+ =cut
  
  sub install_package {
-   my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
+-  my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
++  my ($self, $pkg, $totlpdb, $tag) = @_;
 +  if ($self->is_virtual) {
-+    my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
-+    return $maxtlpdb->install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia);
++    if (defined($tag)) {
++      if (defined($self->{'packages'}{$pkg}{'tags'}{$t})) {
++        return $self->{'tlpdbs'}{$t}->install_package($pkg, $totlpdb);
++      } else {
++        tlwarn("package $pkg not found in repository $t\n");
++        return;
++      }
++    } else {
++      my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
++      return $maxtlpdb->install_package($pkg, $totlpdb);
++    }
 +  } else {
-+    return $self->not_virtual_install_package($pkg, $totlpdb, $nopostinstall, $fallbackmedia);
++    if (defined($tag)) {
++      tlwarn("not a virtual database, ignoring tag $tag on installation of $pkg\n");
++    }
++    return $self->not_virtual_install_package($pkg, $totlpdb);
 +  }
++  return;
 +}
 +
 +sub not_virtual_install_package {
-+  my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
++  my ($self, $pkg, $totlpdb) = @_;
    my $fromtlpdb = $self;
    my $ret;
    die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
-@@ -1170,7 +1322,7 @@
+   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;
+-    }
++    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;
+@@ -1170,7 +1351,7 @@
          next;
        }
      } elsif (&media eq 'NET') {
@@ -856,7 +506,54 @@ Index: tlpkg/TeXLive/TLPDB.pm
      }
      $self->_install_package ($container, $reloc, \@installfiles, $totlpdb) 
        || return(0);
-@@ -1545,7 +1697,12 @@
+@@ -1244,23 +1425,21 @@
+     $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"));
++    # 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;
+ }
+@@ -1513,7 +1692,7 @@
+     # 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) {
++    if (!$opts{'nopostinstall'}) {
+       &TeXLive::TLUtils::do_postaction("remove", $tlp,
+         $localtlpdb->option("file_assocs"),
+         $localtlpdb->option("desktop_integration"),
+@@ -1545,7 +1724,12 @@
  sub _set_value_pkg {
    my ($self,$pkgname,$pre,$key,$value) = @_;
    my $k = "$pre$key";
@@ -870,7 +567,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
    my @newdeps;
    if (!defined($pkg)) {
      $pkg = new TeXLive::TLPOBJ;
-@@ -1583,8 +1740,14 @@
+@@ -1583,8 +1767,14 @@
  sub _value_pkg {
    my ($self,$pkg,$pre,$key) = @_;
    my $k = "$pre$key";
@@ -887,7 +584,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
        if ($d =~ m!^$k:(.*)$!) {
          return "$1";
        }
-@@ -1697,7 +1860,12 @@
+@@ -1697,7 +1887,12 @@
    my ($self, $pre, $hr) = @_;
    my @allowed = keys %$hr;
    my %ret;
@@ -901,7 +598,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
    if (defined($pkg)) {
      foreach my $d ($pkg->depends) {
        if ($d =~ m!^$pre([^:]*):(.*)!) {
-@@ -1846,6 +2014,326 @@
+@@ -1846,6 +2041,329 @@
  
  =back
  
@@ -1154,7 +851,10 @@ Index: tlpkg/TeXLive/TLPDB.pm
 +
 +
 +# implementation copied from Text/Glob.pm (copyright Richard Clamp).
-+
++# changes made:
++# remove $strict_leading_dot and $strict_wildcard_slash if calls
++# and execute the code unconditionally, as we do not change the
++# default settings of 1 of these two variables.
 +sub glob_to_regex {
 +    my $glob = shift;
 +    my $regex = glob_to_regex_string($glob);
@@ -1230,7 +930,7 @@ Index: tlpkg/TeXLive/TLPDB.pm
  =head1 OPTIONS
 Index: tlpkg/TeXLive/TLUtils.pm
 ===================================================================
---- tlpkg/TeXLive/TLUtils.pm	(revision 22399)
+--- tlpkg/TeXLive/TLUtils.pm	(revision 22412)
 +++ tlpkg/TeXLive/TLUtils.pm	(working copy)
 @@ -62,6 +62,7 @@
    TeXLive::TLUtils::setup_programs($bindir, $platform);
@@ -1280,3 +980,546 @@ Index: tlpkg/TeXLive/TLUtils.pm
  
  =back
  
+Index: texmf/scripts/texlive/tlmgr.pl
+===================================================================
+--- texmf/scripts/texlive/tlmgr.pl	(revision 22412)
++++ texmf/scripts/texlive/tlmgr.pl	(working copy)
+@@ -124,6 +124,7 @@
+     "package-logfile" => "=s",
+     "persistent-downloads" => "!",
+     "no-execute-actions" => 1,
++    "pin-file" => "=s",
+     "pause" => 1,
+     "print-platform|print-arch" => 1,
+     "version" => 1,
+@@ -480,6 +481,12 @@
+   } elsif ($action =~ m/^option$/i) {
+     action_option();
+     finish(0);
++  } elsif ($action =~ m/^repository$/i) {
++    action_repository();
++    finish(0);
++  } elsif ($action =~ m/^candidates$/i) {
++    action_candidates();
++    finish(0);
+   } elsif ($action =~ m/^list$/i) {
+     action_list();
+     finish(0);
+@@ -1941,7 +1948,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"}) {
+@@ -2042,12 +2054,15 @@
+     $ret = 1;
+     shift;
+   }
+-  my ($pkg, $flag, $lrev, $rrev, @args) = @_;
++  my ($pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag) = @_;
+   $lrev ||= "-";
+   $rrev ||= "-";
+   $flag ||= "?";
+-  my $str = "$pkg\t$flag\t$lrev\t$rrev\t";
+-  $str .= join("\t", @args) if (@args);
++  $size ||= "-";
++  $runtime ||= "-";
++  $esttot ||= "-";
++  $tag ||= "-";
++  my $str = join("\t", $pkg, $flag, $lrev, $rrev, $size, $runtime, $esttot, $tag);
+   $str .= "\n";
+   return($str) if $ret;
+   print $str;
+@@ -2571,19 +2586,32 @@
+       my $unwind_package;
+       my $remove_unwind_container = 0;
+       my $rev = $tlp->revision;
+-      my $mediatlp = $remotetlpdb->get_package($pkg);
++      my $mediatlp;
++      my $maxtag;
++      if ($remotetlpdb->is_virtual) {
++        ($maxtag, undef, $mediatlp, undef) = 
++          $remotetlpdb->virtual_candidate($pkg);
++      } else {
++        $mediatlp = $remotetlpdb->get_package($pkg);
++      }
+       if (!defined($mediatlp)) {
+         debug("$pkg cannot be found in $location\n");
+         next;
+       }
+       my $mediarev = $mediatlp->revision;
++      my $mediarevstr = $mediarev;
++      my @addargs = ();
++      if ($remotetlpdb->is_virtual) {
++        push @addargs, $maxtag;
++        $mediarevstr .= "\@$maxtag";
++      }
+       $nrupdated++;
+       if ($opts{"list"}) {
+         if ($::machinereadable) {
+-          machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
++          machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, "-", "-", @addargs);
+         } else {
+           my $kb = int($sizes{$pkg} / 1024) + 1;
+-          info("$pkg [${kb}k]: local: $rev, source: $mediarev (update)\n");
++          info("$pkg [${kb}k]: local: $rev, source: $mediarevstr (update)\n");
+         }
+         $updated{$pkg} = 1;
+         next;
+@@ -2624,10 +2652,10 @@
+       }
+       
+       if ($::machinereadable) {
+-        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot);
++        machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}, $estrem, $esttot, @addargs);
+       } else {
+         my $kb = int ($sizes{$pkg} / 1024) + 1;
+-        info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarev)");
++        info("[$currnr/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarevstr)");
+       }
+       $donesize += $sizes{$pkg};
+       $currnr++;
+@@ -2670,7 +2698,7 @@
+       }
+       if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
+         # installation succeeded because we got a reference
+-        logpackage("update: $pkg ($rev -> $mediarev)");
++        logpackage("update: $pkg ($rev -> $mediarevstr)");
+         unlink($unwind_package) if $remove_unwind_container;
+         # remember successful update
+         $updated{$pkg} = 1;
+@@ -2698,7 +2726,7 @@
+         # now in fact we should do some cleanup, removing files and
+         # dirs from the new package before re-installing the old one.
+         # TODO
+-        logpackage("failed update: $pkg ($rev -> $mediarev)");
++        logpackage("failed update: $pkg ($rev -> $mediarevstr)");
+         tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n");
+         if (win32()) {
+           # w32 is notorious for not releasing a file immediately
+@@ -2739,12 +2767,25 @@
+             unless $::machinereadable;
+       } else {
+         # install new packages
+-        my $mediatlp = $remotetlpdb->get_package($pkg);
++        my $mediatlp;
++        my $maxtag;
++        if ($remotetlpdb->is_virtual) {
++          ($maxtag, undef, $mediatlp, undef) = 
++            $remotetlpdb->virtual_candidate($pkg);
++        } else {
++          $mediatlp = $remotetlpdb->get_package($pkg);
++        }
+         if (!defined($mediatlp)) {
+           tlwarn("\nShould not happen: $pkg not found in $location");
+           next;
+         }
+         my $mediarev = $mediatlp->revision;
++        my $mediarevstr = $mediarev;
++        my @addargs;
++        if ($remotetlpdb->is_virtual) {
++          $mediarevstr .= "\@$maxtag";
++          push @addargs, $maxtag;
++        }
+         my ($estrem, $esttot);
+         if (!$opts{"list"}) {
+           ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
+@@ -2754,14 +2795,16 @@
+           my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg});
+           if (!$opts{"list"}) {
+             push @maargs, $estrem, $esttot;
++          } else {
++            push @maargs, undef, undef;
+           }
+-          machine_line(@maargs);
++          machine_line(@maargs, @addargs);
+         } else {
+           my $kb = int($sizes{$pkg} / 1024) + 1;
+           if ($opts{"list"}) {
+-            info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n");
++            info("$pkg [${kb}k]: local: <absent>, source: $mediarevstr (auto-install)\n");
+           } else {
+-            info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg [${kb}k]\n");
++            info("[$currnr/$totalnr, $estrem/$esttot] auto-install: $pkg ($mediarevstr) [${kb}k]\n");
+           }
+         }
+         $currnr++;
+@@ -2769,7 +2812,7 @@
+         next if ($opts{"dry-run"} || $opts{"list"});
+         if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
+           # installation succeeded because we got a reference
+-          logpackage("auto-install new: $pkg ($mediarev)");
++          logpackage("auto-install new: $pkg ($mediarevstr)");
+           $nrupdated++;
+         } else {
+           tlwarn("$0: couldn't install new package $pkg\n");
+@@ -2908,6 +2951,7 @@
+   if (!(@new || @updated)) {
+     info("tlmgr: no updates available\n");
+     if ($remotetlpdb->media ne "NET"
++        && $remotetlpdb->media ne "virtual"
+         && !$opts{"dry-run"}
+         && !$opts{"repository"}
+        ) {
+@@ -2986,6 +3030,14 @@
+     @packs = $remotetlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"};
+   }
+   #
++  # expand dependencies returns a list pkg@tag in case of a virtual 
++  # remote db.
++  my %packs;
++  for my $p (@packs) {
++    my ($pp, $aa) = split('@', $p);
++    $packs{$pp} = (defined($aa) ? $aa : 0);
++  }
++  #
+   # installation order of packages:
+   # first all normal packages, then collections, then schemes
+   # isn't already installed, but the collection already updated, it will
+@@ -2993,7 +3045,7 @@
+   my @inst_packs;
+   my @inst_colls;
+   my @inst_schemes;
+-  for my $pkg (sort @packs) {
++  for my $pkg (sort keys %packs) {
+     # we do name checking here, not to load all tlpobj again and again
+     if ($pkg =~ m/^scheme-/) {
+       push @inst_schemes, $pkg;
+@@ -3012,7 +3064,11 @@
+   my @todo;
+   for my $pkg (@inst_packs, @inst_colls, @inst_schemes) {
+     my $pkgrev = 0;
+-    my $mediatlp = $remotetlpdb->get_package($pkg);
++    # if the package name is asked from a specific repository, use
++    # that one, otherwise leave the  decision to $remotetlpdb by not
++    # giving a final argument
++    my $mediatlp = $remotetlpdb->get_package($pkg, 
++      ($packs{$pkg} ? $packs{$pkg} : undef));
+     if (!defined($mediatlp)) {
+       tlwarn("package $pkg not present in package repository.\n");
+       next;
+@@ -3060,13 +3116,26 @@
+     my ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
+                               $donesize, $starttime);
+     my $kb = int($sizes{$pkg} / 1024) + 1;
++    my @addargs = ();
++    my $tagstr = "";
++    if ($remotetlpdb->is_virtual) {
++      if ($packs{$pkg} ne "0") {
++        push @addargs, $packs{$pkg};
++        $tagstr = " \@" . $packs{$pkg};
++      } else {
++        my ($maxtag,undef,undef,undef) = $remotetlpdb->virtual_candidate($pkg);
++        push @addargs, $maxtag;
++        $tagstr = " \@" . $maxtag;
++      }
++    }
+     if ($::machinereadable) {
+-      machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot);
++      machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot, @addargs);
+     } else {
+-      info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg [${kb}k]\n");
++      info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg$tagstr [${kb}k]\n");
+     }
+     if (!$opts{"dry-run"}) {
+-      $remotetlpdb->install_package($pkg, $localtlpdb);
++      $remotetlpdb->install_package($pkg, $localtlpdb, 
++        ($packs{$pkg} ? $packs{$pkg} : undef) );
+       logpackage("${re}install: $pkg");
+     }
+     $donesize += $sizes{$pkg};
+@@ -3123,7 +3192,150 @@
+   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;
++    return;
++  }
++  # we are still here, unknown command to repository
++  tlwarn("tlmgr: unknown directive to tlmgr repository: $what\n");
++  return;
++}
++
++sub action_candidates {
++  my $what = shift @ARGV;
++  if (!defined($what)) {
++    tlwarn("tlmgr: action candidates needs a package name as argument\n");
++    return;
++  }
++  init_local_db();
++  init_tlmedia();
++  my @cand = $remotetlpdb->candidates($what);
++  if (@cand) {
++    my $first = shift @cand;
++    if (defined($first)) {
++      my ($t,$r) = split(/\//, $first, 2);
++      print "Install candidate for $what from $t ($r)\n";
++    } else {
++      print "No install candidate for $what found.\n";
++    }
++    # already shifted away the first element
++    if ($#cand >= 0) {
++      print "Other repositories providing this package:\n";
++      for my $a (@cand) {
++        my ($t,$r) = split(/\//, $a, 2);
++        print "$t ($r)\n";
++      }
++    }
++  } else {
++    print "Package $what not found.\n";
++  }
++  return;
++}
++
+ #  OPTION
+ #
+ sub action_option {
+@@ -4470,6 +4682,74 @@
+ #
+ 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 %repos = repository_to_array($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'};
++  my $tlmdb = setup_one_remotetlpdb($locstr);
++  $remotetlpdb->virtual_add_tlpdb($tlmdb, "main");
++  for my $t (@tags) {
++    if ($t ne 'main') {
++      my $tlmdb = setup_one_remotetlpdb($repos{$t});
++      $remotetlpdb->virtual_add_tlpdb($tlmdb, $t);
++      $locstr .= " $repos{$t}";
++    }
++  }
++
++  # now check/setup pinning
++  # TODO for now no default pinning file!
++  if ($opts{"pin-file"}) {
++    my @pins = read_pinning_file($opts{"pin-file"});
++    if (@pins) {
++      $remotetlpdb->virtual_pinning(@pins);
++    }
++  } else {
++    # check for pinning file in TEXMFLOCAL/tlpkg/pinning.txt
++    chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
++    debug("trying to load pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
++    if (-r "$TEXMFLOCAL/tlpkg/pinning.txt") {
++      my @pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning.txt");
++      if (@pins) {
++        info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
++        $remotetlpdb->virtual_pinning(@pins);
++      }
++    }
++  }
++
++
++  # 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;
+@@ -4483,11 +4763,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,
+@@ -4632,8 +4930,30 @@
+       close($tlfh);
+     }
+   }
++
++  return($remotetlpdb);
+ }
+ 
++sub read_pinning_file {
++  my $pf = shift;
++  my @pins;
++  my $pfh;
++  if (!open($pfh, "<$pf")) {
++    tlwarn("Pinning file $pf cannot be read: $!\n");
++    return;
++  }
++  debug("Reading pinning file $pf\n");
++  while (my $l = TeXLive::TLUtils::get_full_line($pfh)) {
++    chomp($l);
++    # comments and empty lines are allowed
++    next if ($l =~ m/^\s*#/);
++    next if ($l =~ m/^\s*$/);
++    my ($a, $b) = split(/:/, $l);
++    push @pins, $remotetlpdb->make_pin_data_from_line($l);
++  }
++  close($pfh);
++  return @pins;
++}
+ 
+ 
+ # finish handles the -pause option (wait for input from stdin),