Implement most of pinning action

use the new TLConfFile multiple value approach to manage the pinning file.
Do all the pin-data handling tlpdb internal

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

1 files changed, 34 insertions, 23 deletions

diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm
index 912aacfc8a4..dd136da6df2 100644
--- a/Master/tlpkg/TeXLive/TLPDB.pm
+++ b/Master/tlpkg/TeXLive/TLPDB.pm
@@ -1,6 +1,6 @@
 # $Id$
 # TeXLive::TLPDB.pm - module for using tlpdb files
-# Copyright 2007-2012 Norbert Preining
+# Copyright 2007-2013 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
@@ -86,7 +86,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages
   $tlpdb->virtual_get_package($pkg, $tag);
   $tlpdb->candidates($pkg);
   $tlpdb->virtual_candidate($pkg);
-  $tlpdb->virtual_pinning( [@tlpkpins ] );
+  $tlpdb->virtual_pinning( [ $pin_file_TLConfFile ] );
 
 =head1 DESCRIPTION
 
@@ -2383,38 +2383,49 @@ sub virtual_candidate {
   return(undef,undef,undef,undef);
 }
 
-=item C<< $tlpdb->virtual_pinning ( [@pinning_data] ) >>
+=item C<< $tlpdb->virtual_pinning ( [ $pinfile_TLConfFile] ) >>
 
-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 list of pins, where each pin
-must be one hash ref with the following keys:
-C<repo> the tag of the repository,
-C<glob> the glob for matching a package
-C<re> the regexp which corresponds to the glob
-C<line> the line where the glob was found (for warning purpose).
+Sets or returns the C<TLConfFile> object for the pinning data.
 
 =cut
 
-sub virtual_pinning {
+sub virtual_pindata {
+  my $self = shift;
+  return ($self->{'pindata'});
+}
+
+sub virtual_update_pins {
   my $self = shift;
-  my (@pins) = @_;
   if (!$self->is_virtual) {
     tlwarn("Not-virtual databases cannot have pinning data.\n");
     return 0;
   }
-  if (!@pins) {
-    if (!defined($self->{'pindata'})) {
-      my @foo = ();
-      $self->{'pindata'} = \@foo;
+  my $pincf = $self->{'pinfile'};
+  my @pins;
+  for my $k ($pincf->keys) {
+    for my $v ($pincf->value($k)) {
+      # we recompose the values into lines again, as we *might* have
+      # options later, i.e., lines of the format
+      #   repo:pkg:opt
+      push @pins, $self->make_pin_data_from_line("$k:$v");
     }
-    return (@{$self->{'pindata'}});
-  } else {
-    $self->{'pindata'} = \@pins;
-    $self->check_evaluate_pinning();
-    return ($self->{'pindata'});
   }
+  $self->{'pindata'} = \@pins;
+  $self->check_evaluate_pinning();
+  return ($self->{'pindata'});
+}
+sub virtual_pinning {
+  my ($self, $pincf) = @_;
+  if (!$self->is_virtual) {
+    tlwarn("Not-virtual databases cannot have pinning data.\n");
+    return 0;
+  }
+  if (!defined($pincf)) {
+    return ($self->{'pinfile'});
+  }
+  $self->{'pinfile'} = $pincf;
+  $self->virtual_update_pins();
+  return ($self->{'pinfile'});
 }
 
 #