summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2012-04-17 04:09:34 +0000
committerNorbert Preining <preining@logic.at>2012-04-17 04:09:34 +0000
commit86d7c60c406474fa856d8f87d69c7fa52ccacb1b (patch)
tree9748d614778f34f9852a733539ad893ea7f2acd7
parentaca4d8c5312a2b39e994d35fa19d7dcbd12f6f28 (diff)
include multi-repository support into main subversion repo
git-svn-id: svn://tug.org/texlive/trunk@26004 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl910
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui.pl394
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm706
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support-v2.patch230
4 files changed, 1936 insertions, 304 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 7f3e38383ce..3612cc6fb35 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
# $Id$
#
-# Copyright 2008, 2009, 2010, 2011 Norbert Preining
+# Copyright 2008, 2009, 2010, 2011, 2012 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -124,6 +124,7 @@ sub main {
"package-logfile" => "=s",
"persistent-downloads" => "!",
"no-execute-actions" => 1,
+ "pin-file" => "=s",
"pause" => 1,
"print-platform|print-arch" => 1,
"version" => 1,
@@ -135,6 +136,8 @@ sub main {
"option" => { },
"conf" => { },
"version" => { },
+ "repository" => { },
+ "candidate" => { },
"backup" => { "backupdir" => "=s",
"clean" => ":-99",
"all" => 1,
@@ -504,6 +507,12 @@ sub execute_action {
} 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);
@@ -533,7 +542,7 @@ sub execute_action {
action_dumptlpdb();
finish(0);
} elsif ($action =~ m/^show$/i) {
- action_show();
+ action_show(@ARGV);
finish(0);
} elsif ($action =~ m/^remove$/i) {
action_remove();
@@ -1145,7 +1154,8 @@ sub action_show {
tlwarn("tlmgr: Cannot load taxonomy file, showing taxonomies not supported.\n");
}
}
- foreach my $pkg (@ARGV) {
+ foreach my $ppp (@_) {
+ my ($pkg, $tag) = split '@', $ppp, 2;
my $tlpdb = $localtlpdb;
my $tlp = $localtlpdb->get_package($pkg);
my $installed = 0;
@@ -1153,126 +1163,179 @@ sub action_show {
if (!$remotetlpdb) {
init_tlmedia();
}
- $tlp = $remotetlpdb->get_package($pkg);
+ if (defined($tag)) {
+ if (!$remotetlpdb->is_virtual) {
+ tlwarn("tlmgr: specifying implicite tags is not allowed for non-virtual databases!\n");
+ next;
+ } else {
+ if (!$remotetlpdb->is_repository($tag)) {
+ tlwarn("tlmgr: no such repository tag defined: $tag\n");
+ next;
+ }
+ }
+ }
+ $tlp = $remotetlpdb->get_package($pkg, $tag);
+ if (!$tlp) {
+ if (defined($tag)) {
+ # we already searched for the package in a specific tag, don't retry
+ # all candidates!
+ tlwarn("tlmgr: Cannot find package $pkg in repository $tag\n");
+ next;
+ }
+ if ($remotetlpdb->is_virtual) {
+ # we might have a package that is available in a
+ # subsidiary repository, but not installable
+ # because it is not pinned
+ # we will list it but warn about this fact
+ my @cand = $remotetlpdb->candidates($pkg);
+ if (@cand) {
+ my $first = shift @cand;
+ if (defined($first)) {
+ tlwarn("strange, we have a first candidate but no tlp: $pkg\n");
+ next;
+ }
+ # already shifted away the first element
+ if ($#cand >= 0) {
+ # recursively showing all tags, but warn
+ print "package: ", $pkg, "\n";
+ print "WARNING: This package is not pinned but present in subsidiary repositories\n";
+ print "WARNING: As long as it is not pinned it is not installable.\n";
+ print "WARNING: Listing all available copies of the package.\n";
+ my @aaa;
+ for my $a (@cand) {
+ my ($t,$r) = split(/\//, $a, 2);
+ push @aaa, "$pkg" . '@' . $t;
+ }
+ action_show(@aaa);
+ next;
+ } else {
+ tlwarn("strange, package listed but no residual candidates: $pkg\n");
+ next;
+ }
+ } else {
+ tlwarn("strange, package listed but no candidates: $pkg\n");
+ next;
+ }
+ }
+ tlwarn("tlmgr: cannot find package $pkg\n");
+ next;
+ }
$tlpdb = $remotetlpdb;
} else {
$installed = 1;
}
- if ($tlp) {
- my @colls;
- if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") {
- @colls = $localtlpdb->needed_by($pkg);
- if (!@colls) {
- # not referenced in the local tlpdb, so try the remote here, too
- if (!$remotetlpdb) {
- init_tlmedia();
- }
- @colls = $remotetlpdb->needed_by($pkg);
+ my @colls;
+ if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") {
+ @colls = $localtlpdb->needed_by($pkg);
+ if (!@colls) {
+ # not referenced in the local tlpdb, so try the remote here, too
+ if (!$remotetlpdb) {
+ init_tlmedia();
}
+ @colls = $remotetlpdb->needed_by($pkg);
}
- # some packages might depend on other packages, so do not
- # include arbitrary package in the list of collections, but
- # only collectons:
- @colls = grep {m;^collection-;} @colls;
- print "package: ", $tlp->name, "\n";
- print "category: ", $tlp->category, "\n";
- print "shortdesc: ", $tlp->shortdesc, "\n" if ($tlp->shortdesc);
- print "longdesc: ", $tlp->longdesc, "\n" if ($tlp->longdesc);
- print "installed: ", ($installed ? "Yes" : "No"), "\n";
- print "revision: ", $tlp->revision, "\n" if ($installed);
- print "cat-version: ", $tlp->cataloguedata->{'version'}, "\n"
- if $tlp->cataloguedata->{'version'};
- print "cat-date: ", $tlp->cataloguedata->{'date'}, "\n"
- if $tlp->cataloguedata->{'date'};
- print "cat-license: ", $tlp->cataloguedata->{'license'}, "\n"
- if $tlp->cataloguedata->{'license'};
- print "collection: ", @colls, "\n" if (@colls);
- if ($opts{"keyword"} || $opts{"taxonomy"}) {
- print "keywords: ";
- if (defined($taxonomy->{'by-package'}{'keyword'}{$pkg})) {
- print join(', ',@{$taxonomy->{'by-package'}{'keyword'}{$pkg}}), "\n";
- } else {
- print "(none found)\n";
- }
+ }
+ # some packages might depend on other packages, so do not
+ # include arbitrary package in the list of collections, but
+ # only collectons:
+ @colls = grep {m;^collection-;} @colls;
+ print "package: ", $tlp->name, "\n";
+ print "repository: ", $tag, "\n" if (defined($tag));
+ print "category: ", $tlp->category, "\n";
+ print "shortdesc: ", $tlp->shortdesc, "\n" if ($tlp->shortdesc);
+ print "longdesc: ", $tlp->longdesc, "\n" if ($tlp->longdesc);
+ print "installed: ", ($installed ? "Yes" : "No"), "\n";
+ print "revision: ", $tlp->revision, "\n" if ($installed);
+ print "cat-version: ", $tlp->cataloguedata->{'version'}, "\n"
+ if $tlp->cataloguedata->{'version'};
+ print "cat-date: ", $tlp->cataloguedata->{'date'}, "\n"
+ if $tlp->cataloguedata->{'date'};
+ print "cat-license: ", $tlp->cataloguedata->{'license'}, "\n"
+ if $tlp->cataloguedata->{'license'};
+ print "collection: ", @colls, "\n" if (@colls);
+ if ($opts{"keyword"} || $opts{"taxonomy"}) {
+ print "keywords: ";
+ if (defined($taxonomy->{'by-package'}{'keyword'}{$pkg})) {
+ print join(', ',@{$taxonomy->{'by-package'}{'keyword'}{$pkg}}), "\n";
+ } else {
+ print "(none found)\n";
}
- if ($opts{"functionality"} || $opts{"taxonomy"}) {
- print "function: ";
- if (defined($taxonomy->{'by-package'}{'functionality'}{$pkg})) {
- print join(', ',@{$taxonomy->{'by-package'}{'functionality'}{$pkg}}), "\n";
- } else {
- print "(none found)\n";
+ }
+ if ($opts{"functionality"} || $opts{"taxonomy"}) {
+ print "function: ";
+ if (defined($taxonomy->{'by-package'}{'functionality'}{$pkg})) {
+ print join(', ',@{$taxonomy->{'by-package'}{'functionality'}{$pkg}}), "\n";
+ } else {
+ print "(none found)\n";
+ }
+ }
+ if ($opts{"characterization"} || $opts{"taxonomy"}) {
+ print "primary characterization: ";
+ if (defined($taxonomy->{'by-package'}{'primary'}{$pkg})) {
+ print $taxonomy->{'by-package'}{'primary'}{$pkg}, "\n";
+ } else {
+ print "(none found)\n";
+ }
+ print "secondary characterization: ";
+ if (defined($taxonomy->{'by-package'}{'secondary'}{$pkg})) {
+ print $taxonomy->{'by-package'}{'secondary'}{$pkg}, "\n";
+ } else {
+ print "(none found)\n";
+ }
+ }
+ if ($opts{"list"}) {
+ if ($tlp->category eq "Collection" || $tlp->category eq "Scheme") {
+ # in the case of collections of schemes we list the deps
+ my @deps = $tlp->depends;
+ if (@deps) {
+ print "depends:\n";
+ for my $d (@deps) {
+ print "\t$d\n";
+ }
}
}
- if ($opts{"characterization"} || $opts{"taxonomy"}) {
- print "primary characterization: ";
- if (defined($taxonomy->{'by-package'}{'primary'}{$pkg})) {
- print $taxonomy->{'by-package'}{'primary'}{$pkg}, "\n";
- } else {
- print "(none found)\n";
+ print "Included files, by type:\n";
+ # if the package has a .ARCH dependency we also list the files for
+ # those packages
+ my @todo = $tlpdb->expand_dependencies("-only-arch", $tlpdb, ($pkg));
+ for my $d (sort @todo) {
+ my $foo = $tlpdb->get_package($d);
+ if (!$foo) {
+ tlwarn ("\nShould not happen, no dependent package $d\n");
+ next;
}
- print "secondary characterization: ";
- if (defined($taxonomy->{'by-package'}{'secondary'}{$pkg})) {
- print $taxonomy->{'by-package'}{'secondary'}{$pkg}, "\n";
- } else {
- print "(none found)\n";
+ if ($d ne $pkg) {
+ print "depending package $d:\n";
}
- }
- if ($opts{"list"}) {
- if ($tlp->category eq "Collection" || $tlp->category eq "Scheme") {
- # in the case of collections of schemes we list the deps
- my @deps = $tlp->depends;
- if (@deps) {
- print "depends:\n";
- for my $d (@deps) {
- print "\t$d\n";
- }
- }
+ if ($foo->runfiles) {
+ print "run files:\n";
+ for my $f (sort $foo->runfiles) { print " $f\n"; }
}
- print "Included files, by type:\n";
- # if the package has a .ARCH dependency we also list the files for
- # those packages
- my @todo = $tlpdb->expand_dependencies("-only-arch", $tlpdb, ($pkg));
- for my $d (sort @todo) {
- my $foo = $tlpdb->get_package($d);
- if (!$foo) {
- tlwarn ("\nShould not happen, no dependent package $d\n");
- next;
- }
- if ($d ne $pkg) {
- print "depending package $d:\n";
- }
- if ($foo->runfiles) {
- print "run files:\n";
- for my $f (sort $foo->runfiles) { print " $f\n"; }
- }
- if ($foo->srcfiles) {
- print "source files:\n";
- for my $f (sort $foo->srcfiles) { print " $f\n"; }
- }
- if ($foo->docfiles) {
- print "doc files:\n";
- for my $f (sort $foo->docfiles) {
- print " $f";
- my $dfd = $foo->docfiledata;
- if (defined($dfd->{$f})) {
- for my $k (keys %{$dfd->{$f}}) {
- print " $k=\"", $dfd->{$f}->{$k}, '"';
- }
+ if ($foo->srcfiles) {
+ print "source files:\n";
+ for my $f (sort $foo->srcfiles) { print " $f\n"; }
+ }
+ if ($foo->docfiles) {
+ print "doc files:\n";
+ for my $f (sort $foo->docfiles) {
+ print " $f";
+ my $dfd = $foo->docfiledata;
+ if (defined($dfd->{$f})) {
+ for my $k (keys %{$dfd->{$f}}) {
+ print " $k=\"", $dfd->{$f}->{$k}, '"';
}
- print "\n";
}
- }
- # in case we have them
- if ($foo->allbinfiles) {
- print "bin files (all platforms):\n";
- for my $f (sort $foo->allbinfiles) { print " $f\n"; }
+ print "\n";
}
}
+ # in case we have them
+ if ($foo->allbinfiles) {
+ print "bin files (all platforms):\n";
+ for my $f (sort $foo->allbinfiles) { print " $f\n"; }
+ }
}
- print "\n";
- } else {
- printf STDERR "tlmgr: cannot find $pkg\n";
}
+ print "\n";
}
return;
}
@@ -2048,7 +2111,12 @@ sub auto_remove_install_force_packages {
# 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"}) {
@@ -2149,17 +2217,38 @@ sub machine_line {
$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;
}
+sub upd_info {
+ my ($pkg, $kb, $lrev, $mrev, $txt) = @_;
+ my $flen = 25;
+ my $kbstr = ($kb >= 0 ? " [${kb}k]" : "");
+ my $kbstrlen = length($kbstr);
+ my $pkglen = length($pkg);
+ my $is = sprintf("%-9s ", "$txt:");
+ if ($pkglen + $kbstrlen > $flen) {
+ $is .= "$pkg$kbstr: ";
+ } else {
+ $is .= sprintf ('%*2$s', $pkg, -($flen-$kbstrlen));
+ $is .= "$kbstr: ";
+ }
+ $is .= sprintf("local: %8s, source: %8s",
+ $lrev, $mrev);
+ info("$is\n");
+}
+
sub action_update {
init_local_db(1);
$opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
@@ -2414,20 +2503,36 @@ sub action_update {
next;
}
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";
+ }
if ($rev < $mediarev) {
$updated{$pkg} = 0; # will be changed to one on successful update
} elsif ($rev > $mediarev) {
if ($::machinereadable) {
push @addlines,
- machine_line("-ret", $pkg, $FLAG_REVERSED_UPDATE, $rev, $mediarev, "-");
+ machine_line("-ret", $pkg, $FLAG_REVERSED_UPDATE, $rev, $mediarev, "-", @addargs);
} else {
- info("$pkg: local: $rev, source: $mediarev (reverse, keep)\n");
+ if ($opts{"list"}) {
+ # not issueing anything if we keep a package
+ upd_info($pkg, -1, $rev, $mediarevstr, "keep");
+ }
}
}
}
@@ -2525,6 +2630,8 @@ sub action_update {
}
}
+ # parameters for field width
+ my $totalnrdigits = length("$totalnr");
#
# ORDER OF PACKAGE ACTIONS
@@ -2557,7 +2664,7 @@ sub action_update {
if ($::machinereadable) {
machine_line($p, $FLAG_REMOVE, $rev, "-", "-", "-");
} else {
- info("$p: local: $rev, source: <absent> (auto-remove)\n");
+ upd_info($p, -1, $rev, "<absent>", "autorm");
}
$currnr++;
} else {
@@ -2569,7 +2676,8 @@ sub action_update {
if ($::machinereadable) {
machine_line($p, $FLAG_REMOVE, $rev, "-", "-", "-");
} else {
- info("[$currnr/$totalnr] auto-remove: $p\n");
+ info("[" . sprintf ('%*2$s', $currnr, $totalnrdigits) .
+ "/$totalnr] auto-remove: $p ... ");
}
if (!$opts{"dry-run"}) {
if ($opts{"backup"}) {
@@ -2585,6 +2693,7 @@ sub action_update {
$localtlpdb->remove_package($p);
logpackage("remove: $p");
}
+ info("done\n") unless $::machinereadable;
$currnr++;
}
}
@@ -2678,19 +2787,44 @@ sub action_update {
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");
+ upd_info($pkg, $kb, $rev, $mediarevstr, "update");
+ if ($remotetlpdb->is_virtual) {
+ my @cand = $remotetlpdb->candidates($pkg);
+ shift @cand; # remove the top element
+ if (@cand) {
+ print "\tother candidates: ";
+ for my $a (@cand) {
+ my ($t,$r) = split(/\//, $a, 2);
+ print $r . '@' . $t . " ";
+ }
+ print "\n";
+ }
+ }
}
$updated{$pkg} = 1;
next;
@@ -2731,10 +2865,11 @@ sub action_update {
}
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("[" . sprintf ('%*2$s', $currnr, $totalnrdigits) .
+ "/$totalnr, $estrem/$esttot] update: $pkg [${kb}k] ($rev -> $mediarevstr)");
}
$donesize += $sizes{$pkg};
$currnr++;
@@ -2777,7 +2912,7 @@ sub action_update {
}
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;
@@ -2805,7 +2940,7 @@ sub action_update {
# 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
@@ -2846,12 +2981,25 @@ sub action_update {
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\n");
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,
@@ -2861,14 +3009,16 @@ sub action_update {
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");
+ upd_info($pkg, $kb, "<absent>", $mediarevstr, "autoinst");
} 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++;
@@ -2876,7 +3026,7 @@ sub action_update {
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");
@@ -3023,6 +3173,7 @@ sub action_update {
if (!(@new || @updated)) {
info("tlmgr: no updates available\n");
if ($remotetlpdb->media ne "NET"
+ && $remotetlpdb->media ne "virtual"
&& !$opts{"dry-run"}
&& !$opts{"repository"}
) {
@@ -3101,6 +3252,14 @@ sub action_install {
@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
@@ -3108,7 +3267,7 @@ sub action_install {
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;
@@ -3127,7 +3286,11 @@ sub action_install {
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;
@@ -3175,13 +3338,26 @@ sub action_install {
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};
@@ -3204,7 +3380,7 @@ sub action_list {
# we list them, otherwise we go direct into tlmgr show $pkg mode
if ($what !~ m/^(collection|scheme)/i) {
tlwarn("(switching to show mode)\n");
- action_show();
+ action_show(@ARGV);
return;
}
} else {
@@ -3223,7 +3399,11 @@ sub action_list {
} elsif ($what =~ m/^scheme/i) {
@whattolist = $tlm->schemes;
} else {
- @whattolist = $tlm->list_packages;
+ if ($tlm->is_virtual) {
+ @whattolist = $tlm->list_packages("-all");
+ } else {
+ @whattolist = $tlm->list_packages;
+ }
}
foreach (@whattolist) {
next if ($_ =~ m/^00texlive/);
@@ -3232,12 +3412,198 @@ sub action_list {
} else {
print " ";
}
- my $foo = $tlm->get_package($_)->shortdesc;
+ my $tlp = $tlm->get_package($_);
+ if (!$tlp) {
+ if ($remotetlpdb->is_virtual) {
+ # we might have the case that a package is present in a
+ # subsidiary repository, but not pinned, so it will
+ # not be found by ->get_package
+ # In this case we list all repositories shipping it,
+ # but warn that it is not pinned and thus not reachable.
+ my @cand = $remotetlpdb->candidates($_);
+ if (@cand) {
+ my $first = shift @cand;
+ if (defined($first)) {
+ tlwarn("strange, we have a first candidate but no tlp: $_\n");
+ next;
+ }
+ # already shifted away the first element
+ if ($#cand >= 0) {
+ print "$_: --- no installable candidate found, \n";
+ print " but present in subsidiary repositories without a pin.\n";
+ print " This package is not reachable without pinning.\n";
+ print " Repositories containing this package:\n";
+ for my $a (@cand) {
+ my ($t,$r) = split(/\//, $a, 2);
+ my $tlp = $remotetlpdb->get_package($_, $t);
+ my $foo = $tlp->shortdesc;
+ print " $t: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n";
+ }
+ next;
+ } else {
+ tlwarn("strange, package listed but no residual candidates: $_\n");
+ next;
+ }
+ } else {
+ tlwarn("strange, package listed but no candidates: $_\n");
+ next;
+ }
+ } else {
+ tlwarn("strange, package cannot be found in remote tlpdb: $_\n");
+ next;
+ }
+ }
+ my $foo = $tlp->shortdesc;
print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n";
}
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") {
+ # TODO TODO
+ # we have to make sure that there is ONE main repository!!!
+ %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
#
@@ -4601,7 +4967,93 @@ sub init_local_db {
#
sub init_tlmedia
{
- if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
+ # 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;
+ # if we have only one repo, but this one contains a name tag #....
+ # then we remove it and save the local tlpdb
+ if ($#tags == 0 && ($location =~ m/#/)) {
+ $location = $repos{$tags[0]};
+ $localtlpdb->option("location", $location);
+ $localtlpdb->save;
+ %repos = repository_to_array($location);
+ }
+ # 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:\n");
+ info("\tmain = " . $repos{'main'} . "\n");
+ for my $t (@tags) {
+ if ($t ne 'main') {
+ info("\t$t = " . $repos{$t} . "\n");
+ }
+ }
+}
+
+
+
+
+sub _init_tlmedia
+{
+
+ # if we are already initialized to the same location, nothing
+ # needs to be done.
+ # if we are initialized to a virtual tlpdb, then we have to
+ # do in any case an initialization
+ if (defined($remotetlpdb) && !$remotetlpdb->is_virtual &&
+ ($remotetlpdb->root eq $location)) {
# nothing to be done
return;
}
@@ -4614,10 +5066,28 @@ sub init_tlmedia
$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
@@ -4763,8 +5233,30 @@ FROZEN
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),
@@ -5561,6 +6053,42 @@ written to the terminal.
=back
+=head2 repositoy
+
+=over 4
+
+=item B<repository list>
+
+=item B<repository add I<path> [I<tag>]>
+
+=item B<repository remove I<path|tag>>
+
+=item B<repository set I<path>[#I<tag>] [I<path>[#I<tag>] ...]>
+
+This action manages the list of repositories. See L</"MULTIPLE REPOSITORIES">
+below for detailed explanations.
+
+The first form list all configured repositories and the respective tags
+if set. The second form adds a repository (and optionally attaching a
+tag) to the list of repositories. The third from removes a repository,
+either by full path/url, or by tag. The last form sets the list
+of repositories to the items given on the command line, not keeping
+previous settings. Be reminded that one of the repositories has to
+be tagged as B<main>, otherwise all operations will fail.
+
+=back
+
+=head2 candidates
+
+=over 4
+
+=item B<candidates I<pkg>>
+
+Shows the list of available candidates for package I<pkg>. See
+L</"MULTIPLE REPOSITORIES"> below for details.
+
+
+=back
=head2 option
@@ -6198,6 +6726,118 @@ C<gui-expertmode> switches between the full
GUI and a simplified GUI with only the important and mostly used
settings.
+=head1 MULTIPLE REPOSITORIES
+
+Most packages are distributed via the main TeX Live repository, but
+sometimes local repositories are used to provide local packages
+(like commercial fonts, internal styles), as well as alternative
+package repositories for packages that cannot be included in
+proper TeX Live due to license or other reasons.
+
+Without multiple repository support using these additional repositories
+needed an extra invocation and temporarily setting the installation
+source to this additional repository. By setting up all the
+repositories as sources of packages one does not need to
+use multiple invocations of tlmgr anymore.
+
+B<Warning:> Although support for multiple repositories has been
+tested extensively, it does not guarantee proper operation. If you
+want to be sure not to break anything, consider continuing
+using multiple invocations of tlmgr.
+
+When using multiple repositories, one has to be the main repository,
+which distributes most of the TeX Live packages. If you convert
+from a single repository installation to a multiple repository
+installation (by calling tlmgr repository add), the previously
+set repository will be set as the main repository.
+
+By default, even if multiple repositories are configured, packages
+are B<only> installed from the main repository, as long as
+packages are not explicitely pinned to a different repository.
+That also means by simply adding another repository you will
+B<not> be able to install the packages from there, you first
+have to specify which packages should be taken from a
+different repository by specifying some pinning rules.
+
+=head2 Pinning
+
+Pinning a package is done by editing (adding) a file
+
+ TEXMFLOCAL/tlpkg/pinning.txt
+
+which contains lines
+
+ repo:pkg[,pkg]
+
+In this line the C<repo> is either the full URL saved in the
+list or repositories, or one of the tags given. The C<pkg>
+are shell style globs for packages.
+
+By default everything is pinned to the main repository, so
+you can imagine that at the end of the file pinning.txt there
+is a line
+
+ main:*
+
+If a package C<foo> is pinned to a repository, any package
+C<foo> in any other repository, even if it has a higher
+revision number, will not be considered as installable
+candidate.
+
+=head2 Usage example with tlcontrib
+
+- check current repository:
+
+ $ tlmgr repository list
+ List of repositories (with tags if set):
+ /var/www/norbert/tlnet
+
+- add tlcontrib repository (and give it a short name)
+
+ $ tlmgr repository add http://tlcontrib.metatex.org/2011 tlcontrib
+
+- check repositories:
+
+ $ tlmgr repository list
+ List of repositories (with tags if set):
+ http://tlcontrib.metatex.org/2011 (tlcontrib)
+ /var/www/norbert/tlnet (main)
+
+
+- add a pinning to get cowfont from tlcontrib:
+
+ $ mkdir -p `kpsewhich -var-value TEXMFLOCAL`/tlpkg
+ $ echo "tlcontrib:cowfont" > `kpsewhich -var-value TEXMFLOCAL`/tlpkg/pinning.txt
+
+- check that we can find cowfont:
+
+ $ tlmgr show cowfont
+ tlmgr: using pinning file .../tlpkg/pinning.txt
+ tlmgr: package repository /var/www/norbert/tlnet http://tlcontrib.metatex.org/2011
+ package: cowfont
+ category: Package
+ ...
+
+- install cowfont and context (which is needed!)
+
+ $ tlmgr install context cowfont
+ tlmgr: using pinning file .../tlpkg/pinning.txt
+ tlmgr: package repository /var/www/norbert/tlnet http://tlcontrib.metatex.org/2011
+ [1/11, ??:??/??:??] install: context.x86_64-linux @main [84k]
+ [2/11, 00:00/00:00] install: context @main [4274k]
+ [3/11, 00:01/00:02] install: cowfont @tlcontrib [655k]
+ [4/11, 00:05/00:09] install: metapost.x86_64-linux @main [198k]
+ [5/11, 00:05/00:09] install: metapost @main [72k]
+ [6/11, 00:05/00:09] install: mptopdf.x86_64-linux @main [1k]
+ [7/11, 00:06/00:11] install: mptopdf @main [37k]
+ [8/11, 00:06/00:11] install: stmaryrd @main [163k]
+ [9/11, 00:07/00:12] install: xetex.x86_64-linux @main [4442k]
+ [10/11, 00:08/00:08] install: xetex @main [46k]
+ [11/11, 00:08/00:08] install: xetexconfig @main [13k]
+ ...
+
+In the last part you see that the cowfont is installed from
+the tlcontrib part (@tlcontrib).
=head1 TAXONOMIES
diff --git a/Master/texmf/scripts/texlive/tlmgrgui.pl b/Master/texmf/scripts/texlive/tlmgrgui.pl
index e2eb221e69a..ccf6a28f684 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui.pl
@@ -1,13 +1,17 @@
#!/usr/bin/env perl
# $Id$
#
-# Copyright 2009, 2010 Norbert Preining
+# Copyright 2009, 2010, 2011, 2012 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
# GUI for tlmgr
# version 2, completely rewritten GUI
#
+#
+# TODO FOR MULTI SUPPORT
+# - colorize the General config tab, if something is changed, show it in RED
+# that can actually applied to single repo tlmgrgui, too
# TODO: Fix return codes of execute_action sub items and execute_action
# so that we can give a decent warning window
# TODO: implement path adjustment also for Windows
@@ -60,8 +64,17 @@ our %opts;
our @update_function_list;
my $tlpdb_location;
+my %tlpdb_repos;
+my @tlpdb_tags;
my $cmdline_location;
my @critical_updates = ();
+
+my $single_repo_mode = 1;
+my %repos;
+my @tags;
+
+my $location_button; # uggg, change from far away ...
+
#
# shortcuts for padding, expand/fill, and pack sides, anchors
my @p_ii = qw/-padx 2m -pady 2m/;
@@ -97,6 +110,7 @@ my $lighttext;
my $darktext;
my $match_entry;
my $loaded_text;
+my $loaded_text_button;
#
# communication between filters and the rest
@@ -169,6 +183,8 @@ sub guimain {
# cmd line > tlpdb
# save the two possible location for the menu
$tlpdb_location = $localtlpdb->option("location");
+ %tlpdb_repos = repository_to_array($tlpdb_location);
+ @tlpdb_tags = keys %tlpdb_repos;
if (defined($opts{"location"})) {
$cmdline_location = $opts{"location"};
}
@@ -261,14 +277,13 @@ sub do_rest_of_gui {
-selectmode => "none");
my $button_frame = $mw->Frame;
- my $but;
- $but = $button_frame->Button(-text => __("Load default"),
- -command => sub { setup_location($tlpdb_location); $but->packForget; });
- $but->pack(
+ $loaded_text_button = $button_frame->Button(-text => __("Load default"),
+ -command => sub { setup_location($tlpdb_location); });
+ $loaded_text_button->pack(
-anchor => 'e', -padx => 0, -pady => 0,
-ipadx => 0, -ipady => 0, -side => 'right');
$loaded_text = $button_frame->Label(
- -text => __("Loaded repository:") . " " .__("none"));
+ -text => __("Loaded repository:") . " " . __("none"));
$loaded_text->pack(-anchor => 'e', -padx => 0, -pady => 0,
-ipadx => 0, -ipady => 0, -side => 'right');
@@ -484,8 +499,14 @@ sub setup_menu_system {
#
# FILE MENU
#
+ my %foo = repository_to_array($tlpdb_location);
+ my @bar = keys %foo;
+ my $tlpdb_location_string = $tlpdb_location;
+ if ($#bar > 0) {
+ $tlpdb_location_string = __("multiple repositories");
+ }
$menu_file->add('command',
- -label => __("Load default repository:") . " $tlpdb_location",
+ -label => __("Load default repository:") . " $tlpdb_location_string",
-command => sub { setup_location($tlpdb_location); });
if (defined($cmdline_location)) {
$menu_file->add('command', -label => __("Load cmd line repository:") . " $cmdline_location",
@@ -663,7 +684,7 @@ sub show_extended_info {
-sticky => "nw");
}
$tf->Label(-text => __("Remote Revision:"))->grid(
- $tf->Label(-text => $Packages{$p}{'remoterevision'}),
+ $tf->Label(-text => $Packages{$p}{'remoterevisionstring'}),
-sticky => "nw");
if (defined($Packages{$p}{'remotecatalogueversion'})) {
$tf->Label(-text => __("Remote Catalogue Version:"))->grid(
@@ -838,7 +859,7 @@ sub update_grid {
$t .= " ($Packages{$p}{'localcatalogueversion'})";
}
$g->itemCreate($p, 2, -itemtype => 'text', -style => $st, -text => $t);
- $t = ($Packages{$p}{'remoterevision'} || '');
+ $t = ($Packages{$p}{'remoterevisionstring'} || '');
if ($Packages{$p}{'remotecatalogueversion'}) {
$t .= " ($Packages{$p}{'remotecatalogueversion'})";
}
@@ -905,9 +926,13 @@ sub MatchesFilters {
return 0;
}
# check first for the default search type, the descriptions
+ # also match the remoterevisionstring to get search for repositories
if ($match_descriptions) {
if ($Packages{$p}{'match_desc'} =~ m/$r/i) {
$found = 1;
+ } elsif (defined($Packages{$p}{'remoterevisionstring'}) &&
+ $Packages{$p}{'remoterevisionstring'} =~ m/$r/i) {
+ $found = 1;
}
}
if (!$found) {
@@ -1046,12 +1071,20 @@ sub init_defaults_setting {
}
%changeddefaults = ();
for my $k (keys %defaults) {
+ $changeddefaults{$k}{'changed'} = 0;
$changeddefaults{$k}{'value'} = $defaults{$k};
if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") {
$changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No"));
} else {
if ($k eq "file_assocs") {
$changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}];
+ } elsif ($k eq "location") {
+ if ($#tlpdb_tags > 0) {
+ # we are using multiple repositories
+ $changeddefaults{$k}{'display'} = __("multiple repositories");
+ } else {
+ $changeddefaults{$k}{'display'} = $defaults{$k};
+ }
} else {
$changeddefaults{$k}{'display'} = $defaults{$k};
}
@@ -1075,11 +1108,23 @@ sub do_general_settings {
push @config_set_l,
$back_config_set->Label(-text => __("Default package repository"), -anchor => "w");
- push @config_set_m,
- $back_config_set->Label(-textvariable => \$changeddefaults{"location"}{'display'});
- push @config_set_r,
- $back_config_set->Button(-text => __("Change"),
- -command => sub { menu_default_location($sw); });
+ if ($#tlpdb_tags > 0) {
+ my @vals = map { "$_:$tlpdb_repos{$_}" } sort sort_main_first @tlpdb_tags;
+ $location_button = $back_config_set->Button(-relief => 'flat',
+ -textvariable => \$changeddefaults{"location"}{'display'});
+ $location_button->configure(
+ -command => sub { transient_show_multiple_repos($location_button, @vals); });
+ push @config_set_m, $location_button;
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { menu_multi_location($sw); });
+ } else {
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"location"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { menu_default_location($sw); });
+ }
if ($mode_expert) {
@@ -1383,48 +1428,240 @@ sub do_and_warn_gui_mode_settings {
}
}
-#
-# this function is used to edit/change the default tlpdb repository
-# we also want to change the menu entry if we change that
-sub menu_default_location {
- my $mw = shift;
+sub ask_one_repository {
+ my ($mw, $title, $info) = @_;
my $val;
- my $sw = $mw->Toplevel(-title => __("Change default package repository"));
+ my $done;
+ my $sw = $mw->Toplevel(-title => $title);
$sw->transient($mw);
- $sw->grab();
- $sw->Label(-text => __("New default package repository"))->pack(-padx => "2m", -pady => "2m");
+ $sw->withdraw;
+ $sw->Label(-text => $info)->pack(-padx => "2m", -pady => "2m");
my $f1 = $sw->Frame;
- my $entry = $f1->Entry(-text => $val, -width => 50);
- $entry->pack(-side => "left",-padx => "2m", -pady => "2m");
+ my @mirror_list;
+ push @mirror_list, " " . __("Default remote repository") . ": http://mirror.ctan.org";
+ push @mirror_list, TeXLive::TLUtils::create_mirror_list();
+ my $entry = $f1->BrowseEntry(
+ -listheight => 12,
+ -listwidth => 400,
+ -width => 50,
+ -autolistwidth => 1,
+ -choices => \@mirror_list,
+ -browsecmd =>
+ sub {
+ if ($val !~ m/^ /) {
+ $val = "";
+ } elsif ($val =~ m!(http|ftp)://!) {
+ $val = TeXLive::TLUtils::extract_mirror_entry($val);
+ } else {
+ $val =~ s/^\s*//;
+ }
+ },
+ -variable => \$val)->pack(-side => "left",-padx => "2m", -pady => "2m");
+
+ #my $entry = $f1->Entry(-text => $val, -width => 50);
+ #$entry->pack(-side => "left",-padx => "2m", -pady => "2m");
my $f2 = $sw->Frame;
$f2->Button(-text => __("Choose Directory"),
-command => sub {
- my $var = $sw->chooseDirectory;
- if (defined($var)) {
- $entry->delete(0,"end");
- $entry->insert(0,$var);
- }
+ $val = $sw->chooseDirectory;
+ #if (defined($var)) {
+ # $entry->delete(0,"end");
+ # $entry->insert(0,$var);
+ #}
})->pack(-side => "left",-padx => "2m", -pady => "2m");
$f2->Button(-text => __("Default remote repository"),
-command => sub {
- $entry->delete(0,"end");
- $entry->insert(0,$TeXLiveURL);
+ #$entry->delete(0,"end");
+ #$entry->insert(0,$TeXLiveURL);
+ $val = $TeXLiveURL;
})->pack(-side => "left",-padx => "2m", -pady => "2m");
$f1->pack;
$f2->pack;
my $f = $sw->Frame;
my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub { $done = 1; }
+ )->pack(-side => 'left',-padx => "2m", -pady => "2m");
+ my $cancelbutton = $f->Button(-text => __("Cancel"),
+ -command => sub { $val = undef; $done = 1; }
+ )->pack(-side => 'right',-padx => "2m", -pady => "2m");
+ $f->pack(-expand => 'x');
+ $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+ my $old_focus = $sw->focusSave;
+ my $old_grab = $sw->grabSave;
+ $sw->Popup;
+ $sw->grab;
+ $sw->waitVariable(\$done);
+ $sw->grabRelease if Tk::Exists($sw);
+ $sw->destroy if Tk::Exists($sw);
+ return $val;
+}
+
+sub menu_default_location {
+ my $mw = shift;
+ my $ret = ask_one_repository($mw, __("Change default package repository"),
+ __("New default package repository"));
+ if (defined($ret)) {
+ $changeddefaults{'location'}{'value'} =
+ $changeddefaults{'location'}{'display'} = $ret;
+ }
+}
+
+sub sort_main_first {
+ if ($a eq 'main') {
+ if ($b eq 'main') {
+ return 0;
+ } else {
+ return -1;
+ }
+ } else {
+ if ($b eq 'main') {
+ return 1;
+ } else {
+ return ($a cmp $b);
+ }
+ }
+}
+
+sub menu_multi_location {
+ my $mw = shift;
+ my $val;
+ our $sw = $mw->Toplevel(-title => __("Edit default package repositories"));
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => __("Specify set of repositories to be used"))->pack(-padx => "2m", -pady => "2m");
+
+ our $f1 = $sw->Frame;
+ my @entry_tag; our $tagw = 10;
+ my @entry_loc; our $locw = 30;
+ my @entry_del;
+ my @entry_chg;
+
+ my $addrepo_button;
+
+
+ sub add_buttons {
+ my ($ref) = @_;
+ my $t = $ref->{'tag'};
+ $ref->{'tag_w'} = $f1->Entry(-textvariable => \$ref->{'tag'}, -state => ($t eq "main" ? 'readonly' : 'normal'), -width => $tagw);
+ $ref->{'val_w'} = $f1->Entry(-textvariable => \$ref->{'val'}, -width => $locw);
+ $ref->{'del_w'} = $f1->Button(-text => __("Delete"),
+ -state => ($t eq "main" ? 'disabled' : 'normal'),
+ -command => sub {
+ $ref->{'status'} = 0;
+ $ref->{'tag_w'}->configure(-state => 'disabled');
+ $ref->{'val_w'}->configure(-state => 'disabled');
+ $ref->{'del_w'}->configure(-state => 'disabled');
+ $ref->{'chg_w'}->configure(-state => 'disabled');
+ });
+ $ref->{'chg_w'} = $f1->Button(-text => __("Change"),
+ -command => sub {
+ my $ret = ask_one_repository($sw, __("Change " . ($t eq "main" ? "main" : "subsidiary") . " package repository"),
+ __(($t eq "main" ? "Change main" : "New subsidiary") . " package repository"));
+ $ref->{'val'} = $ret if (defined($ret));
+ });
+ }
+
+ my %changed_repos = repository_to_array($changeddefaults{'location'}{'value'});
+
+ my @edit_repos;
+ push @edit_repos, { 'tag' => 'main', 'val' => $changed_repos{'main'}, 'status' => 1};
+ for my $k (sort keys %changed_repos) {
+ next if ($k eq "main");
+ push @edit_repos, { 'tag'=> $k, 'val' => $changed_repos{$k}, 'status' => 1 };
+ }
+ for my $ref (@edit_repos) {
+ add_buttons($ref);
+ }
+ for my $ref (@edit_repos) {
+ my %foo = %$ref;
+ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
+ -padx => "1m", -pady => "1m", -sticky => "nwe");
+ }
+ $addrepo_button = $f1->Button(-text => __("Add repository") . "...",
+ -command => sub {
+ my $ret = ask_one_repository($sw, __("Add package repository"),
+ __("Add package repository"));
+ if (defined($ret)) {
+ $addrepo_button->gridForget;
+ my %foo = ( 'tag' => $ret, 'val' => $ret, 'status' => 1 );
+ add_buttons(\%foo);
+ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
+ -padx => "1m", -pady => "1m", -sticky => "nwe");
+ push @edit_repos, \%foo;
+ }
+ $addrepo_button->grid(-columnspan => 2, -column => 2);
+ });
+ $addrepo_button->grid(-columnspan => 2, -column => 2);
+
+ $f1->pack;
+
+ my $f = $sw->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
-command =>
sub {
- $changeddefaults{'location'}{'value'} =
- $changeddefaults{'location'}{'display'} = $entry->get;
+ # we have to check if something has changed ... and for consistency!!!
+ my %new_repos;
+ for my $ref (@edit_repos) {
+ my %foo = %$ref;
+ if ($foo{'status'}) {
+ if (defined($new_repos{$foo{'tag'}})) {
+ $sw->Dialog(-title => __("Warning"),
+ -text => __("Multiple defined tags (first column) are not possible, please fix it."), -buttons => [ __("Ok") ])->Show;
+ return;
+ }
+ $new_repos{$foo{'tag'}} = $foo{'val'};
+ }
+ }
+ my $differs = 0;
+ for my $k (keys %changed_repos) {
+ if (!defined($new_repos{$k})) {
+ $differs = 1;
+ last;
+ }
+ if ($changed_repos{$k} ne $new_repos{$k}) {
+ $differs = 1;
+ last;
+ }
+ }
+ if (!$differs) {
+ # do the same the other way round
+ for my $k (keys %new_repos) {
+ if (!defined($changed_repos{$k})) {
+ $differs = 1;
+ last;
+ }
+ if ($changed_repos{$k} ne $new_repos{$k}) {
+ $differs = 1;
+ last;
+ }
+ }
+ }
+ if ($differs) {
+ # print "current repos:\n";
+ # for my $ref (@edit_repos) {
+ # print "tag = $ref->{'tag'}\n";
+ # print "val = $ref->{'val'}\n";
+ # print "act = $ref->{'status'}\n";
+ # }
+ $changeddefaults{'location'}{'value'} = array_to_repository(%new_repos);
+ $changeddefaults{'location'}{'display'} = __("multiple repositories");
+ my @vals = map { "$_:$new_repos{$_}" }
+ sort sort_main_first keys %new_repos;
+ $location_button->configure(
+ -command => sub { transient_show_multiple_repos($location_button, @vals); });
+ } else {
+ # print "Nothing happend!\n";
+ }
$sw->destroy;
})->pack(-side => 'left',-padx => "2m", -pady => "2m");
my $cancelbutton = $f->Button(-text => __("Cancel"),
-command => sub { $sw->destroy })->pack(-side => 'right',-padx => "2m", -pady => "2m");
+ my $resetbutton = $f->Button(-text => __("Revert"),
+ -command => sub { $sw->destroy; menu_multi_location($mw); })->pack(-side => 'right',-padx => "2m", -pady => "2m");
$f->pack(-expand => 'x');
$sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
$sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
@@ -1554,19 +1791,27 @@ sub select_file_assocs {
sub setup_location {
my $loc = shift;
$location = $loc;
- update_loaded_location_string();
+ # first check if $location contains multiple locations
+ # in this case we go to virtual mode
+ %repos = ();
+ %repos = repository_to_array($location);
+ @tags = keys %repos;
+ if ($#tags == 0) {
+ $single_repo_mode = 1;
+ } else {
+ $single_repo_mode = 0;
+ }
run_update_functions();
}
sub init_install_media {
my $newroot = $location;
- if (defined($remotetlpdb) && ($remotetlpdb->root eq $newroot)) {
+ if (defined($remotetlpdb) && !$remotetlpdb->is_virtual &&
+ ($remotetlpdb->root eq $newroot)) {
# nothing to be done
} else {
$mw->Busy(-recurse => 1);
- info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n");
- $remotetlpdb = TeXLive::TLPDB->new(root => $newroot);
- info(__("Completed") . ".\n");
+ init_tlmedia();
$mw->Unbusy;
if (!defined($remotetlpdb)) {
# something went badly wrong, maybe the newroot is wrong?
@@ -1725,7 +1970,7 @@ sub reinit_local_tlpdb {
# sub populate_Packages
#
sub populate_Packages {
- my ($mode, $tlp) = @_;
+ my ($mode, $tlp, $maxtag) = @_;
my $p = $tlp->name;
$Packages{$p}{'displayname'} = $p;
if ($mode eq "local") {
@@ -1736,6 +1981,10 @@ sub populate_Packages {
$Packages{$p}{'tlp'} = $tlp;
} else {
$Packages{$p}{'remoterevision'} = $tlp->revision;
+ $Packages{$p}{'remoterevisionstring'} = $tlp->revision;
+ if ($remotetlpdb->is_virtual) {
+ $Packages{$p}{'remoterevisionstring'} .= "\@$maxtag";
+ }
$Packages{$p}{'selected'} = 0
unless defined $Packages{$p}{'selected'};
if (!defined($Packages{$p}{'tlp'})) {
@@ -1865,6 +2114,7 @@ sub update_list_remote {
next;
}
delete $Packages{$p}{'remoterevision'};
+ delete $Packages{$p}{'remoterevisionstring'};
delete $Packages{$p}{'remotecatalogueversion'};
}
if (defined($remotetlpdb)) {
@@ -1875,8 +2125,15 @@ sub update_list_remote {
push @do_later_media, $p;
next;
}
- my $tlp = $remotetlpdb->get_package($p);
- populate_Packages("remote", $tlp);
+ my $tlp;
+ my $maxtag;
+ if ($remotetlpdb->is_virtual) {
+ ($maxtag, undef, $tlp, undef) =
+ $remotetlpdb->virtual_candidate($p);
+ } else {
+ $tlp = $remotetlpdb->get_package($p);
+ }
+ populate_Packages("remote", $tlp, $maxtag);
}
}
my @avail_arch = $localtlpdb->available_architectures;
@@ -1886,9 +2143,16 @@ sub update_list_remote {
tlerror("very strange, above it matched and now not anymore?!?! $p\n");
next;
}
- my $tlp = $remotetlpdb->get_package($p);
+ my $tlp;
+ my $maxtag;
+ if ($remotetlpdb->is_virtual) {
+ ($maxtag, undef, $tlp, undef) =
+ $remotetlpdb->virtual_candidate($p);
+ } else {
+ $tlp = $remotetlpdb->get_package($p);
+ }
if (!defined($Packages{$mp})) {
- populate_Packages("remote", $tlp);
+ populate_Packages("remote", $tlp, $maxtag);
} else {
# two cases:
# - $mp.$ma where $ma is in available_archs
@@ -1926,7 +2190,7 @@ sub update_list_remote {
} else {
# only show that one if it is locally installed
if (defined($Packages{$p})) {
- populate_Packages("remote", $tlp);
+ populate_Packages("remote", $tlp, $maxtag);
}
}
}
@@ -2216,7 +2480,47 @@ sub cb_edit_location {
sub update_loaded_location_string {
my $arg = shift;
$arg || ($arg = $location);
- $loaded_text->configure(-text => __("Loaded repository:") . " " . $arg);
+ my %repos = repository_to_array($arg);
+ my @tags = sort keys %repos;
+ my @vals;
+ if ($#tags > 0) {
+ @vals = map { "$_:$repos{$_}" } sort sort_main_first @tags;
+ } else {
+ @vals = ( $arg );
+ }
+ my $locstr;
+ if ($#tags > 0) {
+ $locstr = $repos{'main'};
+ for my $t (keys %repos) {
+ if ($t ne 'main') {
+ $locstr .= " $repos{$t}";
+ }
+ }
+ $loaded_text_button->configure(-text => __("multiple repositories"));
+ } else {
+ $loaded_text_button->configure(-text => $arg);
+ }
+ $loaded_text->configure(-text => __("Loaded repository:"));
+ $loaded_text_button->configure( -command =>
+ sub { transient_show_multiple_repos($loaded_text_button, @vals); });
+}
+
+sub transient_show_multiple_repos {
+ my ($ref_widget, @vals) = @_;
+ my $xx = $ref_widget->rootx;
+ my $yy = $ref_widget->rooty + $ref_widget->reqheight;
+ my $sw = $mw->Toplevel(-bd => 2);
+ $sw->geometry("+$xx+$yy");
+ $sw->overrideredirect(1);
+ $sw->transient($mw);
+ $sw->grab;
+ # we want to have a global grab, but that somehow does not work!
+ #$sw->grabGlobal;
+ $sw->bind('<1>', sub { $sw->grabRelease; $sw->destroy; });
+ my $foo = $sw->Listbox(-height => 0, -width => 0,
+ -listvariable => \@vals,
+ -state => 'normal');
+ $foo->pack;
}
sub run_update_functions {
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index a644db08522..7722c0fdf2b 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -70,20 +70,31 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
$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);
-
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->candidates($pkg);
+ $tlpdb->virtual_candidate($pkg);
+ $tlpdb->virtual_pinning( [@tlpkpins ] );
+
=head1 DESCRIPTION
=cut
-use TeXLive::TLConfig;
+use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation
+ $DatabaseName $MetaCategoriesRegexp $Archive
+ %TLPDBOptions %TLPDBSettings
+ $RelocPrefix $RelocTree);
use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug
- tlwarn basename download_file merge_into);
+ tlwarn basename download_file merge_into tldie);
use TeXLive::TLPOBJ;
use TeXLive::TLWinGoo;
@@ -123,8 +134,7 @@ sub new {
$_listdir = $params{'listdir'} if defined($params{'listdir'});
bless $self, $class;
if (defined($params{'tlpdbfile'})) {
- my $nr_packages_read
- = $self->from_file("$self->{'root'}/$InfraLocation/$DatabaseName");
+ my $nr_packages_read = $self->from_file($params{'tlpdbfile'}, '-from-file');
if ($nr_packages_read == 0) {
# that is bad, we didn't read anything, so return undef.
return undef;
@@ -161,6 +171,10 @@ The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB.
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;
}
@@ -209,6 +223,10 @@ package is not present
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,15 +246,22 @@ It returns the actual number of packages (TLPOBJs) read from C<$filename>.
=cut
sub from_file {
- my ($self, $path) = @_;
- if (@_ != 2) {
+ my ($self, $path, $arg) = @_;
+ 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";
}
my $root_from_path = dirname(dirname($path));
if (defined($self->{'root'})) {
if ($self->{'root'} ne $root_from_path) {
- tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n");
- tlwarn("Initialization from different location as originally given.\nHope you are sure!\n");
+ # only warn if we are not given $arg = "-from-file"
+ if (!defined($arg) || ($arg ne "-from-file")) {
+ tlwarn("root=$self->{'root'}, root_from_path=$root_from_path\n");
+ tlwarn("Initialization from different location as originally given.\nHope you are sure!\n");
+ }
}
} else {
$self->root($root_from_path);
@@ -362,6 +387,10 @@ the file handle given as argument.
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");
@@ -381,6 +410,10 @@ as location. If the location is undefined, die.
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";
@@ -402,6 +435,9 @@ Returns the media code the respective installation resides on.
sub media {
my $self = shift ;
+ if ($self->is_virtual) {
+ return "virtual";
+ }
return $self->{'media'};
}
@@ -417,6 +453,19 @@ architectures as set in the options section
sub available_architectures {
my $self = shift;
+ my @archs;
+ if ($self->is_virtual) {
+ for my $k (keys %{$self->{'tlpdbs'}}) {
+ TeXLive::TLUtils::push_uniq \@archs, $self->{'tlpdbs'}{$k}->available_architectures;
+ }
+ return sort @archs;
+ } 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\.*
@@ -444,6 +493,10 @@ adds new dependencies they are not necessarily fulfilled.
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;
@@ -508,6 +561,29 @@ corresponding to the I<pkgname>, or undef.
=cut
sub get_package {
+ my ($self,$pkg,$tag) = @_;
+ if ($self->is_virtual) {
+ if (defined($tag)) {
+ if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+ return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+ } else {
+ debug("TLPDB::get_package: 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) = @_;
if (defined($self->{'tlps'}{$pkg})) {
my $ret = $self->{'tlps'}{$pkg};
@@ -519,6 +595,35 @@ sub get_package {
=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.
@@ -527,6 +632,34 @@ The C<list_packages> function returns the list of all included packages.
sub list_packages {
my $self = shift;
+ my $arg = shift;
+ my $showall = 0;
+ if (defined($arg) && ($arg eq "-all")) {
+ $showall = 1;
+ }
+ if ($self->is_virtual) {
+ if ($showall) {
+ return (sort keys %{$self->{'packages'}});
+ }
+ # we have to be careful here: If a package
+ # is only present in a subsidiary repository
+ # and the package is *not* explicitely
+ # pinned to it, it will not be installable.
+ # This is what we want. But in this case
+ # we don't want it to be listed by default.
+ #
+ my @pps;
+ for my $p (keys %{$self->{'packages'}}) {
+ push @pps, $p if (defined($self->{'packages'}{$p}{'target'}));
+ }
+ return (sort @pps);
+ } else {
+ return $self->_list_packages;
+ }
+}
+
+sub _list_packages {
+ my $self = shift;
return (sort keys %{$self->{'tlps'}});
}
@@ -544,6 +677,11 @@ package onto package) are ignored.
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.)
@@ -567,7 +705,8 @@ sub expand_dependencies {
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) {
@@ -576,7 +715,7 @@ sub expand_dependencies {
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;
@@ -602,16 +741,19 @@ sub expand_dependencies {
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;
}
}
}
@@ -623,7 +765,9 @@ sub expand_dependencies {
$changed = 1;
}
}
- return(keys %install);
+ # create return list
+ return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install;
+ #return(keys %install);
}
=pod
@@ -635,6 +779,7 @@ containing a file named C<filename>.
=cut
+# TODO adapt for searching in *all* tags ???
sub find_file {
my ($self,$fn) = @_;
my @ret;
@@ -868,6 +1013,10 @@ installation.
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'};
}
@@ -887,6 +1036,10 @@ special value C<__MASTER>.
sub location {
my $self = shift;
+ if ($self->is_virtual) {
+ tlwarn("cannot get location of a virtual tlpdb\n");
+ return 0;
+ }
return "$self->{'root'}/$InfraLocation/$DatabaseName";
}
@@ -937,8 +1090,14 @@ container level is set. See Options below.
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";
}
@@ -958,8 +1117,14 @@ container level is set. See Options below.
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->depends) {
if ($d =~ m!^container_split_doc_files/(.*)$!) {
return "$1";
}
@@ -978,8 +1143,14 @@ Returns the currently set default container format. See Options below.
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";
}
@@ -998,8 +1169,14 @@ Returns the currently set release. See Options below.
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";
}
@@ -1018,8 +1195,14 @@ Returns the currently allowed minimal release. See Options below.
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";
}
@@ -1039,8 +1222,14 @@ Returns the currently set revision. See Options below.
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";
}
@@ -1066,12 +1255,12 @@ which contains the total size of all packages under discussion.
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;
@@ -1110,31 +1299,46 @@ sub size_of_one_package {
=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, $tag) = @_;
+ if ($self->is_virtual) {
+ if (defined($tag)) {
+ if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+ return $self->{'tlpdbs'}{$tag}->install_package($pkg, $totlpdb);
+ } else {
+ tlwarn("package $pkg not found in repository $tag\n");
+ return;
+ }
+ } else {
+ my ($maxtag, $maxrev, $maxtlp, $maxtlpdb) = $self->virtual_candidate($pkg);
+ return $maxtlpdb->install_package($pkg, $totlpdb);
+ }
+ } else {
+ 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) = @_;
my $fromtlpdb = $self;
my $ret;
die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb));
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;
@@ -1182,7 +1386,7 @@ sub install_package {
next;
}
} elsif (&media eq 'NET') {
- $container = "$root/$Archive/$pkg.$DefaultContainerExtension";
+ $container = "$root/$Archive/$pkg.$TeXLive::TLConfig::DefaultContainerExtension";
}
$self->_install_package ($container, $reloc, \@installfiles, $totlpdb)
|| return(0);
@@ -1256,23 +1460,21 @@ sub install_package {
$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;
}
@@ -1525,7 +1727,7 @@ sub remove_package {
# 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"),
@@ -1557,7 +1759,12 @@ sub _set_setting_value {
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;
@@ -1595,8 +1802,14 @@ sub _setting_value {
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";
}
@@ -1709,7 +1922,12 @@ sub _keyshash {
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([^:]*):(.*)!) {
@@ -1858,6 +2076,362 @@ sub language_lua_lines {
=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->{'packages'}{$pkgname}{'tags'}{$tag}{'revision'} = $rev
+# $self->{'packages'}{$pkgname}{'tags'}{$tag}{'tlp'} = $tlp
+# $self->{'packages'}{$pkgname}{'target'} = $target_tag
+#
+
+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}{'tags'}{$tag}{'revision'} = $tlp->revision;
+ $self->{'packages'}{$p}{'tags'}{$tag}{'tlp'} = $tlp;
+ }
+ $self->check_evaluate_pinning();
+ 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}{'tags'}{$tag};
+ }
+ delete $self->{'tlpdbs'}{$tag};
+ $self->check_evaluate_pinning();
+ return 1;
+}
+
+sub virtual_get_package {
+ my ($self, $pkg, $tag) = @_;
+ if (defined($self->{'packages'}{$pkg}{'tags'}{$tag})) {
+ return $self->{'packages'}{$pkg}{'tags'}{$tag}{'tlp'};
+ } else {
+ tlwarn("pkg $pkg not found in tag $tag\n");
+ return;
+ }
+}
+
+=item C<< $tlpdb->candidates ( $pkg ) >>
+
+Returns the list of candidates for the given package in the
+format
+
+ tag/revision
+
+If the returned list is empty, then the database was not virtual and
+no install candidate was found.
+
+If the returned list contains undef as first element, the database
+is virtual, and no install candidate was found.
+
+The remaining elements in the list are all repositories that provide
+that package.
+
+Note that there might not be an install candidate, but still the
+package is provided by a sub-repository. This can happen if a package
+is present only in the sub-repository and there is no explicit pin
+for that package in the pinning file.
+
+=cut
+
+sub is_repository {
+ my $self = shift;
+ my $tag = shift;
+ if (!$self->is_virtual) {
+ return ( ($tag eq $self->{'root'}) ? 1 : 0 );
+ }
+ return ( defined($self->{'tlpdbs'}{$tag}) ? 1 : 0 );
+}
+
+
+# returns a list of tag/rev
+sub candidates {
+ my $self = shift;
+ my $pkg = shift;
+ my @ret = ();
+ if ($self->is_virtual) {
+ if (defined($self->{'packages'}{$pkg})) {
+ my $t = $self->{'packages'}{$pkg}{'target'};
+ if (defined($t)) {
+ push @ret, "$t/" . $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'};
+ } else {
+ $t = "";
+ # no target found, but maybe available somewhere else,
+ # we return undef as first one
+ push @ret, undef;
+ }
+ # make sure that we always check for main as repo
+ my @repos = keys %{$self->{'packages'}{$pkg}};
+ for my $r (sort keys %{$self->{'packages'}{$pkg}{'tags'}}) {
+ push @ret, "$r/" . $self->{'packages'}{$pkg}{'tags'}{$r}{'revision'}
+ if ($t ne $r);
+ }
+ }
+ } else {
+ my $tlp = $self->get_package($pkg);
+ if (defined($tlp)) {
+ push @ret, "main/" . $tlp->revision;
+ }
+ }
+ return @ret;
+}
+
+=item C<< $tlpdb->candidate ( ) >>
+
+Returns either a list of four undef, if no install candidate is found,
+or the following information on the install candidate as list: the tag
+name of the repository, the revision number of the package in the
+candidate repository, the tlpobj of the package in the candidate
+repository, and the candidate repository's TLPDB itself.
+
+=cut
+
+#
+sub virtual_candidate {
+ my ($self, $pkg) = @_;
+ my $t = $self->{'packages'}{$pkg}{'target'};
+ if (defined($t)) {
+ return ($t, $self->{'packages'}{$pkg}{'tags'}{$t}{'revision'},
+ $self->{'packages'}{$pkg}{'tags'}{$t}{'tlp'}, $self->{'tlpdbs'}{$t});
+ }
+ return(undef,undef,undef,undef);
+}
+
+=item C<< $tlpdb->virtual_pinning ( [@pinning_data] ) >>
+
+Without any argument returns the pinning data, or undef. Be reminded that an
+empty pinning data will behave differently to no pinning data.
+
+With an argument it must be a list of pins, where each pin
+must be one hash ref with the following keys:
+C<repo> the tag of the repository,
+C<glob> the glob for matching a package
+C<re> the regexp which corresponds to the glob
+C<line> the line where the glob was found (for warning purpose).
+
+=cut
+
+sub virtual_pinning {
+ my $self = shift;
+ my (@pins) = @_;
+ if (!$self->is_virtual) {
+ tlerror("Not-virtual databases cannot have pinning data.\n");
+ return 0;
+ }
+ if (!@pins) {
+ if (!defined($self->{'pindata'})) {
+ my @foo = ();
+ $self->{'pindata'} = \@foo;
+ }
+ return (@{$self->{'pindata'}});
+ } else {
+ $self->{'pindata'} = \@pins;
+ $self->check_evaluate_pinning();
+ return ($self->{'pindata'});
+ }
+}
+
+#
+# current format:
+# <repo>:<pkg_glob>[,<pkg_glob>,...][:<options>]
+# only supported options for now is
+# revision
+# meaning that, if for the selected package there is no other
+# "non-revision" pinning, then all repo/package versions are compared
+# using normal revision comparison, and the biggest revision number wins.
+# That allows you to have the same package in several repos:
+# repo1:foo:revision
+# repo2:foo:revision
+# repo1:*
+# repo2:*
+# means that:
+# for package "foo" the revision numbers of "foo" in the repos "repo1",
+# "repo2", and "main" are numerically compared and biggest number wins.
+# for all other packages of "repo1" and "repo2", other other repositories
+# are not considered.
+#
+# NOT IMPLEMENTED YET!!!
+#
+# $pin{'repo'} = $repo;
+# $pin{'glob'} = $glob;
+# $pin{'re'} = $re;
+# $pin{'line'} = $line; # for debug/warning purpose
+sub make_pin_data_from_line {
+ my $self = shift;
+ my $l = shift;
+ my ($a, $b, $c) = split(/:/, $l);
+ my @ret;
+ my %m;
+ $m{'repo'} = $a;
+ $m{'line'} = $l;
+ if (defined($c)) {
+ $m{'options'} = $c;
+ }
+ # split the package globs
+ for (split(/,/, $b)) {
+ my %mm = %m;
+ $mm{'glob'} = $_;
+ $mm{'re'} = glob_to_regex($_);
+ push @ret, \%mm;
+ }
+ return @ret;
+}
+
+sub check_evaluate_pinning {
+ my $self = shift;
+ my @pins = (defined($self->{'pindata'}) ? @{$self->{'pindata'}} : ());
+ #
+ # run through the pin lines and make sure that all the conditions
+ # and requirements are obeyed
+ my %pkgs = %{$self->{'packages'}};
+ # main:*
+ my ($mainpin) = $self->make_pin_data_from_line("main:*");
+ # the default main:* is always considered to be matched
+ $mainpin->{'hit'} = 1;
+ push @pins, $mainpin;
+ for my $pkg (keys %pkgs) {
+ PINS: for my $pp (@pins) {
+ my $pre = $pp->{'re'};
+ if (($pkg =~ m/$pre/) &&
+ (defined($self->{'packages'}{$pkg}{'tags'}{$pp->{'repo'}}))) {
+ $self->{'packages'}{$pkg}{'target'} = $pp->{'repo'};
+ # register that this pin was hit
+ $pp->{'hit'} = 1;
+ last PINS;
+ }
+ }
+ }
+ # check that all pinning lines where hit
+ for my $p (@pins) {
+ next if defined($p->{'hit'});
+ tlwarn("pinning warning: the entry in line\n ", $p->{'line'},
+ "\nconcerning the package pattern ", $p->{'glob'},
+ "\nis not matched by any package!\n");
+ }
+}
+
+
+# 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);
+ return qr/^$regex$/;
+}
+
+sub glob_to_regex_string
+{
+ my $glob = shift;
+ my ($regex, $in_curlies, $escaping);
+ local $_;
+ my $first_byte = 1;
+ for ($glob =~ m/(.)/gs) {
+ if ($first_byte) {
+ $regex .= '(?=[^\.])' unless $_ eq '.';
+ $first_byte = 0;
+ }
+ if ($_ eq '/') {
+ $first_byte = 1;
+ }
+ if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' ||
+ $_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%' ) {
+ $regex .= "\\$_";
+ }
+ elsif ($_ eq '*') {
+ $regex .= $escaping ? "\\*" : "[^/]*";
+ }
+ elsif ($_ eq '?') {
+ $regex .= $escaping ? "\\?" : "[^/]";
+ }
+ elsif ($_ eq '{') {
+ $regex .= $escaping ? "\\{" : "(";
+ ++$in_curlies unless $escaping;
+ }
+ elsif ($_ eq '}' && $in_curlies) {
+ $regex .= $escaping ? "}" : ")";
+ --$in_curlies unless $escaping;
+ }
+ elsif ($_ eq ',' && $in_curlies) {
+ $regex .= $escaping ? "," : "|";
+ }
+ elsif ($_ eq "\\") {
+ if ($escaping) {
+ $regex .= "\\\\";
+ $escaping = 0;
+ }
+ else {
+ $escaping = 1;
+ }
+ next;
+ }
+ else {
+ $regex .= $_;
+ $escaping = 0;
+ }
+ $escaping = 0;
+ }
+ print "# $glob $regex\n" if debug;
+
+ return $regex;
+}
+
+sub match_glob {
+ print "# ", join(', ', map { "'$_'" } @_), "\n" if debug;
+ my $glob = shift;
+ my $regex = glob_to_regex $glob;
+ local $_;
+ grep { $_ =~ $regex } @_;
+}
+
=pod
=head1 OPTIONS
@@ -1919,4 +2493,4 @@ GNU General Public License Version 2 or later.
### tab-width: 2
### indent-tabs-mode: nil
### End:
-# vim:set tabstop=2 expandtab: #
+# vim:set tabstop=2 expandtab autoindent: #
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
index 18c03dcd4ec..c32c0ff64bf 100644
--- a/Master/tlpkg/dev/dev.multi-source-support-v2.patch
+++ b/Master/tlpkg/dev/dev.multi-source-support-v2.patch
@@ -1,8 +1,8 @@
---
texmf/scripts/texlive/tlmgr.pl | 916 ++++++++++++++++++++++++++++++++------
- texmf/scripts/texlive/tlmgrgui.pl | 292 ++++++++++--
+ texmf/scripts/texlive/tlmgrgui.pl | 394 ++++++++++++++--
tlpkg/TeXLive/TLPDB.pm | 706 ++++++++++++++++++++++++++---
- 3 files changed, 1665 insertions(+), 249 deletions(-)
+ 3 files changed, 1767 insertions(+), 249 deletions(-)
Index: tlpkg/TeXLive/TLPDB.pm
===================================================================
@@ -2241,8 +2241,8 @@ Index: texmf/scripts/texlive/tlmgr.pl
Index: texmf/scripts/texlive/tlmgrgui.pl
===================================================================
--- texmf/scripts/texlive/tlmgrgui.pl.orig 2011-06-16 21:30:37.000000000 +0900
-+++ texmf/scripts/texlive/tlmgrgui.pl 2012-03-28 14:30:06.000129905 +0900
-@@ -1,7 +1,7 @@
++++ texmf/scripts/texlive/tlmgrgui.pl 2012-03-29 02:38:57.124639975 +0900
+@@ -1,13 +1,17 @@
#!/usr/bin/env perl
# $Id: tlmgrgui.pl 23011 2011-06-16 12:30:37Z preining $
#
@@ -2251,7 +2251,17 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
# This file is licensed under the GNU General Public License version 2
# or any later version.
#
-@@ -60,8 +60,15 @@
+ # GUI for tlmgr
+ # version 2, completely rewritten GUI
+ #
++#
++# TODO FOR MULTI SUPPORT
++# - colorize the General config tab, if something is changed, show it in RED
++# that can actually applied to single repo tlmgrgui, too
+ # TODO: Fix return codes of execute_action sub items and execute_action
+ # so that we can give a decent warning window
+ # TODO: implement path adjustment also for Windows
+@@ -60,8 +64,17 @@
our @update_function_list;
my $tlpdb_location;
@@ -2264,10 +2274,12 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
+my %repos;
+my @tags;
+
++my $location_button; # uggg, change from far away ...
++
#
# shortcuts for padding, expand/fill, and pack sides, anchors
my @p_ii = qw/-padx 2m -pady 2m/;
-@@ -97,6 +104,7 @@
+@@ -97,6 +110,7 @@
my $darktext;
my $match_entry;
my $loaded_text;
@@ -2275,7 +2287,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
#
# communication between filters and the rest
-@@ -169,6 +177,8 @@
+@@ -169,6 +183,8 @@
# cmd line > tlpdb
# save the two possible location for the menu
$tlpdb_location = $localtlpdb->option("location");
@@ -2284,7 +2296,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
if (defined($opts{"location"})) {
$cmdline_location = $opts{"location"};
}
-@@ -261,14 +271,13 @@
+@@ -261,14 +277,13 @@
-selectmode => "none");
my $button_frame = $mw->Frame;
@@ -2303,7 +2315,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
$loaded_text->pack(-anchor => 'e', -padx => 0, -pady => 0,
-ipadx => 0, -ipady => 0, -side => 'right');
-@@ -484,8 +493,14 @@
+@@ -484,8 +499,14 @@
#
# FILE MENU
#
@@ -2319,7 +2331,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
-command => sub { setup_location($tlpdb_location); });
if (defined($cmdline_location)) {
$menu_file->add('command', -label => __("Load cmd line repository:") . " $cmdline_location",
-@@ -663,7 +678,7 @@
+@@ -663,7 +684,7 @@
-sticky => "nw");
}
$tf->Label(-text => __("Remote Revision:"))->grid(
@@ -2328,7 +2340,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
-sticky => "nw");
if (defined($Packages{$p}{'remotecatalogueversion'})) {
$tf->Label(-text => __("Remote Catalogue Version:"))->grid(
-@@ -838,7 +853,7 @@
+@@ -838,7 +859,7 @@
$t .= " ($Packages{$p}{'localcatalogueversion'})";
}
$g->itemCreate($p, 2, -itemtype => 'text', -style => $st, -text => $t);
@@ -2337,7 +2349,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
if ($Packages{$p}{'remotecatalogueversion'}) {
$t .= " ($Packages{$p}{'remotecatalogueversion'})";
}
-@@ -905,9 +920,13 @@
+@@ -905,9 +926,13 @@
return 0;
}
# check first for the default search type, the descriptions
@@ -2351,7 +2363,14 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
}
}
if (!$found) {
-@@ -1052,6 +1071,13 @@
+@@ -1046,12 +1071,20 @@
+ }
+ %changeddefaults = ();
+ for my $k (keys %defaults) {
++ $changeddefaults{$k}{'changed'} = 0;
+ $changeddefaults{$k}{'value'} = $defaults{$k};
+ if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") {
+ $changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No"));
} else {
if ($k eq "file_assocs") {
$changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}];
@@ -2365,7 +2384,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
} else {
$changeddefaults{$k}{'display'} = $defaults{$k};
}
-@@ -1075,11 +1101,23 @@
+@@ -1075,11 +1108,23 @@
push @config_set_l,
$back_config_set->Label(-text => __("Default package repository"), -anchor => "w");
@@ -2375,12 +2394,12 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
- $back_config_set->Button(-text => __("Change"),
- -command => sub { menu_default_location($sw); });
+ if ($#tlpdb_tags > 0) {
-+ my @vals = map { "$_:$tlpdb_repos{$_}" } sort @tlpdb_tags;
-+ my $b = $back_config_set->Button(-relief => 'flat',
++ my @vals = map { "$_:$tlpdb_repos{$_}" } sort sort_main_first @tlpdb_tags;
++ $location_button = $back_config_set->Button(-relief => 'flat',
+ -textvariable => \$changeddefaults{"location"}{'display'});
-+ $b->configure(
-+ -command => sub { transient_show_multiple_repos($b, @vals); });
-+ push @config_set_m, $b;
++ $location_button->configure(
++ -command => sub { transient_show_multiple_repos($location_button, @vals); });
++ push @config_set_m, $location_button;
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { menu_multi_location($sw); });
@@ -2394,7 +2413,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
if ($mode_expert) {
-@@ -1383,48 +1421,145 @@
+@@ -1383,48 +1428,240 @@
}
}
@@ -2497,49 +2516,92 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
+ }
+}
+
++sub sort_main_first {
++ if ($a eq 'main') {
++ if ($b eq 'main') {
++ return 0;
++ } else {
++ return -1;
++ }
++ } else {
++ if ($b eq 'main') {
++ return 1;
++ } else {
++ return ($a cmp $b);
++ }
++ }
++}
+
+sub menu_multi_location {
+ my $mw = shift;
+ my $val;
-+ my $sw = $mw->Toplevel(-title => __("Edit default package repositories"));
++ our $sw = $mw->Toplevel(-title => __("Edit default package repositories"));
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => __("Specify set of repositories to be used"))->pack(-padx => "2m", -pady => "2m");
+
-+ my $f1 = $sw->Frame;
-+ my @entry_tag; my $tagw = 10;
-+ my @entry_loc; my $locw = 30;
++ our $f1 = $sw->Frame;
++ my @entry_tag; our $tagw = 10;
++ my @entry_loc; our $locw = 30;
+ my @entry_del;
+ my @entry_chg;
+
-+ my %edit_repos = %tlpdb_repos;
-+ my @edit_tags = @tlpdb_tags;
-+ push @entry_tag, $f1->Entry(-text => 'main', -state => 'readonly', -width => $tagw);
-+ push @entry_loc, $f1->Entry(-text => $tlpdb_repos{'main'}, -width => $locw);
-+ push @entry_del, $f1->Button(-text => __("Delete"), -state => 'disabled');
-+ push @entry_chg, $f1->Button(-text => __("Change"),
-+ -command => sub {
-+ my $ret = ask_one_repository($sw, __("Change main package repository"),
-+ __("New main package repository"));
-+ $edit_repos{'main'} = $ret if (defined($ret));
-+ });
-+ for my $t (sort @edit_tags) {
-+ next if ($t eq "main");
-+ push @entry_tag, $f1->Entry(-textvariable => \$t, -width => $tagw);
-+ push @entry_loc, $f1->Entry(-textvariable => \$edit_repos{$t}, -width => $locw);
-+ push @entry_del, $f1->Button(-text => __("Delete"));
-+ push @entry_chg, $f1->Button(-text => __("Change"),
++ my $addrepo_button;
++
++
++ sub add_buttons {
++ my ($ref) = @_;
++ my $t = $ref->{'tag'};
++ $ref->{'tag_w'} = $f1->Entry(-textvariable => \$ref->{'tag'}, -state => ($t eq "main" ? 'readonly' : 'normal'), -width => $tagw);
++ $ref->{'val_w'} = $f1->Entry(-textvariable => \$ref->{'val'}, -width => $locw);
++ $ref->{'del_w'} = $f1->Button(-text => __("Delete"),
++ -state => ($t eq "main" ? 'disabled' : 'normal'),
++ -command => sub {
++ $ref->{'status'} = 0;
++ $ref->{'tag_w'}->configure(-state => 'disabled');
++ $ref->{'val_w'}->configure(-state => 'disabled');
++ $ref->{'del_w'}->configure(-state => 'disabled');
++ $ref->{'chg_w'}->configure(-state => 'disabled');
++ });
++ $ref->{'chg_w'} = $f1->Button(-text => __("Change"),
+ -command => sub {
-+ my $ret = ask_one_repository($sw, __("Change subsidiary package repository"),
-+ __("New subsidiary package repository"));
-+ $edit_repos{$t} = $ret if (defined($ret));
++ my $ret = ask_one_repository($sw, __("Change " . ($t eq "main" ? "main" : "subsidiary") . " package repository"),
++ __(($t eq "main" ? "Change main" : "New subsidiary") . " package repository"));
++ $ref->{'val'} = $ret if (defined($ret));
+ });
+ }
-+ # add some "Add ..." line? TODO
-+ for my $i (0..$#entry_tag) {
-+ $entry_tag[$i]->grid( $entry_loc[$i], $entry_del[$i], $entry_chg[$i],
++
++ my %changed_repos = repository_to_array($changeddefaults{'location'}{'value'});
++
++ my @edit_repos;
++ push @edit_repos, { 'tag' => 'main', 'val' => $changed_repos{'main'}, 'status' => 1};
++ for my $k (sort keys %changed_repos) {
++ next if ($k eq "main");
++ push @edit_repos, { 'tag'=> $k, 'val' => $changed_repos{$k}, 'status' => 1 };
++ }
++ for my $ref (@edit_repos) {
++ add_buttons($ref);
++ }
++ for my $ref (@edit_repos) {
++ my %foo = %$ref;
++ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
+ -padx => "1m", -pady => "1m", -sticky => "nwe");
+ }
++ $addrepo_button = $f1->Button(-text => __("Add repository") . "...",
++ -command => sub {
++ my $ret = ask_one_repository($sw, __("Add package repository"),
++ __("Add package repository"));
++ if (defined($ret)) {
++ $addrepo_button->gridForget;
++ my %foo = ( 'tag' => $ret, 'val' => $ret, 'status' => 1 );
++ add_buttons(\%foo);
++ $foo{'tag_w'}->grid($foo{'val_w'}, $foo{'del_w'}, $foo{'chg_w'},
++ -padx => "1m", -pady => "1m", -sticky => "nwe");
++ push @edit_repos, \%foo;
++ }
++ $addrepo_button->grid(-columnspan => 2, -column => 2);
++ });
++ $addrepo_button->grid(-columnspan => 2, -column => 2);
+
+ $f1->pack;
+
@@ -2549,17 +2611,69 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
sub {
- $changeddefaults{'location'}{'value'} =
- $changeddefaults{'location'}{'display'} = $entry->get;
-+ print "TODO TODO TODO ___ EDITING OF MULTIPLE NOT SUPPORTED!!!\nWE ALSO HAVE TO MAKE SURE THAT THERE IS ONE MAIN AND NOT MORE ETC ETC\n";
++ # we have to check if something has changed ... and for consistency!!!
++ my %new_repos;
++ for my $ref (@edit_repos) {
++ my %foo = %$ref;
++ if ($foo{'status'}) {
++ if (defined($new_repos{$foo{'tag'}})) {
++ $sw->Dialog(-title => __("Warning"),
++ -text => __("Multiple defined tags (first column) are not possible, please fix it."), -buttons => [ __("Ok") ])->Show;
++ return;
++ }
++ $new_repos{$foo{'tag'}} = $foo{'val'};
++ }
++ }
++ my $differs = 0;
++ for my $k (keys %changed_repos) {
++ if (!defined($new_repos{$k})) {
++ $differs = 1;
++ last;
++ }
++ if ($changed_repos{$k} ne $new_repos{$k}) {
++ $differs = 1;
++ last;
++ }
++ }
++ if (!$differs) {
++ # do the same the other way round
++ for my $k (keys %new_repos) {
++ if (!defined($changed_repos{$k})) {
++ $differs = 1;
++ last;
++ }
++ if ($changed_repos{$k} ne $new_repos{$k}) {
++ $differs = 1;
++ last;
++ }
++ }
++ }
++ if ($differs) {
++ # print "current repos:\n";
++ # for my $ref (@edit_repos) {
++ # print "tag = $ref->{'tag'}\n";
++ # print "val = $ref->{'val'}\n";
++ # print "act = $ref->{'status'}\n";
++ # }
++ $changeddefaults{'location'}{'value'} = array_to_repository(%new_repos);
++ $changeddefaults{'location'}{'display'} = __("multiple repositories");
++ my @vals = map { "$_:$new_repos{$_}" }
++ sort sort_main_first keys %new_repos;
++ $location_button->configure(
++ -command => sub { transient_show_multiple_repos($location_button, @vals); });
++ } else {
++ # print "Nothing happend!\n";
++ }
$sw->destroy;
})->pack(-side => 'left',-padx => "2m", -pady => "2m");
my $cancelbutton = $f->Button(-text => __("Cancel"),
-command => sub { $sw->destroy })->pack(-side => 'right',-padx => "2m", -pady => "2m");
+ my $resetbutton = $f->Button(-text => __("Revert"),
-+ -command => sub { print "TODO REVERT SETTINGS\n"; })->pack(-side => 'right',-padx => "2m", -pady => "2m");
++ -command => sub { $sw->destroy; menu_multi_location($mw); })->pack(-side => 'right',-padx => "2m", -pady => "2m");
$f->pack(-expand => 'x');
$sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
$sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
-@@ -1554,19 +1689,27 @@
+@@ -1554,19 +1791,27 @@
sub setup_location {
my $loc = shift;
$location = $loc;
@@ -2592,7 +2706,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
$mw->Unbusy;
if (!defined($remotetlpdb)) {
# something went badly wrong, maybe the newroot is wrong?
-@@ -1725,7 +1868,7 @@
+@@ -1725,7 +1970,7 @@
# sub populate_Packages
#
sub populate_Packages {
@@ -2601,7 +2715,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
my $p = $tlp->name;
$Packages{$p}{'displayname'} = $p;
if ($mode eq "local") {
-@@ -1736,6 +1879,10 @@
+@@ -1736,6 +1981,10 @@
$Packages{$p}{'tlp'} = $tlp;
} else {
$Packages{$p}{'remoterevision'} = $tlp->revision;
@@ -2612,7 +2726,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
$Packages{$p}{'selected'} = 0
unless defined $Packages{$p}{'selected'};
if (!defined($Packages{$p}{'tlp'})) {
-@@ -1865,6 +2012,7 @@
+@@ -1865,6 +2114,7 @@
next;
}
delete $Packages{$p}{'remoterevision'};
@@ -2620,7 +2734,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
delete $Packages{$p}{'remotecatalogueversion'};
}
if (defined($remotetlpdb)) {
-@@ -1875,8 +2023,15 @@
+@@ -1875,8 +2125,15 @@
push @do_later_media, $p;
next;
}
@@ -2638,7 +2752,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
}
}
my @avail_arch = $localtlpdb->available_architectures;
-@@ -1886,9 +2041,16 @@
+@@ -1886,9 +2143,16 @@
tlerror("very strange, above it matched and now not anymore?!?! $p\n");
next;
}
@@ -2657,7 +2771,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
} else {
# two cases:
# - $mp.$ma where $ma is in available_archs
-@@ -1926,7 +2088,7 @@
+@@ -1926,7 +2190,7 @@
} else {
# only show that one if it is locally installed
if (defined($Packages{$p})) {
@@ -2666,7 +2780,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
}
}
}
-@@ -2216,7 +2378,47 @@
+@@ -2216,7 +2480,47 @@
sub update_loaded_location_string {
my $arg = shift;
$arg || ($arg = $location);
@@ -2675,7 +2789,7 @@ Index: texmf/scripts/texlive/tlmgrgui.pl
+ my @tags = sort keys %repos;
+ my @vals;
+ if ($#tags > 0) {
-+ @vals = sort map { "$_:$repos{$_}" } @tags;
++ @vals = map { "$_:$repos{$_}" } sort sort_main_first @tags;
+ } else {
+ @vals = ( $arg );
+ }