summaryrefslogtreecommitdiff
path: root/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support
blob: fabbfc6ad49aa866d1abe457351c7df378006610 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
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