update multi-source patch for pinning

git-svn-id: svn://tug.org/texlive/trunk@22287 c570f23f-e606-0410-a88d-b1316a301751

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),