summaryrefslogtreecommitdiff
path: root/Master/texmf
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 /Master/texmf
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
Diffstat (limited to 'Master/texmf')
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl114
1 files changed, 80 insertions, 34 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),