summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/dev.multi-source-support-v2.patch
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2011-05-11 04:34:12 +0000
committerNorbert Preining <preining@logic.at>2011-05-11 04:34:12 +0000
commit3d2558b609131434d2e113c6e39ced72fbe3b82d (patch)
treec95eca2507dcd04a0bb9aaa5da46402003cada6b /Master/tlpkg/dev/dev.multi-source-support-v2.patch
parent2d9c041819d03dc26ffb783cd08f16b367cb94ab (diff)
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
Diffstat (limited to 'Master/tlpkg/dev/dev.multi-source-support-v2.patch')
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.patch1265
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),