texlive[44136] Master/texmf-dist/scripts/texlive/tlmgr.pl:
commits+karl at tug.org
commits+karl at tug.org
Mon May 1 19:57:20 CEST 2017
Revision: 44136
http://tug.org/svn/texlive?view=revision&revision=44136
Author: karl
Date: 2017-05-01 19:57:19 +0200 (Mon, 01 May 2017)
Log Message:
-----------
(action_shell): trivial help command, move source
to end of other actions. other minor formatting.
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
Modified: trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl
===================================================================
--- trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl 2017-05-01 15:50:31 UTC (rev 44135)
+++ trunk/Master/texmf-dist/scripts/texlive/tlmgr.pl 2017-05-01 17:57:19 UTC (rev 44136)
@@ -1145,6 +1145,7 @@
#
PAPER
+#
# ARGV can look like:
# paper a4
# paper letter
@@ -1335,7 +1336,7 @@
return ($ret | $F_NOPOSTACTION);
}
-#
DUMP TLPDB
+#
DUMP-TLPDB
#
sub action_dumptlpdb {
init_local_db();
@@ -4316,7 +4317,7 @@
}
-#
ARCH
+#
PLATFORM (was ARCH)
#
sub action_platform {
my $ret = $F_OK;
@@ -4817,6 +4818,7 @@
return;
}
+
#
CHECK
#
sub init_tltree {
@@ -5350,7 +5352,9 @@
return $ret;
}
+
#
POSTACTION
+#
# explictly run the various post actions, e.g.,
# on a client system or overriding global settings.
#
@@ -5458,7 +5462,9 @@
}
}
-#
INIT USER TREE
+
+#
INIT-USERTREE
+#
# sets up the user tree for tlmgr in user mode
sub action_init_usertree {
# init_local_db but do not die if localtlpdb is not found!
@@ -5500,7 +5506,9 @@
return ($F_OK);
}
+
#
CONF
+#
# tries to mimic texconfig conf but can also set values for both tlmgr
# and texmf conf files.
#
@@ -5729,14 +5737,13 @@
}
-
-# Action key
+#
KEY
#
-# general key management
-#
+# gpg key management:
# tlmgr key list
# tlmgr key add <filename>
# tlmgr key remove <keyid>
+#
sub action_key {
my $arg = shift @ARGV;
@@ -5813,6 +5820,211 @@
}
+#
SHELL
+# interactive shell.
+#
+sub action_shell {
+ my $protocol = 1;
+ sub do_prompt {
+ my $default_prompt = "tlmgr>";
+ my $prompt = "";
+ my @options;
+ my @guarantee;
+ my @savedargs = @_;
+ my $did_prompt = 0;
+ while (defined(my $arg = shift @_)) {
+ if ($arg =~ m/^-prompt$/) {
+ print shift @_, " ";
+ $did_prompt = 1;
+ } elsif ($arg =~ m/^-menu$/) {
+ my $options = shift @_;
+ @options = @$options;
+ print "\n";
+ my $c = 1;
+ for my $o (@options) {
+ print " $c) $o\n";
+ $c++;
+ }
+ } elsif ($arg =~ m/^-guarantee$/) {
+ my $guarantee = shift @_;
+ @guarantee = @$guarantee;
+ } elsif ($arg =~ m/^-/) {
+ print "ERROR unsupported prompt command, please report: $arg!\n";
+ } else {
+ print $arg, " ";
+ $did_prompt = 1;
+ }
+ }
+ print "default_prompt " if (!$did_prompt);
+ my $ans = <STDIN>;
+ if (!defined($ans)) {
+ # we got Ctrl-D, just break out
+ return;
+ }
+ chomp($ans);
+ if (@options) {
+ $ans--;
+ if ($ans >= 0 && $ans <= $#options) {
+ $ans = $options[$ans];
+ return($ans);
+ } else {
+ print "ERROR invalid answer\n";
+ return;
+ }
+ }
+ if (@guarantee) {
+ my $isok = 0;
+ for my $g (@guarantee) {
+ if ($ans eq $g) {
+ $isok = 1;
+ last;
+ }
+ }
+ if (!$isok) {
+ print("Please answer one of @guarantee!\n");
+ return(do_prompt(@savedargs));
+ }
+ }
+ return($ans);
+ }
+
+ print "protocol $protocol\n";
+ while (1) {
+ # print $prompt;
+ # my $ans = <STDIN>;
+ my $ans = do_prompt('tlmgr>');
+ # chomp $ans;
+ next if (!defined($ans));
+ my ($cmd, @args) = TeXLive::TLUtils::quotewords('\s+', 0, $ans);
+ next if (!defined($cmd));
+ if ($cmd eq "protocol") {
+ print "protocol $protocol\n";
+ } elsif ($cmd eq "help") {
+ print "Please see tlmgr help or http://tug.org/texlive/tlmgr.html.\n";
+ } elsif ($cmd eq "version") {
+ print give_version(), "\n";
+ } elsif ($cmd =~ m/^(quit|end|bye(bye)?)$/i) {
+ return $F_OK;
+ } elsif ($cmd eq "setup-location") {
+ my $dest = shift @args;
+ print "ERROR not implemented: $cmd\n";
+ } elsif ($cmd =~ m/^(set|get)$/) {
+ my @valid_keys = qw/repository debug-translation machine-readable no-execute-actions require-verification verify-downloads/;
+ my $key = shift @args;
+ my $val = shift @args;
+ if (!$key) {
+ $key = do_prompt('Choose...', -menu => \@valid_keys, '>');
+ }
+ if (!$key) {
+ print("ERROR missing argument for get\n");
+ next;
+ }
+ if ($cmd eq "get" && defined($val)) {
+ print("ERROR no argument allowed for get\n");
+ next;
+ }
+ if ($cmd eq "set" && !defined($val)) {
+ if ($key eq "repository") {
+ $val = do_prompt('Enter repository:');
+ } else {
+ $val = do_prompt('Enter 1 for on, 0 for off:', -guarantee => [0,1]);
+ }
+ # deal with Ctrl-D
+ if (!defined($val)) {
+ print("ERROR Missing value for set.\n");
+ next;
+ }
+ }
+
+ if ($key eq "repository") {
+ if ($cmd eq "set") {
+ $location = scalar($val);
+ } else {
+ if (defined($location)) {
+ print "repository = $location\n";
+ } else {
+ print "repository = <UNDEFINED>\n";
+ }
+ }
+ print "OK\n";
+ } elsif ($key =~ m/^(debug-translation|machine-readable|no-execute-actions|require-verification|verify-downloads)$/i) {
+ if ($cmd eq "set") {
+ $opts{$key} = ($val eq "1" ? 1 : 0); ### THIS DOES NOT WORK??? TODO TODO
+ # special cases
+ $::debug_translation = $opts{"debug-translation"};
+ $::machinereadable = $opts{"machine-readable"};
+ $::no_execute_actions = $opts{'no-execute-actions'};
+ } else {
+ print "$key = ", ($opts{$key} ? 1 : 0), "\n";
+ }
+ print "OK\n";
+ } else {
+ print "ERROR unknown key $key\n";
+ }
+ } elsif ($cmd eq "load") {
+ my $what = shift @args;
+ if (!defined($what)) {
+ $what = do_prompt("Choose...", -menu => ['local', 'remote'], '>');
+ }
+ if ($what eq "local") {
+ init_local_db();
+ print "OK\n";
+ } elsif ($what eq "remote") {
+ init_tlmedia_or_die();
+ print "OK\n";
+ } else {
+ print "ERROR can only load 'local' or 'remote'\n";
+ }
+ } elsif ($cmd eq "save") {
+ $localtlpdb->save;
+ print "OK\n";
+ } elsif (defined($action_specification{$cmd})) {
+ # an action
+ if (!defined($action_specification{$cmd}{"function"})) {
+ print "ERROR action function not defined\n";
+ next;
+ }
+ # redo the option parsing
+ my %optarg;
+ if (defined($action_specification{$cmd}{'options'})) {
+ my %actopts = %{$action_specification{$cmd}{'options'}};
+ for my $k (keys %actopts) {
+ if ($actopts{$k} eq "1") {
+ $optarg{$k} = 1;
+ } else {
+ $optarg{"$k" . $actopts{$k}} = 1;
+ }
+ }
+ }
+ # save command line options for later restart, if necessary
+ @ARGV = @args;
+ my %savedopts = %opts;
+ %opts = ();
+ if (!GetOptions(\%opts, keys(%optarg))) {
+ print "ERROR unsupported arguments\n";
+ next;
+ }
+ my $ret = execute_action($cmd, @ARGV);
+ if ($ret & $F_ERROR) {
+ print "ERROR\n";
+ } elsif ($ret & $F_WARNING) {
+ print "OK\n";
+ } else {
+ print "OK\n";
+ }
+ # make sure that we restart after having called update --self!
+ if (($cmd eq 'update') && $opts{'self'}) {
+ print "tlmgr has been updated, restarting!\n";
+ exec("tlmgr", @::SAVEDARGV);
+ }
+ %opts = %savedopts;
+ } else {
+ print "ERROR unknown command\n";
+ }
+ }
+}
+
+
# Subroutines galore.
#
@@ -6589,208 +6801,6 @@
}
-###########
-# tlmgr shell code
-sub action_shell {
- my $protocol = 1;
- sub do_prompt {
- my $default_prompt = "tlmgr>";
- my $prompt = "";
- my @options;
- my @guarantee;
- my @savedargs = @_;
- my $did_prompt = 0;
- while (defined(my $arg = shift @_)) {
- if ($arg =~ m/^-prompt$/) {
- print shift @_, " ";
- $did_prompt = 1;
- } elsif ($arg =~ m/^-menu$/) {
- my $options = shift @_;
- @options = @$options;
- print "\n";
- my $c = 1;
- for my $o (@options) {
- print " $c) $o\n";
- $c++;
- }
- } elsif ($arg =~ m/^-guarantee$/) {
- my $guarantee = shift @_;
- @guarantee = @$guarantee;
- } elsif ($arg =~ m/^-/) {
- print "ERROR unsupported prompt command, please report: $arg!\n";
- } else {
- print $arg, " ";
- $did_prompt = 1;
- }
- }
- print "default_prompt " if (!$did_prompt);
- my $ans = <STDIN>;
- if (!defined($ans)) {
- # we got Ctrl-D, just break out
- return;
- }
- chomp($ans);
- if (@options) {
- $ans--;
- if ($ans >= 0 && $ans <= $#options) {
- $ans = $options[$ans];
- return($ans);
- } else {
- print "ERROR invalid answer\n";
- return;
- }
- }
- if (@guarantee) {
- my $isok = 0;
- for my $g (@guarantee) {
- if ($ans eq $g) {
- $isok = 1;
- last;
- }
- }
- if (!$isok) {
- print("Please answer one of @guarantee!\n");
- return(do_prompt(@savedargs));
- }
- }
- return($ans);
- }
-
- print "protocol $protocol\n";
- while (1) {
- # print $prompt;
- # my $ans = <STDIN>;
- my $ans = do_prompt('tlmgr>');
- # chomp $ans;
- next if (!defined($ans));
- my ($cmd, @args) = TeXLive::TLUtils::quotewords('\s+', 0, $ans);
- next if (!defined($cmd));
- if ($cmd eq "protocol") {
- print "protocol $protocol\n";
- } elsif ($cmd eq "version") {
- print give_version(), "\n";
- } elsif ($cmd =~ m/^(quit|end|byebye)$/i) {
- return $F_OK;
- } elsif ($cmd eq "setup-location") {
- my $dest = shift @args;
- print "ERROR not implemented: $cmd\n";
- } elsif ($cmd =~ m/^(set|get)$/) {
- my @valid_keys = qw/repository debug-translation machine-readable no-execute-actions require-verification verify-downloads/;
- my $key = shift @args;
- my $val = shift @args;
- if (!$key) {
- $key = do_prompt('Choose...', -menu => \@valid_keys, '>');
- }
- if (!$key) {
- print("ERROR missing argument for get\n");
- next;
- }
- if ($cmd eq "get" && defined($val)) {
- print("ERROR no argument allowed for get\n");
- next;
- }
- if ($cmd eq "set" && !defined($val)) {
- if ($key eq "repository") {
- $val = do_prompt('Enter repository:');
- } else {
- $val = do_prompt('Enter 1 for on, 0 for off:', -guarantee => [0,1]);
- }
- # deal with Ctrl-D
- if (!defined($val)) {
- print("ERROR Missing value for set.\n");
- next;
- }
- }
-
- if ($key eq "repository") {
- if ($cmd eq "set") {
- $location = scalar($val);
- } else {
- if (defined($location)) {
- print "repository = $location\n";
- } else {
- print "repository = <UNDEFINED>\n";
- }
- }
- print "OK\n";
- } elsif ($key =~ m/^(debug-translation|machine-readable|no-execute-actions|require-verification|verify-downloads)$/i) {
- if ($cmd eq "set") {
- $opts{$key} = ($val eq "1" ? 1 : 0); ### THIS DOES NOT WORK??? TODO TODO
- # special cases
- $::debug_translation = $opts{"debug-translation"};
- $::machinereadable = $opts{"machine-readable"};
- $::no_execute_actions = $opts{'no-execute-actions'};
- } else {
- print "$key = ", ($opts{$key} ? 1 : 0), "\n";
- }
- print "OK\n";
- } else {
- print "ERROR unknown key $key\n";
- }
- } elsif ($cmd eq "load") {
- my $what = shift @args;
- if (!defined($what)) {
- $what = do_prompt("Choose...", -menu => ['local', 'remote'], '>');
- }
- if ($what eq "local") {
- init_local_db();
- print "OK\n";
- } elsif ($what eq "remote") {
- init_tlmedia_or_die();
- print "OK\n";
- } else {
- print "ERROR can only load 'local' or 'remote'\n";
- }
- } elsif ($cmd eq "save") {
- $localtlpdb->save;
- print "OK\n";
- } elsif (defined($action_specification{$cmd})) {
- # an action
- if (!defined($action_specification{$cmd}{"function"})) {
- print "ERROR action function not defined\n";
- next;
- }
- # redo the option parsing
- my %optarg;
- if (defined($action_specification{$cmd}{'options'})) {
- my %actopts = %{$action_specification{$cmd}{'options'}};
- for my $k (keys %actopts) {
- if ($actopts{$k} eq "1") {
- $optarg{$k} = 1;
- } else {
- $optarg{"$k" . $actopts{$k}} = 1;
- }
- }
- }
- # save command line options for later restart, if necessary
- @ARGV = @args;
- my %savedopts = %opts;
- %opts = ();
- if (!GetOptions(\%opts, keys(%optarg))) {
- print "ERROR unsupported arguments\n";
- next;
- }
- my $ret = execute_action($cmd, @ARGV);
- if ($ret & $F_ERROR) {
- print "ERROR\n";
- } elsif ($ret & $F_WARNING) {
- print "OK\n";
- } else {
- print "OK\n";
- }
- # make sure that we restart after having called update --self!
- if (($cmd eq 'update') && $opts{'self'}) {
- print "tlmgr has been updated, restarting!\n";
- exec("tlmgr", @::SAVEDARGV);
- }
- %opts = %savedopts;
- } else {
- print "ERROR unknown command\n";
- }
- }
-}
-
-
1;
__END__
More information about the tex-live-commits
mailing list