From ec216a6e55d3417a6ae60c5fa91b19aba65113a4 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 9 May 2011 01:52:35 +0000 Subject: update multi-repo support patch git-svn-id: svn://tug.org/texlive/trunk@22364 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/dev/dev.multi-source-support-v2.patch | 440 +++++++++++++-------- 1 file changed, 275 insertions(+), 165 deletions(-) (limited to 'Master/tlpkg/dev/dev.multi-source-support-v2.patch') diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch index 576d04b815e..e87a772a1f3 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 @@ Index: tlpkg/TeXLive/TLPDB.pm =================================================================== ---- tlpkg/TeXLive/TLPDB.pm (revision 22273) +--- tlpkg/TeXLive/TLPDB.pm (revision 22343) +++ tlpkg/TeXLive/TLPDB.pm (working copy) -@@ -73,10 +73,18 @@ +@@ -73,17 +73,27 @@ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); $tlpdb->remove_package($pkg, %options); @@ -17,12 +17,23 @@ Index: tlpkg/TeXLive/TLPDB.pm + $tlpdb->virtual_get_package($pkg, $tag); + $tlpdb->candidates($pkg); + $tlpdb->virtual_candidate($pkg); -+ $tlpdb->virtual_pinning( [\%tlpkpins ] ); ++ $tlpdb->virtual_pinning( [@tlpkpins ] ); + =head1 DESCRIPTION =cut -@@ -160,6 +168,10 @@ + +-use TeXLive::TLConfig; ++use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation ++ $DatabaseName $MetaCategoriesRegexp $Archive ++ %TLPDBOptions %TLPDBSettings); + 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 Cwd 'abs_path'; +@@ -158,6 +168,10 @@ sub add_tlpobj { my ($self,$tlp) = @_; @@ -33,7 +44,7 @@ Index: tlpkg/TeXLive/TLPDB.pm $self->{'tlps'}{$tlp->name} = $tlp; } -@@ -208,6 +220,10 @@ +@@ -206,6 +220,10 @@ sub remove_tlpobj { my ($self,$pkg) = @_; @@ -44,7 +55,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($self->{'tlps'}{$pkg})) { delete $self->{'tlps'}{$pkg}; } else { -@@ -228,6 +244,10 @@ +@@ -226,6 +244,10 @@ sub from_file { my ($self, $path) = @_; @@ -55,7 +66,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (@_ != 2) { die "$0: from_file needs filename for initialization"; } -@@ -352,6 +372,10 @@ +@@ -350,6 +372,10 @@ sub writeout { my $self = shift; @@ -66,7 +77,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my $fd = (@_ ? $_[0] : STDOUT); foreach (sort keys %{$self->{'tlps'}}) { ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n"); -@@ -371,6 +395,10 @@ +@@ -369,6 +395,10 @@ sub save { my $self = shift; @@ -77,7 +88,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my $path = $self->location; mkdirhier(dirname($path)); my $tmppath = "$path.tmp"; -@@ -392,6 +420,9 @@ +@@ -390,6 +420,9 @@ sub media { my $self = shift ; @@ -87,7 +98,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return $self->{'media'}; } -@@ -407,6 +438,18 @@ +@@ -405,6 +438,18 @@ sub available_architectures { my $self = shift; @@ -106,7 +117,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @archs = $self->setting("available_architectures"); if (! @archs) { # fall back to the old method checking tex\.* -@@ -434,6 +477,10 @@ +@@ -432,6 +477,10 @@ sub add_tlpcontainer { my ($self, $package, $ziplocation, $archrefs, $dest) = @_; @@ -117,7 +128,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @archs; if (defined($archrefs)) { @archs = @$archrefs; -@@ -499,6 +546,16 @@ +@@ -497,6 +546,16 @@ sub get_package { my ($self,$pkg) = @_; @@ -134,7 +145,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($self->{'tlps'}{$pkg})) { my $ret = $self->{'tlps'}{$pkg}; return $self->{'tlps'}{$pkg}; -@@ -509,6 +566,35 @@ +@@ -507,6 +566,35 @@ =pod @@ -170,7 +181,7 @@ Index: tlpkg/TeXLive/TLPDB.pm =item C<< $tlpdb->list_packages >> The C function returns the list of all included packages. -@@ -517,6 +603,15 @@ +@@ -515,6 +603,15 @@ sub list_packages { my $self = shift; @@ -186,7 +197,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return (sort keys %{$self->{'tlps'}}); } -@@ -625,6 +720,7 @@ +@@ -623,6 +720,7 @@ =cut @@ -194,7 +205,7 @@ Index: tlpkg/TeXLive/TLPDB.pm sub find_file { my ($self,$fn) = @_; my @ret; -@@ -858,6 +954,10 @@ +@@ -856,6 +954,10 @@ sub root { my $self = shift; @@ -205,7 +216,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (@_) { $self->{'root'} = shift } return $self->{'root'}; } -@@ -876,7 +976,11 @@ +@@ -874,7 +976,11 @@ =cut sub location { @@ -218,7 +229,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return "$self->{'root'}/$InfraLocation/$DatabaseName"; } -@@ -927,8 +1031,14 @@ +@@ -925,8 +1031,14 @@ sub config_src_container { my $self = shift; @@ -235,7 +246,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_src_files/(.*)$!) { return "$1"; } -@@ -948,8 +1058,14 @@ +@@ -946,8 +1058,14 @@ sub config_doc_container { my $self = shift; @@ -252,7 +263,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_doc_files/(.*)$!) { return "$1"; } -@@ -968,8 +1084,14 @@ +@@ -966,8 +1084,14 @@ sub config_container_format { my $self = shift; @@ -269,7 +280,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_format/(.*)$!) { return "$1"; } -@@ -988,8 +1110,14 @@ +@@ -986,8 +1110,14 @@ sub config_release { my $self = shift; @@ -286,7 +297,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^release/(.*)$!) { return "$1"; } -@@ -1008,8 +1136,14 @@ +@@ -1006,8 +1136,14 @@ sub config_minrelease { my $self = shift; @@ -303,7 +314,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^minrelease/(.*)$!) { return "$1"; } -@@ -1029,8 +1163,14 @@ +@@ -1027,8 +1163,14 @@ sub config_revision { my $self = shift; @@ -320,7 +331,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^revision/(.*)$!) { return "$1"; } -@@ -1056,12 +1196,12 @@ +@@ -1054,12 +1196,12 @@ sub sizes_of_packages { my ($self, $opt_src, $opt_doc, @packs) = @_; @packs || ( @packs = $self->list_packages() ); @@ -334,7 +345,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (!defined($tlpobjs{$p})) { warn "STRANGE: $p not to be found in ", $self->root; next; -@@ -1085,7 +1225,7 @@ +@@ -1083,7 +1225,7 @@ $size += $tlpobj->srccontainersize if $opt_src; $size += $tlpobj->doccontainersize if $opt_doc; } else { @@ -343,7 +354,7 @@ Index: tlpkg/TeXLive/TLPDB.pm # installation of src and doc file $size = $tlpobj->runsize; $size += $tlpobj->srcsize if $opt_src; -@@ -1108,6 +1248,16 @@ +@@ -1106,6 +1248,16 @@ sub install_package { my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; @@ -360,7 +371,16 @@ Index: tlpkg/TeXLive/TLPDB.pm my $fromtlpdb = $self; my $ret; die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb)); -@@ -1547,7 +1697,12 @@ +@@ -1170,7 +1322,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); +@@ -1545,7 +1697,12 @@ sub _set_value_pkg { my ($self,$pkgname,$pre,$key,$value) = @_; my $k = "$pre$key"; @@ -374,7 +394,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @newdeps; if (!defined($pkg)) { $pkg = new TeXLive::TLPOBJ; -@@ -1585,8 +1740,14 @@ +@@ -1583,8 +1740,14 @@ sub _value_pkg { my ($self,$pkg,$pre,$key) = @_; my $k = "$pre$key"; @@ -391,7 +411,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^$k:(.*)$!) { return "$1"; } -@@ -1699,7 +1860,12 @@ +@@ -1697,7 +1860,12 @@ my ($self, $pre, $hr) = @_; my @allowed = keys %$hr; my %ret; @@ -405,7 +425,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($pkg)) { foreach my $d ($pkg->depends) { if ($d =~ m!^$pre([^:]*):(.*)!) { -@@ -1848,6 +2014,292 @@ +@@ -1846,6 +2014,326 @@ =back @@ -421,8 +441,9 @@ Index: tlpkg/TeXLive/TLPDB.pm + +# +# packages are saved: -+# $self->{$pkgname}{$tag}{'revision'} = $rev -+# $self->{$pkgname}{$tag}{'tlp'} = $tlp ++# $self->{$pkgname}{'tags'}{$tag}{'revision'} = $rev ++# $self->{$pkgname}{'tags'}{$tag}{'tlp'} = $tlp ++# $self->{$pkgname}{'target'} = $target_tag +# + +sub is_virtual { @@ -454,9 +475,10 @@ Index: tlpkg/TeXLive/TLPDB.pm + $self->{'tlpdbs'}{$tag} = $tlpdb; + for my $p ($tlpdb->list_packages) { + my $tlp = $tlpdb->get_package($p); -+ $self->{'packages'}{$p}{$tag}{'revision'} = $tlp->revision; -+ $self->{'packages'}{$p}{$tag}{'tlp'} = $tlp; ++ $self->{'packages'}{$p}{'tags'}{$tag}{'revision'} = $tlp->revision; ++ $self->{'packages'}{$p}{'tags'}{$tag}{'tlp'} = $tlp; + } ++ $self->check_evaluate_pinning(); + return 1; +} + @@ -471,33 +493,68 @@ Index: tlpkg/TeXLive/TLPDB.pm + return 0; + } + for my $p ($self->{'tlpdbs'}{$tag}->list_packages) { -+ delete $self->{'packages'}{$p}{$tag}; ++ 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}{$tag})) { -+ return $self->{'packages'}{$pkg}{$tag}{'tlp'}; ++ 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 ++ ++ +# returns a list of tag/rev +sub candidates { -+ my ($self, $pkg) = @_; ++ my $self = shift; ++ my $pkg = shift; + my @ret = (); + if ($self->is_virtual) { + if (defined($self->{'packages'}{$pkg})) { -+ for my $t (keys %{$self->{'packages'}{$pkg}}) { -+ my $bla = "$t/" . $self->{'packages'}{$pkg}{$t}{'revision'}; -+ $bla .= "/" . $self->virtual_pin_tag_value($pkg, $t) -+ if ($self->virtual_pinning); -+ push @ret, $bla; ++ 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 { @@ -509,117 +566,114 @@ Index: tlpkg/TeXLive/TLPDB.pm + 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 ++ +# -+# computation of install candidates from a list of packagess -+# this can later be extended to include pinning +sub virtual_candidate { + my ($self, $pkg) = @_; -+ my $maxrev = -1; -+ my $maxtag; -+ # -+ my $usepinning = $self->virtual_pinning ? 1 : 0; -+ # -+ if (defined($self->{'packages'}{$pkg})) { -+ for my $t (keys %{$self->{'packages'}{$pkg}}) { -+ my $r; -+ if ($usepinning) { -+ $r = $self->virtual_pin_tag_value($pkg, $t); -+ } else { -+ $r = $self->{'packages'}{$pkg}{$t}{'revision'}; -+ } -+ if ($maxrev < $r) { -+ $maxrev = $r; -+ $maxtag = $t; -+ } -+ } -+ } -+ if (defined($maxtag)) { -+ # something was found ($maxsrc, $maxrev, $maxtlp, $maxtlmedia) -+ return ($maxtag, $maxrev, $self->{'packages'}{$pkg}{$maxtag}{'tlp'}, -+ $self->{'tlpdbs'}{$maxtag}); ++ 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] ) >> -+ -+By default the computation of candidates is based on the maximum value -+of revisions. By setting up pinning data the selection method will -+switch to pinning. See VIRTUAL DATABASE and PINNING below. ++=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 ref to a hash containing pinning data -+in the format described below under PINNING. ++With an argument it must be a list of pins, where each pin ++must be one hash ref with the following keys: ++C the tag of the repository, ++C the glob for matching a package ++C the regexp which corresponds to the glob ++C the line where the glob was found (for warning purpose). + +=cut + +sub virtual_pinning { + my $self = shift; -+ my $pinref = shift; ++ my (@pins) = @_; + if (!$self->is_virtual) { + tlerror("Not-virtual databases cannot have pinning data.\n"); + return 0; + } -+ if (!defined($pinref)) { -+ return ($self->{'pindata'}); ++ if (!@pins) { ++ if (!defined($self->{'pindata'})) { ++ my @foo = (); ++ $self->{'pindata'} = \@foo; ++ } ++ return (@{$self->{'pindata'}}); + } else { -+ $self->{'pindata'} = $pinref; ++ $self->{'pindata'} = \@pins; ++ $self->check_evaluate_pinning(); + return ($self->{'pindata'}); + } +} + -+ -+# compute the pin value from the %tlpkgpins hash -+# $pins{'catchall'}{$tag} = $pin *:tlcontrib:600 -+# $pins{'glob'}{$pkgglob}{$tag} = $pin texlive*:tlcritical:700 -+# $pins{'name'}{$pkg}{$tag} = $pin pgf:tlcontrib:200 -+# -+# pins are evaluate according to their level of specifics. First the catch all, -+# then the one with globs, then the full package names. THe laters *override* -+# the formers. -+# Example: -+# *:main:500 -+# *:tlcontrib:300 -+# context*:tlcontrib:600 -+# context-foobar:privaterepo:900 -+# in this case all packages from main would get 500, all from tlcontrib 300, -+# so less important. BUt packages matching "context*" would be installed -+# from tlcontrib, but that again is overriden from context-foobar which -+# will be installed from privaterepo. -+# Thus order is not important (besides the case that one puts the same line -+# two times!) -+sub virtual_pin_tag_value { ++# $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 ($pkg, $tag) = @_; -+ my %pins = %{$self->{'pindata'}}; -+ # default pin -+ debug("setting pin $pkg/$tag to 500 (default)\n"); -+ my $pin = 500; -+ # first the catch all cases -+ if (defined($pins{'catchall'}{$tag})) { -+ $pin = $pins{'catchall'}{$tag}; -+ debug("setting pin $pkg/$tag to $pin (catchall case for $tag)\n"); ++ 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; + } -+ # next the glob matching -+ my %pinglobs = %{$pins{'glob'}}; -+ for my $gl (keys %pinglobs) { -+ my $re = glob_to_regex($gl); -+ if ($pkg =~ m/$re/) { -+ if (defined($pins{'glob'}{$gl}{$tag})) { -+ $pin = $pins{'glob'}{$gl}{$tag}; -+ debug("setting pin $pkg/$tag to $pin (glob case for $gl)\n"); ++ 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; + } + } + } -+ # finally normal pkg names -+ if (defined($pins{'name'}{$pkg}{$tag})) { -+ $pin = $pins{'name'}{$pkg}{$tag}; -+ debug("setting pin $pkg/$tag to $pin (name case)\n"); ++ # 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"); + } -+ debug("final pin for $pkg/$tag = $pin\n"); -+ return $pin; +} + + @@ -698,9 +752,61 @@ Index: tlpkg/TeXLive/TLPDB.pm =pod =head1 OPTIONS +Index: tlpkg/TeXLive/TLUtils.pm +=================================================================== +--- tlpkg/TeXLive/TLUtils.pm (revision 22343) ++++ tlpkg/TeXLive/TLUtils.pm (working copy) +@@ -62,6 +62,7 @@ + TeXLive::TLUtils::setup_programs($bindir, $platform); + TeXLive::TLUtils::tlcmp($file, $file); + TeXLive::TLUtils::nulldev(); ++ TeXLive::TLUtils::get_full_line($fh); + + =head2 Installer Functions + +@@ -180,6 +181,7 @@ + &setup_persistent_downloads + &mktexupd + &nulldev ++ &get_full_line + ); + @EXPORT = qw(setup_programs download_file process_logging_options + tldie tlwarn info log debug ddebug dddebug debug_hash +@@ -2424,6 +2426,31 @@ + return (&win32)? 'nul' : '/dev/null'; + } + ++=item C ++ ++returns the next line from the file handle $fh, taking ++continuation lines into account (last character of a line is \, and ++no quoting is parsed). ++ ++=cut ++ ++# open my $f, '<', $file_name or die; ++# while (my $l = get_full_line($f)) { ... } ++# close $f or die; ++sub get_full_line { ++ my ($fh) = @_; ++ my $line = <$fh>; ++ return undef unless defined $line; ++ return $line unless $line =~ s/\\\r?\n$//; ++ my $cont = get_full_line($fh); ++ if (!defined($cont)) { ++ tlwarn('Continuation disallowed at end of file'); ++ $cont = ""; ++ } ++ $cont =~ s/^\s*//; ++ return $line . $cont; ++} ++ + + =back + Index: texmf/scripts/texlive/tlmgr.pl =================================================================== ---- texmf/scripts/texlive/tlmgr.pl (revision 22273) +--- texmf/scripts/texlive/tlmgr.pl (revision 22344) +++ texmf/scripts/texlive/tlmgr.pl (working copy) @@ -124,6 +124,7 @@ "package-logfile" => "=s", @@ -745,7 +851,7 @@ Index: texmf/scripts/texlive/tlmgr.pl && !$opts{"dry-run"} && !$opts{"repository"} ) { -@@ -3123,7 +3136,145 @@ +@@ -3123,7 +3136,150 @@ return; } @@ -872,15 +978,20 @@ Index: texmf/scripts/texlive/tlmgr.pl + init_tlmedia(); + my @cand = $remotetlpdb->candidates($what); + if (@cand) { -+ print "Candidate(s) for $what (* marks the installation candidate):\n"; -+ my $maxtag = "main"; -+ if ($#cand >= 1) { -+ ($maxtag) = $remotetlpdb->virtual_candidate($what); ++ 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"; + } -+ for my $a (@cand) { -+ my ($t,$r) = split(/\//, $a, 2); -+ print (($maxtag eq $t) ? "*" : " "); -+ print "$t: $r\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"; @@ -891,7 +1002,7 @@ Index: texmf/scripts/texlive/tlmgr.pl # OPTION # sub action_option { -@@ -4470,6 +4621,70 @@ +@@ -4470,6 +4626,74 @@ # sub init_tlmedia { @@ -920,28 +1031,32 @@ Index: texmf/scripts/texlive/tlmgr.pl + $remotetlpdb->make_virtual; + + my $locstr = $repos{'main'}; ++ my $tlmdb = setup_one_remotetlpdb($locstr); ++ $remotetlpdb->virtual_add_tlpdb($tlmdb, "main"); + for my $t (@tags) { -+ my $tlmdb = setup_one_remotetlpdb($repos{$t}); -+ $remotetlpdb->virtual_add_tlpdb($tlmdb, $t); -+ $locstr .= " $repos{$t}" if ($t ne 'main'); ++ 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); ++ my @pins = read_pinning_file($opts{"pin-file"}); ++ if (@pins) { ++ $remotetlpdb->virtual_pinning(@pins); + } + } else { -+ # check for pinning file in TEXMFLOCAL/tlpkg/pinning ++ # 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\n"); -+ if (-r "$TEXMFLOCAL/tlpkg/pinning") { -+ my %pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning"); -+ if (%pins) { -+ info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning\n"); -+ $remotetlpdb->virtual_pinning(\%pins); ++ 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); + } + } + } @@ -962,7 +1077,7 @@ Index: texmf/scripts/texlive/tlmgr.pl if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { # nothing to be done return; -@@ -4483,11 +4698,29 @@ +@@ -4483,11 +4707,29 @@ $location =~ s,^$TeXLiveServerURL,$mirrorbase,; } @@ -992,7 +1107,7 @@ Index: texmf/scripts/texlive/tlmgr.pl # if we talk about a net location try to download the hash of the tlpdb # - if that is possible, check for the locally saved file and if the hash # agrees load the local copy if present instead of the remote one, -@@ -4632,8 +4865,35 @@ +@@ -4632,8 +4874,30 @@ close($tlfh); } } @@ -1002,28 +1117,23 @@ Index: texmf/scripts/texlive/tlmgr.pl +sub read_pinning_file { + my $pf = shift; -+ my %pins = (); -+ if (!open(FOO, "<$pf")) { ++ my @pins; ++ my $pfh; ++ if (!open($pfh, "<$pf")) { + tlwarn("Pinning file $pf cannot be read: $!\n"); + return; + } + debug("Reading pinning file $pf\n"); -+ for my $l () { ++ while (my $l = TeXLive::TLUtils::get_full_line($pfh)) { + chomp($l); -+ my ($a, $b, $c) = split(/:/, $l); -+ if ($a eq "*") { -+ $pins{'catchall'}{$b} = $c; -+ debug("found catchall pin line: $a : $b : $c\n"); -+ } elsif ($a =~ m/[\*\?]/) { -+ $pins{'glob'}{$a}{$b} = $c; -+ debug("found glob pin line: $a : $b : $c\n"); -+ } else { -+ $pins{'name'}{$a}{$b} = $c; -+ debug("found name pin line: $a : $b : $c\n"); -+ } ++ # 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(FOO); -+ return %pins; ++ close($pfh); ++ return @pins; +} -- cgit v1.2.3