summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support')
-rw-r--r--Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support156
1 files changed, 156 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support b/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support
new file mode 100644
index 00000000000..fabbfc6ad49
--- /dev/null
+++ b/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support
@@ -0,0 +1,156 @@
+add support for TEXMFSYSCONFIG/tlmgr/pinning
+show the available pins in tlmgr candidate and mark the winning one with *
+---
+ texmf/scripts/texlive/tlmgr.pl | 102 +++++++++++++++++++++++++++++++++++++++--
+ 1 file changed, 99 insertions(+), 3 deletions(-)
+
+Index: Master/texmf/scripts/texlive/tlmgr.pl
+===================================================================
+--- Master.orig/texmf/scripts/texlive/tlmgr.pl 2010-05-05 03:22:16.000000000 +0900
++++ Master/texmf/scripts/texlive/tlmgr.pl 2010-05-05 03:22:24.000000000 +0900
+@@ -71,6 +71,7 @@
+
+ use Cwd qw/abs_path/;
+ use Digest::MD5;
++use Text::Glob qw( match_glob);
+ use Pod::Usage;
+ use Getopt::Long qw(:config no_autoabbrev permute);
+ use strict;
+@@ -90,6 +91,7 @@
+ binmode(STDERR, ":utf8");
+
+ our %config; # hash of config settings from config file
++our %Pin; # $pin{$tag}{$package}
+ our $tlmediasrc; # media from which we install/update
+ our %tlmediasrcs;
+ our $tlmediatlpdb;
+@@ -333,6 +335,9 @@
+ # load the config file and set the config options
+ # load it BEFORE starting downloads as we seet persistent-downloads there!
+ load_config_file();
++ #
++ # load pinning file
++ load_pinning_file();
+
+ #
+ # if we are asked to use persistent connections try to start it here
+@@ -3134,18 +3139,28 @@
+ init_local_db(1);
+ init_tlmedias();
+ foreach my $pkg (@ARGV) {
+- my @l = ();
++ my %pkgpin = ();
++ my %revs = ();
++ my $maxsrc = "";
++ my $maxpin = "-1";
+ for my $s (keys %tlmediasrcs) {
+ info("trying $s ...\n");
+ my $tlp = $tlmediatlpdbs{$s}->get_package($pkg);
+ if ($tlp) {
+- push @l, "$s (" . $tlp->revision . ")";
++ $revs{$s} = $tlp->revision;
++ $pkgpin{$s} = get_pin($s,$pkg);
++ if ($maxpin < $pkgpin{$s}) {
++ $maxsrc = $s;
++ $maxpin = $pkgpin{$s};
++ }
+ }
+ }
++ my @l = sort keys %pkgpin;
+ if (@l) {
+ info("$pkg:\n");
+ for my $f (@l) {
+- info("\t$f\n");
++ info(($f eq $maxsrc ? "\t*" : "\t "));
++ info("$f ($revs{$f}) [$pkgpin{$f}]\n");
+ }
+ } else {
+ info("No installation candidate for $pkg\n");
+@@ -4541,6 +4556,87 @@
+ close(TLC);
+ }
+
++#
++# pinning file handling
++# location
++# TEXMFSYSCONFIG/tlmgr/pinning
++# (it is only globally useful!)
++# format
++# # are comments
++# empty lines are ignored
++# package:tag:pin
++# where package is a glob, tag a tag (no * allowed, what for!),
++# pin between 0 and 1000
++# tags identify repositories, so they can also be the urls
++#
++#
++# Format in memory:
++# $Pin{$tag}{$package} but $tag can NOT be "*"
++#
++sub load_pinning_file
++{
++ #
++ chomp (my $TEXMFSYSCONFIG = `kpsewhich -var-value=TEXMFSYSCONFIG`);
++ my $fn = "$TEXMFSYSCONFIG/tlmgr/pinning";
++ if (-r $fn) {
++ if (!open(TLC, "<$fn")) {
++ tlwarn("Cannot open $fn: $!");
++ return;
++ }
++ while (<TLC>) {
++ if (m/^\s*$/) { next; }
++ if (m/^\s*#/) { next; }
++ # TODO
++ # check that we can enter all URL chars in [\w-]+ ?!
++ if (m/^\s*([*\w-]+)\s*:\s*([\w-]+)\s*:\s*([*\w-]+)\s*$/) {
++ my $package = $1;
++ my $tag = $2;
++ my $pin = $3;
++ if ($pin !~ m/^[0-9]+/) {
++ tlwarn("Pin $pin is not numeric, ignoring it.\n");
++ next;
++ }
++ if ($pin < 0 || $pin > 1000) {
++ tlwarn ("Pin $pin out of range (0-1000), ignoring.\n");
++ next;
++ }
++ $Pin{$tag}{$package} = $pin;
++ next;
++ }
++ tlwarn("I cannot understand the following line in $fn:\n$_\n");
++ next;
++ }
++ close(TLC);
++ }
++}
++
++sub match_package
++{
++ my ($package, $p) = @_;
++ return 1 if match_glob( $p, $package);
++}
++
++#
++# compute the pin of $package/$tag
++sub get_pin
++{
++ my ($tag, $package) = @_;
++ # the following three pins collect that pins set by:
++ my $pin;
++ if (defined($Pin{$tag})) {
++ # for this tag some pin specifications are provided, go through
++ # all of them and check them
++ my %foo = %{$Pin{$tag}};
++ for my $p (keys %foo) {
++ $pin = $foo{$p} if match_package($package, $p);
++ }
++ return $pin if defined($pin);
++ }
++ # default pin
++ return 500;
++}
++
++
+ # if the packagelog variable is set then write to PACKAGELOG filehandle
+ #
+ sub logpackage