summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2013-02-26 00:02:32 +0000
committerNorbert Preining <preining@logic.at>2013-02-26 00:02:32 +0000
commit4eec7577ec26f29a64908f753e06df0d8ca96997 (patch)
tree95f3703d283f290238cd5e309bd5eeb70a145475
parent4e3978414cdf66be26d273571a86c7f303c67f0a (diff)
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
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl114
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm57
2 files changed, 114 insertions, 57 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 769b9e4aacc..eaa3134334c 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
# $Id$
#
-# Copyright 2008, 2009, 2010, 2011, 2012 Norbert Preining
+# Copyright 2008, 2009, 2010, 2011, 2012, 2013 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -24,6 +24,7 @@ our $loadmediasrcerror;
our $packagelogfile;
our $packagelogged;
our $tlmgr_config_file;
+our $pinfile;
BEGIN {
$^W = 1;
@@ -161,6 +162,7 @@ sub main {
"dry-run|n" => 1 },
"paper" => { "list" => 1 },
"path" => { "w32mode" => "=s" },
+ "pinning" => { "all" => 1 },
"platform" => { "dry-run|n" => 1 },
"postaction" => { "w32mode" => "=s",
"all" => 1,
@@ -3510,7 +3512,76 @@ sub show_list_of_packages {
# tlmgr pinning remove <repo> <pkgglob> [<pkgglob>, ...]
# tlmgr pinning remove <repo> --all
sub action_pinning {
- tlwarn("Not implemented by now, sorry!\n");
+ my $what = shift @ARGV;
+ $what || ($what = 'show');
+ init_local_db();
+ init_tlmedia_or_die();
+ if (!$remotetlpdb->is_virtual) {
+ tlwarn("tlmgr: not a virtual database, no pinning actions supported!\n");
+ return;
+ }
+ my $pinref = $remotetlpdb->virtual_pindata();
+ my $pf = $remotetlpdb->virtual_pinning();
+ my @pins = @$pinref;
+ if ($what =~ m/^show$/i) {
+ print "Defined pinning data:\n";
+ for my $p (@pins) {
+ print " ", $p->{'repo'}, ":", $p->{'glob'}, "\n";
+ }
+ } elsif ($what =~ m/^check$/i) {
+ tlwarn("Not implemented by now, sorry!\n");
+ return 0;
+ } elsif ($what =~ m/^add$/i) {
+ # we need at least two more arguments
+ if ($#ARGV < 1) {
+ tlwarn("missing arguments to pinning add\n");
+ return;
+ }
+ my $repo = shift @ARGV;
+ my @ov = $pf->value($repo);
+ push @ov, @ARGV;
+ $pf->value($repo, @ov);
+ $remotetlpdb->virtual_update_pins();
+ $pf->save;
+ info("Added/Updated pinning data for $repo\n");
+ return 1;
+ } elsif ($what =~ m/^remove$/i) {
+ my $repo = shift @ARGV;
+ if (!defined($repo)) {
+ tlwarn("missing arguments to pinning add\n");
+ return;
+ }
+ my $pf = $remotetlpdb->virtual_pinning();
+ if ($opts{'all'}) {
+ if ($#ARGV >= 0) {
+ tlwarn("no additional argument allowed when --all is given\n");
+ return;
+ }
+ $pf->delete_key($repo);
+ $remotetlpdb->virtual_update_pins();
+ $pf->save;
+ return;
+ }
+ # complicated case, we want to remove only one setting
+ my @ov = $pf->value($repo);
+ my @nv;
+ for my $pf (@ov) {
+ push @nv, $pf if (!member($pf, @ARGV));
+ }
+ $pf->value($repo, @nv);
+ $remotetlpdb->virtual_update_pins();
+ $pf->save;
+ info("Removed pinning data for $repo\n");
+ return 1;
+ } else {
+ tlwarn("Unknown argument to pinning action: $what\n");
+ return 0;
+ }
+ # $pin{'repo'} = $repo;
+ # $pin{'glob'} = $glob;
+ # $pin{'re'} = $re;
+ # $pin{'line'} = $line; # for debug/warning purpose
+ return 0;
}
# REPOSITORY
@@ -5185,24 +5256,19 @@ sub init_tlmedia
# 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 {
+ if (!$opts{"pin-file"}) {
# check for pinning file in TEXMFLOCAL/tlpkg/pinning.txt
chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
debug("trying to load pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
if (-r "$TEXMFLOCAL/tlpkg/pinning.txt") {
- my @pins = read_pinning_file("$TEXMFLOCAL/tlpkg/pinning.txt");
- if (@pins) {
- info("tlmgr: using pinning file $TEXMFLOCAL/tlpkg/pinning.txt\n");
- $remotetlpdb->virtual_pinning(@pins);
- }
+ $opts{"pin-file"} = "$TEXMFLOCAL/tlpkg/pinning.txt";
}
}
-
+ if ($opts{"pin-file"} && -r $opts{"pin-file"}) {
+ # $pinfile is global var
+ $pinfile = TeXLive::TLConfFile->new($opts{"pin-file"}, "#", ":", 'multiple');
+ $remotetlpdb->virtual_pinning($pinfile);
+ }
# this "location-url" line should not be changed since GUI programs
# depend on it:
print "location-url\t$locstr\n" if $::machinereadable;
@@ -5419,26 +5485,6 @@ FROZEN
return($remotetlpdb);
}
-sub read_pinning_file {
- my $pf = shift;
- my @pins;
- my $pfh;
- if (!open($pfh, "<$pf")) {
- tlwarn("Pinning file $pf cannot be read: $!\n");
- return;
- }
- debug("Reading pinning file $pf\n");
- while (my $l = TeXLive::TLUtils::get_full_line($pfh)) {
- chomp($l);
- # comments and empty lines are allowed
- next if ($l =~ m/^\s*#/);
- next if ($l =~ m/^\s*$/);
- my ($a, $b) = split(/:/, $l);
- push @pins, $remotetlpdb->make_pin_data_from_line($l);
- }
- close($pfh);
- return @pins;
-}
# finish handles the -pause option (wait for input from stdin),
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'});
}
#