summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch')
-rw-r--r--Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch2167
1 files changed, 2167 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch
new file mode 100644
index 00000000000..4acee6a8263
--- /dev/null
+++ b/Master/tlpkg/dev/quilt-patches/dev.multi-source-support-v2.patch
@@ -0,0 +1,2167 @@
+---
+ texmf/scripts/texlive/tlmgr.pl | 897 ++++++++++++++++++++++++++++++++++-------
+ tlpkg/TeXLive/TLPDB.pm | 669 +++++++++++++++++++++++++++---
+ 2 files changed, 1369 insertions(+), 197 deletions(-)
+
+Index: tlpkg/TeXLive/TLPDB.pm
+===================================================================
+--- tlpkg/TeXLive/TLPDB.pm.orig 2011-07-02 15:31:51.000000000 +0900
++++ tlpkg/TeXLive/TLPDB.pm 2012-01-12 12:51:17.000000000 +0900
+@@ -70,20 +70,31 @@
+ $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;
+
+@@ -161,6 +172,10 @@
+
+ sub add_tlpobj {
+ my ($self,$tlp) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot add tlpobj to a virtual tlpdb\n");
++ return 0;
++ }
+ $self->{'tlps'}{$tlp->name} = $tlp;
+ }
+
+@@ -209,6 +224,10 @@
+
+ sub remove_tlpobj {
+ my ($self,$pkg) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot remove tlpobj from a virtual tlpdb\n");
++ return 0;
++ }
+ if (defined($self->{'tlps'}{$pkg})) {
+ delete $self->{'tlps'}{$pkg};
+ } else {
+@@ -229,6 +248,10 @@
+
+ sub from_file {
+ my ($self, $path) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot initialize from file a virtual tlpdb\n");
++ return 0;
++ }
+ if (@_ != 2) {
+ die "$0: from_file needs filename for initialization";
+ }
+@@ -362,6 +385,10 @@
+
+ sub writeout {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot write out a virtual tlpdb\n");
++ return 0;
++ }
+ my $fd = (@_ ? $_[0] : STDOUT);
+ foreach (sort keys %{$self->{'tlps'}}) {
+ ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n");
+@@ -381,6 +408,10 @@
+
+ sub save {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot save a virtual tlpdb\n");
++ return 0;
++ }
+ my $path = $self->location;
+ mkdirhier(dirname($path));
+ my $tmppath = "$path.tmp";
+@@ -402,6 +433,9 @@
+
+ sub media {
+ my $self = shift ;
++ if ($self->is_virtual) {
++ return "virtual";
++ }
+ return $self->{'media'};
+ }
+
+@@ -417,6 +451,18 @@
+
+ sub available_architectures {
+ my $self = shift;
++ my @archs;
++ if ($self->is_virtual) {
++ for my $k (keys %{$self->{'tlpdbs'}}) {
++ push @archs, $self->{'tlpdbs'}{$k}->available_architectures;
++ }
++ } else {
++ return $self->_available_architectures;
++ }
++}
++
++sub _available_architectures {
++ my $self = shift;
+ my @archs = $self->setting("available_architectures");
+ if (! @archs) {
+ # fall back to the old method checking tex\.*
+@@ -444,6 +490,10 @@
+
+ sub add_tlpcontainer {
+ my ($self, $package, $ziplocation, $archrefs, $dest) = @_;
++ if ($self->is_virtual) {
++ tlwarn("cannot add tlp container to a virtual tlpdb\n");
++ return 0;
++ }
+ my @archs;
+ if (defined($archrefs)) {
+ @archs = @$archrefs;
+@@ -508,6 +558,29 @@
+ =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 +592,35 @@
+
+ =pod
+
++=item C<< $tlpdb->media_of_package($pkg [, $tag]);
++
++returns the media type of the package. In the virtual case a tag can
++be given and the media of that repository is used, otherwise the
++media of the virtual candidate is given.
++
++=cut
++
++sub media_of_package {
++ my ($self, $pkg, $tag) = @_;
++ if ($self->is_virtual) {
++ if (defined($tag)) {
++ if (defined($self->{'tlpdbs'}{$tag})) {
++ return $self->{'tlpdbs'}{$tag}->media;
++ } else {
++ tlwarn ("tag $tag is not known.\n");
++ return;
++ }
++ } else {
++ my (undef,undef,undef,$maxtlpdb) = $self->virtual_candidate($pkg);
++ return $maxtlpdb->media;
++ }
++ } else {
++ return $self->media;
++ }
++}
++
++=pod
++
+ =item C<< $tlpdb->list_packages >>
+
+ The C<list_packages> function returns the list of all included packages.
+@@ -527,6 +629,34 @@
+
+ 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 +674,11 @@
+ The next (or first) argument is the target TLPDB, then a list of
+ packages.
+
++In the virtual case,
++if a package name is tagged with C<@repository-tag> then all the
++dependencies will still be expanded between all included databases.
++Only in case of .ARCH dependencies the repository-tag is sticky.
++
+ We return the closure of the package list with respect to the depends
+ operator. (Sorry, that was for mathematicians.)
+
+@@ -567,7 +702,8 @@
+ my %install = ();
+ my @archs = $totlpdb->available_architectures;
+ for my $p (@_) {
+- $install{$p} = 1;
++ my ($pp, $aa) = split('@', $p);
++ $install{$pp} = (defined($aa) ? $aa : 0);;
+ }
+ my $changed = 1;
+ while ($changed) {
+@@ -576,7 +712,7 @@
+ ddebug("pre_select = @pre_select\n");
+ for my $p (@pre_select) {
+ next if ($p =~ m/^00texlive/);
+- my $pkg = $self->get_package($p);
++ my $pkg = $self->get_package($p, ($install{$p}?$install{$p}:undef));
+ if (!defined($pkg)) {
+ debug("W: $p is mentioned somewhere but not available, disabling\n");
+ $install{$p} = 0;
+@@ -602,16 +738,19 @@
+ if ($p_dep =~ m/^(.*)\.ARCH$/) {
+ my $foo = "$1";
+ foreach $a (@archs) {
+- $install{"$foo.$a"} = 1 if defined($self->get_package("$foo.$a"));
++ # install .ARCH packages from the same sub repository as the
++ # main packages
++ $install{"$foo.$a"} = $install{$foo}
++ if defined($self->get_package("$foo.$a"));
+ }
+ } elsif ($p_dep =~ m/^(.*)\.win32$/) {
+ # a win32 package should *only* be installed if we are installing
+ # the win32 arch
+ if (grep(/^win32$/,@archs)) {
+- $install{$p_dep} = 1;
++ $install{$p_dep} = 0;
+ }
+ } else {
+- $install{$p_dep} = 1 unless $only_arch;
++ $install{$p_dep} = 0 unless $only_arch;
+ }
+ }
+ }
+@@ -623,7 +762,9 @@
+ $changed = 1;
+ }
+ }
+- return(keys %install);
++ # create return list
++ return map { $install{$_} eq "0"?$_:"$_\@" . $install{$_} } keys %install;
++ #return(keys %install);
+ }
+
+ =pod
+@@ -635,6 +776,7 @@
+
+ =cut
+
++# TODO adapt for searching in *all* tags ???
+ sub find_file {
+ my ($self,$fn) = @_;
+ my @ret;
+@@ -868,6 +1010,10 @@
+
+ sub root {
+ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot set/edit root of a virtual tlpdb\n");
++ return 0;
++ }
+ if (@_) { $self->{'root'} = shift }
+ return $self->{'root'};
+ }
+@@ -886,7 +1032,11 @@
+ =cut
+
+ sub location {
+- my $self = shift;
++ my $self = shift;
++ if ($self->is_virtual) {
++ tlwarn("cannot get location of a virtual tlpdb\n");
++ return 0;
++ }
+ return "$self->{'root'}/$InfraLocation/$DatabaseName";
+ }
+
+@@ -937,8 +1087,14 @@
+
+ sub config_src_container {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^container_split_src_files/(.*)$!) {
+ return "$1";
+ }
+@@ -958,8 +1114,14 @@
+
+ sub config_doc_container {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^container_split_doc_files/(.*)$!) {
+ return "$1";
+ }
+@@ -978,8 +1140,14 @@
+
+ sub config_container_format {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^container_format/(.*)$!) {
+ return "$1";
+ }
+@@ -998,8 +1166,14 @@
+
+ sub config_release {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^release/(.*)$!) {
+ return "$1";
+ }
+@@ -1018,8 +1192,14 @@
+
+ sub config_minrelease {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^minrelease/(.*)$!) {
+ return "$1";
+ }
+@@ -1039,8 +1219,14 @@
+
+ sub config_revision {
+ my $self = shift;
+- if (defined($self->{'tlps'}{'00texlive.config'})) {
+- foreach my $d ($self->{'tlps'}{'00texlive.config'}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package('00texlive.config');
++ } else {
++ $tlp = $self->{'tlps'}{'00texlive.config'};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^revision/(.*)$!) {
+ return "$1";
+ }
+@@ -1066,12 +1252,12 @@
+ sub sizes_of_packages {
+ my ($self, $opt_src, $opt_doc, @packs) = @_;
+ @packs || ( @packs = $self->list_packages() );
+- my $media = $self->media;
+ my %tlpsizes;
+ my %tlpobjs;
+ my $totalsize;
+ foreach my $p (@packs) {
+ $tlpobjs{$p} = $self->get_package($p);
++ my $media = $self->media_of_package($p);
+ if (!defined($tlpobjs{$p})) {
+ warn "STRANGE: $p not to be found in ", $self->root;
+ next;
+@@ -1095,7 +1281,7 @@
+ $size += $tlpobj->srccontainersize if $opt_src;
+ $size += $tlpobj->doccontainersize if $opt_doc;
+ } else {
+- # we have to add the respective sizes, that is checking for
++ # we have to add the respective sizes, that is checking for
+ # installation of src and doc file
+ $size = $tlpobj->runsize;
+ $size += $tlpobj->srcsize if $opt_src;
+@@ -1110,31 +1296,46 @@
+
+ =pod
+
+-=item C<< $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb) >>
++=item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >>
+
+ Installs the package $pkg into $dest_tlpdb.
++If C<$tag> is present and the tlpdb is virtual, tries to install $pkg
++from the repository tagged with $tag.
+
+ =cut
+
+ sub install_package {
+- my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_;
++ my ($self, $pkg, $totlpdb, $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 +1383,7 @@
+ 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 +1457,21 @@
+ $totlpdb->save;
+ # compute the return value
+ TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj);
+- if (!$nopostinstall) {
+- # do the postinstallation actions
+- #
+- # Run the post installation code in the postaction tlpsrc entries
+- # in case we are on w32 and the admin did install for himself only
+- # we switch off admin mode
+- if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
+- non_admin();
+- }
+- # for now desktop_integration maps to both installation
+- # of desktop shortcuts and menu items, but we can split them later
+- &TeXLive::TLUtils::do_postaction("install", $tlpobj,
+- $totlpdb->option("file_assocs"),
+- $totlpdb->option("desktop_integration"),
+- $totlpdb->option("desktop_integration"),
+- $totlpdb->option("post_code"));
++ # do the postinstallation actions
++ #
++ # Run the post installation code in the postaction tlpsrc entries
++ # in case we are on w32 and the admin did install for himself only
++ # we switch off admin mode
++ if (win32() && admin() && !$totlpdb->option("w32_multi_user")) {
++ non_admin();
+ }
++ # for now desktop_integration maps to both installation
++ # of desktop shortcuts and menu items, but we can split them later
++ &TeXLive::TLUtils::do_postaction("install", $tlpobj,
++ $totlpdb->option("file_assocs"),
++ $totlpdb->option("desktop_integration"),
++ $totlpdb->option("desktop_integration"),
++ $totlpdb->option("post_code"));
+ }
+ return 1;
+ }
+@@ -1525,7 +1724,7 @@
+ # the postaction code part cannot be evaluated now since the
+ # files are already removed.
+ # Again, desktop integration maps to desktop and menu links
+- if (!$nopostinstall) {
++ if (!$opts{'nopostinstall'}) {
+ &TeXLive::TLUtils::do_postaction("remove", $tlp,
+ $localtlpdb->option("file_assocs"),
+ $localtlpdb->option("desktop_integration"),
+@@ -1557,7 +1756,12 @@
+ sub _set_value_pkg {
+ my ($self,$pkgname,$pre,$key,$value) = @_;
+ my $k = "$pre$key";
+- my $pkg = $self->{'tlps'}{$pkgname};
++ my $pkg;
++ if ($self->is_virtual) {
++ $pkg = $self->{'tlpdbs'}{'main'}->get_package($pkgname);
++ } else {
++ $pkg = $self->{'tlps'}{$pkgname};
++ }
+ my @newdeps;
+ if (!defined($pkg)) {
+ $pkg = new TeXLive::TLPOBJ;
+@@ -1595,8 +1799,14 @@
+ sub _value_pkg {
+ my ($self,$pkg,$pre,$key) = @_;
+ my $k = "$pre$key";
+- if (defined($self->{'tlps'}{$pkg})) {
+- foreach my $d ($self->{'tlps'}{$pkg}->depends) {
++ my $tlp;
++ if ($self->is_virtual) {
++ $tlp = $self->{'tlpdbs'}{'main'}->get_package($pkg);
++ } else {
++ $tlp = $self->{'tlps'}{$pkg};
++ }
++ if (defined($tlp)) {
++ foreach my $d ($tlp->depends) {
+ if ($d =~ m!^$k:(.*)$!) {
+ return "$1";
+ }
+@@ -1709,7 +1919,12 @@
+ my ($self, $pre, $hr) = @_;
+ my @allowed = keys %$hr;
+ my %ret;
+- my $pkg = $self->{'tlps'}{'00texlive.installation'};
++ my $pkg;
++ if ($self->is_virtual) {
++ $pkg = $self->{'tlpdbs'}{'main'}->get_package('00texlive.installation');
++ } else {
++ $pkg = $self->{'tlps'}{'00texlive.installation'};
++ }
+ if (defined($pkg)) {
+ foreach my $d ($pkg->depends) {
+ if ($d =~ m!^$pre([^:]*):(.*)!) {
+@@ -1858,6 +2073,338 @@
+
+ =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'});
++ }
++}
++
++# $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) = split(/:/, $l);
++ my @ret;
++ my %m;
++ $m{'repo'} = $a;
++ $m{'line'} = $l;
++ # 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
+Index: texmf/scripts/texlive/tlmgr.pl
+===================================================================
+--- texmf/scripts/texlive/tlmgr.pl.orig 2011-10-27 23:06:37.000000000 +0900
++++ texmf/scripts/texlive/tlmgr.pl 2012-01-12 12:51:18.000000000 +0900
+@@ -124,6 +124,7 @@
+ "package-logfile" => "=s",
+ "persistent-downloads" => "!",
+ "no-execute-actions" => 1,
++ "pin-file" => "=s",
+ "pause" => 1,
+ "print-platform|print-arch" => 1,
+ "version" => 1,
+@@ -135,6 +136,8 @@
+ "option" => { },
+ "conf" => { },
+ "version" => { },
++ "repository" => { },
++ "candidate" => { },
+ "backup" => { "backupdir" => "=s",
+ "clean" => ":-99",
+ "all" => 1,
+@@ -504,6 +507,12 @@
+ } elsif ($action =~ m/^option$/i) {
+ action_option();
+ finish(0);
++ } elsif ($action =~ m/^repository$/i) {
++ action_repository();
++ finish(0);
++ } elsif ($action =~ m/^candidates$/i) {
++ action_candidates();
++ finish(0);
+ } elsif ($action =~ m/^list$/i) {
+ action_list();
+ finish(0);
+@@ -533,7 +542,7 @@
+ 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 @@
+ 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 @@
+ if (!$remotetlpdb) {
+ init_tlmedia();
+ }
+- $tlp = $remotetlpdb->get_package($pkg);
+- $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();
++ 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;
+ }
+- @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";
++ $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 ($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 ($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;
+ }
+- 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";
+- }
++ $tlpdb = $remotetlpdb;
++ } else {
++ $installed = 1;
++ }
++ 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 "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{"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{"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";
+ }
+ }
+- 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}, '"';
+- }
++ }
++ 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}, '"';
+ }
+- print "\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"; }
+- }
++ }
++ # 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 @@
+ # 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 @@
+ $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("%-10s ", "$txt:");
++ if ($pkglen + $kbstrlen > $flen) {
++ $is .= "$pkg$kbstr: ";
++ } else {
++ $is .= sprintf ('%*2$s', $pkg, -($flen-$kbstrlen));
++ $is .= "$kbstr: ";
++ }
++ $is .= sprintf("local: %6s, 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 @@
+ 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 @@
+ }
+ }
+
++ # parameters for field width
++ my $totalnrdigits = length("$totalnr");
+
+ #
+ # ORDER OF PACKAGE ACTIONS
+@@ -2557,7 +2664,7 @@
+ if ($::machinereadable) {
+ machine_line($p, $FLAG_REMOVE, $rev, "-", "-", "-");
+ } else {
+- info("$p: local: $rev, source: <absent> (auto-remove)\n");
++ upd_info($p, -1, $rev, "<absent>", "a-remove");
+ }
+ $currnr++;
+ } else {
+@@ -2569,7 +2676,8 @@
+ 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 @@
+ $localtlpdb->remove_package($p);
+ logpackage("remove: $p");
+ }
++ info("done\n") unless $::machinereadable;
+ $currnr++;
+ }
+ }
+@@ -2678,19 +2787,39 @@
+ 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: @cand\n";
++ }
++ }
+ }
+ $updated{$pkg} = 1;
+ next;
+@@ -2731,10 +2860,11 @@
+ }
+
+ 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 +2907,7 @@
+ }
+ if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
+ # installation succeeded because we got a reference
+- logpackage("update: $pkg ($rev -> $mediarev)");
++ logpackage("update: $pkg ($rev -> $mediarevstr)");
+ unlink($unwind_package) if $remove_unwind_container;
+ # remember successful update
+ $updated{$pkg} = 1;
+@@ -2805,7 +2935,7 @@
+ # now in fact we should do some cleanup, removing files and
+ # dirs from the new package before re-installing the old one.
+ # TODO
+- logpackage("failed update: $pkg ($rev -> $mediarev)");
++ logpackage("failed update: $pkg ($rev -> $mediarevstr)");
+ tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n");
+ if (win32()) {
+ # w32 is notorious for not releasing a file immediately
+@@ -2846,12 +2976,25 @@
+ unless $::machinereadable;
+ } else {
+ # install new packages
+- my $mediatlp = $remotetlpdb->get_package($pkg);
++ my $mediatlp;
++ my $maxtag;
++ if ($remotetlpdb->is_virtual) {
++ ($maxtag, undef, $mediatlp, undef) =
++ $remotetlpdb->virtual_candidate($pkg);
++ } else {
++ $mediatlp = $remotetlpdb->get_package($pkg);
++ }
+ if (!defined($mediatlp)) {
+ tlwarn("\nShould not happen: $pkg not found in $location\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 +3004,16 @@
+ my @maargs = ($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg});
+ if (!$opts{"list"}) {
+ push @maargs, $estrem, $esttot;
++ } else {
++ push @maargs, undef, undef;
+ }
+- machine_line(@maargs);
++ machine_line(@maargs, @addargs);
+ } else {
+ my $kb = int($sizes{$pkg} / 1024) + 1;
+ if ($opts{"list"}) {
+- info("$pkg [${kb}k]: local: <absent>, source: " . $mediatlp->revision . " (auto-install)\n");
++ upd_info($pkg, $kb, "<absent>", $mediarevstr, "a-install");
+ } 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 +3021,7 @@
+ next if ($opts{"dry-run"} || $opts{"list"});
+ if ($remotetlpdb->install_package($pkg, $localtlpdb)) {
+ # installation succeeded because we got a reference
+- logpackage("auto-install new: $pkg ($mediarev)");
++ logpackage("auto-install new: $pkg ($mediarevstr)");
+ $nrupdated++;
+ } else {
+ tlwarn("$0: couldn't install new package $pkg\n");
+@@ -3023,6 +3168,7 @@
+ 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 +3247,14 @@
+ @packs = $remotetlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"};
+ }
+ #
++ # expand dependencies returns a list pkg@tag in case of a virtual
++ # remote db.
++ my %packs;
++ for my $p (@packs) {
++ my ($pp, $aa) = split('@', $p);
++ $packs{$pp} = (defined($aa) ? $aa : 0);
++ }
++ #
+ # installation order of packages:
+ # first all normal packages, then collections, then schemes
+ # isn't already installed, but the collection already updated, it will
+@@ -3108,7 +3262,7 @@
+ my @inst_packs;
+ my @inst_colls;
+ my @inst_schemes;
+- for my $pkg (sort @packs) {
++ for my $pkg (sort keys %packs) {
+ # we do name checking here, not to load all tlpobj again and again
+ if ($pkg =~ m/^scheme-/) {
+ push @inst_schemes, $pkg;
+@@ -3127,7 +3281,11 @@
+ my @todo;
+ for my $pkg (@inst_packs, @inst_colls, @inst_schemes) {
+ my $pkgrev = 0;
+- my $mediatlp = $remotetlpdb->get_package($pkg);
++ # if the package name is asked from a specific repository, use
++ # that one, otherwise leave the decision to $remotetlpdb by not
++ # giving a final argument
++ my $mediatlp = $remotetlpdb->get_package($pkg,
++ ($packs{$pkg} ? $packs{$pkg} : undef));
+ if (!defined($mediatlp)) {
+ tlwarn("package $pkg not present in package repository.\n");
+ next;
+@@ -3175,13 +3333,26 @@
+ my ($estrem, $esttot) = TeXLive::TLUtils::time_estimate($totalsize,
+ $donesize, $starttime);
+ my $kb = int($sizes{$pkg} / 1024) + 1;
++ my @addargs = ();
++ my $tagstr = "";
++ if ($remotetlpdb->is_virtual) {
++ if ($packs{$pkg} ne "0") {
++ push @addargs, $packs{$pkg};
++ $tagstr = " \@" . $packs{$pkg};
++ } else {
++ my ($maxtag,undef,undef,undef) = $remotetlpdb->virtual_candidate($pkg);
++ push @addargs, $maxtag;
++ $tagstr = " \@" . $maxtag;
++ }
++ }
+ if ($::machinereadable) {
+- machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot);
++ machine_line($pkg, $flag, "-", $revs{$pkg}, $sizes{$pkg}, $estrem, $esttot, @addargs);
+ } else {
+- info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg [${kb}k]\n");
++ info("[$currnr/$totalnr, $estrem/$esttot] ${re}install: $pkg$tagstr [${kb}k]\n");
+ }
+ if (!$opts{"dry-run"}) {
+- $remotetlpdb->install_package($pkg, $localtlpdb);
++ $remotetlpdb->install_package($pkg, $localtlpdb,
++ ($packs{$pkg} ? $packs{$pkg} : undef) );
+ logpackage("${re}install: $pkg");
+ }
+ $donesize += $sizes{$pkg};
+@@ -3204,7 +3375,7 @@
+ # 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 +3394,11 @@
+ } elsif ($what =~ m/^scheme/i) {
+ @whattolist = $tlm->schemes;
+ } else {
+- @whattolist = $tlm->list_packages;
++ if ($remotetlpdb->is_virtual) {
++ @whattolist = $tlm->list_packages("-all");
++ } else {
++ @whattolist = $tlm->list_packages;
++ }
+ }
+ foreach (@whattolist) {
+ next if ($_ =~ m/^00texlive/);
+@@ -3232,12 +3407,198 @@
+ } 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,6 +4962,82 @@
+ #
+ sub init_tlmedia
+ {
++ # first check if $location contains multiple locations
++ # in this case we go to virtual mode
++ #my %repos = repository_to_array($localtlpdb->option("location"));
++ my %repos = repository_to_array($location);
++ my @tags = keys %repos;
++ # 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 $locstr\n");
++
++}
++
++
++
++
++sub _init_tlmedia
++{
+ if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) {
+ # nothing to be done
+ return;
+@@ -4614,10 +5051,28 @@
+ $location =~ s,^$TeXLiveServerURL,$mirrorbase,;
+ }
+
++ $remotetlpdb = setup_one_remotetlpdb($location);
+ # this "location-url" line should not be changed since GUI programs
+ # depend on it:
+ print "location-url\t$location\n" if $::machinereadable;
+ info("tlmgr: package repository $location\n");
++}
++
++sub setup_one_remotetlpdb
++{
++ my $location = shift;
++ my $remotetlpdb;
++
++ # TODO
++ # check if that is already loaded!!!
++
++ # choose a mirror if we are asked.
++ if ($location =~ m/^ctan$/i) {
++ $location = give_ctan_mirror();
++ } elsif ($location =~ m,^$TeXLiveServerURL,) {
++ my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base();
++ $location =~ s,^$TeXLiveServerURL,$mirrorbase,;
++ }
+
+ # if we talk about a net location try to download the hash of the tlpdb
+ # - if that is possible, check for the locally saved file and if the hash
+@@ -4763,8 +5218,30 @@
+ close($tlfh);
+ }
+ }
++
++ return($remotetlpdb);
+ }
+
++sub read_pinning_file {
++ my $pf = shift;
++ my @pins;
++ my $pfh;
++ if (!open($pfh, "<$pf")) {
++ tlwarn("Pinning file $pf cannot be read: $!\n");
++ return;
++ }
++ debug("Reading pinning file $pf\n");
++ while (my $l = TeXLive::TLUtils::get_full_line($pfh)) {
++ chomp($l);
++ # comments and empty lines are allowed
++ next if ($l =~ m/^\s*#/);
++ next if ($l =~ m/^\s*$/);
++ my ($a, $b) = split(/:/, $l);
++ push @pins, $remotetlpdb->make_pin_data_from_line($l);
++ }
++ close($pfh);
++ return @pins;
++}
+
+
+ # finish handles the -pause option (wait for input from stdin),
+@@ -5561,6 +6038,42 @@
+
+ =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 +6711,118 @@
+ 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
+