diff options
| -rw-r--r-- | Master/tlpkg/dev/dev.multi-source-support-v2.patch | 355 |
1 files changed, 308 insertions, 47 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support-v2.patch b/Master/tlpkg/dev/dev.multi-source-support-v2.patch index b0876034362..576d04b815e 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 22247) +--- tlpkg/TeXLive/TLPDB.pm (revision 22273) +++ tlpkg/TeXLive/TLPDB.pm (working copy) -@@ -73,10 +73,17 @@ +@@ -73,10 +73,18 @@ $tlpdb->install_package($pkg, $dest_tlpdb, $nopostinstall, $fallbacktlpdb); $tlpdb->remove_package($pkg, %options); @@ -15,13 +15,14 @@ Index: tlpkg/TeXLive/TLPDB.pm + $tlpdb->virtual_add_tlpdb($tlpdb, $tag); + $tlpdb->virtual_remove_tlpdb($tag); + $tlpdb->virtual_get_package($pkg, $tag); -+ $tlpdb->virtual_candidates($pkg); ++ $tlpdb->candidates($pkg); + $tlpdb->virtual_candidate($pkg); ++ $tlpdb->virtual_pinning( [\%tlpkpins ] ); + =head1 DESCRIPTION =cut -@@ -160,6 +167,10 @@ +@@ -160,6 +168,10 @@ sub add_tlpobj { my ($self,$tlp) = @_; @@ -32,7 +33,7 @@ Index: tlpkg/TeXLive/TLPDB.pm $self->{'tlps'}{$tlp->name} = $tlp; } -@@ -208,6 +219,10 @@ +@@ -208,6 +220,10 @@ sub remove_tlpobj { my ($self,$pkg) = @_; @@ -43,7 +44,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($self->{'tlps'}{$pkg})) { delete $self->{'tlps'}{$pkg}; } else { -@@ -228,6 +243,10 @@ +@@ -228,6 +244,10 @@ sub from_file { my ($self, $path) = @_; @@ -54,7 +55,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (@_ != 2) { die "$0: from_file needs filename for initialization"; } -@@ -352,6 +371,10 @@ +@@ -352,6 +372,10 @@ sub writeout { my $self = shift; @@ -65,7 +66,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my $fd = (@_ ? $_[0] : STDOUT); foreach (sort keys %{$self->{'tlps'}}) { ddebug("writeout: tlpname=$_ ", $self->{'tlps'}{$_}->name, "\n"); -@@ -371,6 +394,10 @@ +@@ -371,6 +395,10 @@ sub save { my $self = shift; @@ -76,7 +77,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my $path = $self->location; mkdirhier(dirname($path)); my $tmppath = "$path.tmp"; -@@ -392,6 +419,9 @@ +@@ -392,6 +420,9 @@ sub media { my $self = shift ; @@ -86,7 +87,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return $self->{'media'}; } -@@ -407,6 +437,18 @@ +@@ -407,6 +438,18 @@ sub available_architectures { my $self = shift; @@ -105,7 +106,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @archs = $self->setting("available_architectures"); if (! @archs) { # fall back to the old method checking tex\.* -@@ -434,6 +476,10 @@ +@@ -434,6 +477,10 @@ sub add_tlpcontainer { my ($self, $package, $ziplocation, $archrefs, $dest) = @_; @@ -116,7 +117,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @archs; if (defined($archrefs)) { @archs = @$archrefs; -@@ -499,6 +545,16 @@ +@@ -499,6 +546,16 @@ sub get_package { my ($self,$pkg) = @_; @@ -133,7 +134,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($self->{'tlps'}{$pkg})) { my $ret = $self->{'tlps'}{$pkg}; return $self->{'tlps'}{$pkg}; -@@ -509,6 +565,35 @@ +@@ -509,6 +566,35 @@ =pod @@ -169,7 +170,7 @@ Index: tlpkg/TeXLive/TLPDB.pm =item C<< $tlpdb->list_packages >> The C<list_packages> function returns the list of all included packages. -@@ -517,6 +602,15 @@ +@@ -517,6 +603,15 @@ sub list_packages { my $self = shift; @@ -185,7 +186,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return (sort keys %{$self->{'tlps'}}); } -@@ -625,6 +719,7 @@ +@@ -625,6 +720,7 @@ =cut @@ -193,7 +194,7 @@ Index: tlpkg/TeXLive/TLPDB.pm sub find_file { my ($self,$fn) = @_; my @ret; -@@ -858,6 +953,10 @@ +@@ -858,6 +954,10 @@ sub root { my $self = shift; @@ -204,7 +205,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (@_) { $self->{'root'} = shift } return $self->{'root'}; } -@@ -876,7 +975,11 @@ +@@ -876,7 +976,11 @@ =cut sub location { @@ -217,7 +218,7 @@ Index: tlpkg/TeXLive/TLPDB.pm return "$self->{'root'}/$InfraLocation/$DatabaseName"; } -@@ -927,8 +1030,14 @@ +@@ -927,8 +1031,14 @@ sub config_src_container { my $self = shift; @@ -234,7 +235,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_src_files/(.*)$!) { return "$1"; } -@@ -948,8 +1057,14 @@ +@@ -948,8 +1058,14 @@ sub config_doc_container { my $self = shift; @@ -251,7 +252,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_split_doc_files/(.*)$!) { return "$1"; } -@@ -968,8 +1083,14 @@ +@@ -968,8 +1084,14 @@ sub config_container_format { my $self = shift; @@ -268,7 +269,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^container_format/(.*)$!) { return "$1"; } -@@ -988,8 +1109,14 @@ +@@ -988,8 +1110,14 @@ sub config_release { my $self = shift; @@ -285,7 +286,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^release/(.*)$!) { return "$1"; } -@@ -1008,8 +1135,14 @@ +@@ -1008,8 +1136,14 @@ sub config_minrelease { my $self = shift; @@ -302,7 +303,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^minrelease/(.*)$!) { return "$1"; } -@@ -1029,8 +1162,14 @@ +@@ -1029,8 +1163,14 @@ sub config_revision { my $self = shift; @@ -319,7 +320,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^revision/(.*)$!) { return "$1"; } -@@ -1056,12 +1195,12 @@ +@@ -1056,12 +1196,12 @@ sub sizes_of_packages { my ($self, $opt_src, $opt_doc, @packs) = @_; @packs || ( @packs = $self->list_packages() ); @@ -333,7 +334,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (!defined($tlpobjs{$p})) { warn "STRANGE: $p not to be found in ", $self->root; next; -@@ -1085,7 +1224,7 @@ +@@ -1085,7 +1225,7 @@ $size += $tlpobj->srccontainersize if $opt_src; $size += $tlpobj->doccontainersize if $opt_doc; } else { @@ -342,7 +343,7 @@ Index: tlpkg/TeXLive/TLPDB.pm # installation of src and doc file $size = $tlpobj->runsize; $size += $tlpobj->srcsize if $opt_src; -@@ -1108,6 +1247,16 @@ +@@ -1108,6 +1248,16 @@ sub install_package { my ($self, $pkg, $totlpdb, $nopostinstall, $fallbackmedia) = @_; @@ -359,7 +360,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my $fromtlpdb = $self; my $ret; die("TLPDB not initialized, cannot find tlpdb!") unless (defined($fromtlpdb)); -@@ -1547,7 +1696,12 @@ +@@ -1547,7 +1697,12 @@ sub _set_value_pkg { my ($self,$pkgname,$pre,$key,$value) = @_; my $k = "$pre$key"; @@ -373,7 +374,7 @@ Index: tlpkg/TeXLive/TLPDB.pm my @newdeps; if (!defined($pkg)) { $pkg = new TeXLive::TLPOBJ; -@@ -1585,8 +1739,14 @@ +@@ -1585,8 +1740,14 @@ sub _value_pkg { my ($self,$pkg,$pre,$key) = @_; my $k = "$pre$key"; @@ -390,7 +391,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if ($d =~ m!^$k:(.*)$!) { return "$1"; } -@@ -1699,7 +1859,12 @@ +@@ -1699,7 +1860,12 @@ my ($self, $pre, $hr) = @_; my @allowed = keys %$hr; my %ret; @@ -404,7 +405,7 @@ Index: tlpkg/TeXLive/TLPDB.pm if (defined($pkg)) { foreach my $d ($pkg->depends) { if ($d =~ m!^$pre([^:]*):(.*)!) { -@@ -1848,6 +2013,122 @@ +@@ -1848,6 +2014,292 @@ =back @@ -487,17 +488,25 @@ Index: tlpkg/TeXLive/TLPDB.pm +} + +# returns a list of tag/rev -+sub virtual_candidates { ++sub candidates { + my ($self, $pkg) = @_; -+ if (defined($self->{'packages'}{$pkg})) { -+ my @ret = (); -+ for my $t (keys %{$self->{'packages'}{$pkg}}) { -+ push @ret, "$t/" . $self->{'packages'}{$pkg}{$t}{'revision'}; ++ 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; ++ } + } -+ return @ret; + } else { -+ return; ++ my $tlp = $self->get_package($pkg); ++ if (defined($tlp)) { ++ push @ret, "main/" . $tlp->revision; ++ } + } ++ return @ret; +} + +# @@ -507,9 +516,17 @@ Index: tlpkg/TeXLive/TLPDB.pm + 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 = $self->{'packages'}{$pkg}{$t}{'revision'}; ++ 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; @@ -524,24 +541,189 @@ Index: tlpkg/TeXLive/TLPDB.pm + 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. ++ ++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. ++ ++=cut ++ ++sub virtual_pinning { ++ my $self = shift; ++ my $pinref = shift; ++ if (!$self->is_virtual) { ++ tlerror("Not-virtual databases cannot have pinning data.\n"); ++ return 0; ++ } ++ if (!defined($pinref)) { ++ return ($self->{'pindata'}); ++ } else { ++ $self->{'pindata'} = $pinref; ++ 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 { ++ 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"); ++ } ++ # 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"); ++ } ++ } ++ } ++ # 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"); ++ } ++ debug("final pin for $pkg/$tag = $pin\n"); ++ return $pin; ++} ++ ++ ++# copied more or less from Text/Glob.pm ++ ++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 (revision 22247) +--- texmf/scripts/texlive/tlmgr.pl (revision 22273) +++ texmf/scripts/texlive/tlmgr.pl (working copy) -@@ -480,6 +480,9 @@ +@@ -124,6 +124,7 @@ + "package-logfile" => "=s", + "persistent-downloads" => "!", + "no-execute-actions" => 1, ++ "pin-file" => "=s", + "pause" => 1, + "print-platform|print-arch" => 1, + "version" => 1, +@@ -480,6 +481,12 @@ } elsif ($action =~ m/^option$/i) { action_option(); finish(0); + } elsif ($action =~ m/^repository$/i) { + action_repository(); + finish(0); ++ } elsif ($action =~ m/^candidates$/i) { ++ action_candidates(); ++ finish(0); } elsif ($action =~ m/^list$/i) { action_list(); finish(0); -@@ -1937,7 +1940,12 @@ +@@ -1941,7 +1948,12 @@ # intersection, don't check A\B and B\A next if $newpkgs_full{$p}; next if $removals_full{$p}; @@ -555,7 +737,7 @@ Index: texmf/scripts/texlive/tlmgr.pl my $tlp = $localtlpdb->get_package($p); if (!defined($tlp)) { if ($opts{"reinstall-forcibly-removed"}) { -@@ -2904,6 +2912,7 @@ +@@ -2908,6 +2920,7 @@ if (!(@new || @updated)) { info("tlmgr: no updates available\n"); if ($remotetlpdb->media ne "NET" @@ -563,7 +745,7 @@ Index: texmf/scripts/texlive/tlmgr.pl && !$opts{"dry-run"} && !$opts{"repository"} ) { -@@ -3119,7 +3128,116 @@ +@@ -3123,7 +3136,145 @@ return; } @@ -673,20 +855,50 @@ Index: texmf/scripts/texlive/tlmgr.pl + %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) { ++ print "Candidate(s) for $what (* marks the installation candidate):\n"; ++ my $maxtag = "main"; ++ if ($#cand >= 1) { ++ ($maxtag) = $remotetlpdb->virtual_candidate($what); ++ } ++ for my $a (@cand) { ++ my ($t,$r) = split(/\//, $a, 2); ++ print (($maxtag eq $t) ? "*" : " "); ++ print "$t: $r\n"; ++ } ++ } else { ++ print "Package $what not found.\n"; ++ } ++ return; ++} + # OPTION # sub action_option { -@@ -4466,6 +4584,47 @@ +@@ -4470,6 +4621,70 @@ # 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($localtlpdb->option("location")); ++ my %repos = repository_to_array($location); + my @tags = keys %repos; + # check if we are only one tag/repo + if ($#tags == 0) { @@ -713,6 +925,28 @@ Index: texmf/scripts/texlive/tlmgr.pl + $remotetlpdb->virtual_add_tlpdb($tlmdb, $t); + $locstr .= " $repos{$t}" if ($t ne 'main'); + } ++ ++ # 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 ++ 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); ++ } ++ } ++ } ++ ++ + # this "location-url" line should not be changed since GUI programs + # depend on it: + print "location-url\t$locstr\n" if $::machinereadable; @@ -728,7 +962,7 @@ Index: texmf/scripts/texlive/tlmgr.pl if (defined($remotetlpdb) && ($remotetlpdb->root eq $location)) { # nothing to be done return; -@@ -4479,11 +4638,29 @@ +@@ -4483,11 +4698,29 @@ $location =~ s,^$TeXLiveServerURL,$mirrorbase,; } @@ -758,7 +992,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, -@@ -4628,6 +4805,8 @@ +@@ -4632,8 +4865,35 @@ close($tlfh); } } @@ -766,4 +1000,31 @@ Index: texmf/scripts/texlive/tlmgr.pl + return($remotetlpdb); } ++sub read_pinning_file { ++ my $pf = shift; ++ my %pins = (); ++ if (!open(FOO, "<$pf")) { ++ tlwarn("Pinning file $pf cannot be read: $!\n"); ++ return; ++ } ++ debug("Reading pinning file $pf\n"); ++ for my $l (<FOO>) { ++ 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"); ++ } ++ } ++ close(FOO); ++ return %pins; ++} + + # finish handles the -pause option (wait for input from stdin), |