diff options
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-support | 156 |
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 |