summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2015-04-23 22:56:57 +0000
committerKarl Berry <karl@freefriends.org>2015-04-23 22:56:57 +0000
commitec4fffd1f3b4bf24a5892e6cd2c06da1b562bab4 (patch)
treee9a0e166feddda069f12c3379e08251eaf78b06d /Build
parenta5edcfe433dd540818b1a0d4eafd6c4b63d24dcc (diff)
musixtex (22apr15), with musixtnt binaries (fixmsxpart,msxlint) now their own package
git-svn-id: svn://tug.org/texlive/trunk@37025 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
-rwxr-xr-xBuild/source/texk/texlive/linked_scripts/texlive/tlmgr.pl818
1 files changed, 521 insertions, 297 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
index 2044e3aca2a..0921eeea637 100755
--- a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
+++ b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
@@ -1,12 +1,12 @@
#!/usr/bin/env perl
-# $Id: tlmgr.pl 36997 2015-04-22 00:21:41Z preining $
+# $Id: tlmgr.pl 37011 2015-04-22 23:10:04Z preining $
#
# Copyright 2008-2015 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
-my $svnrev = '$Revision: 36997 $';
-my $datrev = '$Date: 2015-04-22 02:21:41 +0200 (Wed, 22 Apr 2015) $';
+my $svnrev = '$Revision: 37011 $';
+my $datrev = '$Date: 2015-04-23 01:10:04 +0200 (Thu, 23 Apr 2015) $';
my $tlmgrrevision;
my $prg;
if ($svnrev =~ m/: ([0-9]+) /) {
@@ -26,6 +26,14 @@ our $packagelogged;
our $tlmgr_config_file;
our $pinfile;
our $action; # for the pod2usage -sections call
+our %opts;
+
+END {
+ if ($opts{"pause"}) {
+ print "Press Enter to exit the program.\n";
+ <STDIN>;
+ }
+}
BEGIN {
$^W = 1;
@@ -116,14 +124,223 @@ our $FLAG_REINSTALL = "I";
our $common_fmtutil_args =
"--no-error-if-no-engine=$TeXLive::TLConfig::PartialEngineSupport";
+# return flags for error handling
+#
+# all fine
+our $F_OK = 0;
+#
+# some warnings, but we still try to run post actions
+our $F_WARNING = 1;
+#
+# error, terminating
+our $F_ERROR = 2;
+#
+# all fine, but no need to run post actions
+our $F_NOPOSTACTION = 4;
+
# option variables
$::gui_mode = 0;
$::machinereadable = 0;
-our %opts;
+my %globaloptions = (
+ "gui" => 1,
+ "gui-lang" => "=s",
+ "debug-translation" => 1,
+ "location|repository|repo" => "=s",
+ "machine-readable" => 1,
+ "package-logfile" => "=s",
+ "persistent-downloads" => "!",
+ "no-execute-actions" => 1,
+ "pin-file" => "=s",
+ "pause" => 1,
+ "print-platform|print-arch" => 1,
+ "version" => 1,
+ "help" => 1,
+ "h|?" => 1);
+
+my %action_specification = (
+ '_include_tlpobj' => {
+ "run-post" => 0,
+ "function" => \&action_include_tlpobj
+ },
+ "backup" => {
+ "options" => {
+ "backupdir" => "=s",
+ "clean" => ":-99",
+ "all" => 1,
+ "dry-run|n" => 1
+ },
+ "run-post" => 1,
+ "function" => \&action_backup
+ },
+ "candidates" => {
+ "run-post" => 0,
+ "function" => \&action_candidates
+ },
+ "check" => {
+ "options" => { "use-svn" => 1 },
+ "run-post" => 1,
+ "function" => \&action_check
+ },
+ "conf" => {
+ "options" => {
+ "conffile" => "=s",
+ "delete" => 1,
+ },
+ "run-post" => 0,
+ "function" => \&action_conf
+ },
+ "dump-tlpdb" => {
+ "options" => { "local" => 1, remote => 1 },
+ "run-post" => 0,
+ "function" => \&action_dumptlpdb
+ },
+ "generate" => {
+ "options" => {
+ "localcfg" => "=s",
+ "dest" => "=s",
+ "rebuild-sys" => 1
+ },
+ "run-post" => 1,
+ "function" => \&action_generate
+ },
+ "get-mirror" => {
+ "run-post" => 0,
+ "function" => \&action_get_mirror
+ },
+ "gui" => {
+ "options" => { "load" => 1 },
+ "run-post" => 1,
+ "function" => \&action_gui
+ },
+ "info" => {
+ "options" => { "list" => 1, "only-installed" => 1 },
+ "run-post" => 0,
+ "function" => \&action_info
+ },
+ "init-usertree" => {
+ "run-post" => 0,
+ "function" => \&action_init_usertree
+ },
+ "install" => {
+ "options" => {
+ "no-depends" => 1,
+ "no-depends-at-all" => 1,
+ "file" => 1,
+ "reinstall" => 1,
+ "force" => 1,
+ "dry-run|n" => 1,
+ "with-doc" => 1,
+ "with-src" => 1,
+ },
+ "run-post" => 1,
+ "function" => \&action_install
+ },
+ "option" => {
+ "run-post" => 1,
+ "function" => \&action_option
+ },
+ "paper" => {
+ "options" => { "list" => 1 },
+ "run-post" => 1,
+ "function" => \&action_paper
+ },
+ "path" => {
+ "options" => { "w32mode" => "=s" },
+ "run-post" => 0,
+ "function" => \&action_path
+ },
+ "pinning" => {
+ "options" => { "all" => 1 },
+ "run-post" => 1,
+ "function" => \&action_pinning
+ },
+ "platform" => {
+ "options" => { "dry-run|n" => 1 },
+ "run-post" => 1,
+ "function" => \&action_platform
+ },
+ "postaction" => {
+ "options" => {
+ "w32mode" => "=s",
+ "all" => 1,
+ "fileassocmode" => "=i"
+ },
+ "run-post" => 0,
+ "function" => \&action_postaction
+ },
+ "recreate-tlpdb" => {
+ "options" => { "platform|arch" => "=s" },
+ "run-post" => 0,
+ "function" => \&action_recreate_tlpdb
+ },
+ "remove" => {
+ "options" => {
+ "no-depends" => 1,
+ "no-depends-at-all" => 1,
+ "force" => 1,
+ "dry-run|n" => 1
+ },
+ "run-post" => 1,
+ "function" => \&action_remove
+ },
+ repository => {
+ "options" => { "with-platforms" => 1 },
+ "run-post" => 1,
+ "function" => \&action_repository
+ },
+ "restore" => {
+ "options" => {
+ "backupdir" => "=s",
+ "dry-run|n" => 1,
+ "all" => 1,
+ "force" => 1
+ },
+ "run-post" => 1,
+ "function" => \&action_restore
+ },
+ "search" => {
+ "options" => {
+ "global" => 1,
+ "word" => 1,
+ "file" => 1,
+ "all" => 1,
+ },
+ "run-post" => 1,
+ "function" => \&action_search
+ },
+ "uninstall" => {
+ "options" => { "force" => 1 },
+ "run-post" => 0,
+ "function" => \&action_uninstall
+ },
+ "update" => {
+ "options" => {
+ "no-depends" => 1,
+ "no-depends-at-all" => 1,
+ "all" => 1,
+ "self" => 1,
+ "list" => 1,
+ "no-auto-remove" => 1,
+ "no-auto-install" => 1,
+ "reinstall-forcibly-removed" => 1,
+ "force" => 1,
+ "backupdir" => "=s",
+ "backup" => 1,
+ "exclude" => "=s@",
+ "dry-run|n" => 1
+ },
+ "run-post" => 1,
+ "function" => \&action_update
+ },
+ "version" => { }, # handled separately
+);
main() if $ismain;
+#####################################################################
+
+
sub main {
my %options; # TL options from local tlpdb
@@ -146,75 +363,6 @@ sub main {
"version" => 1,
);
- my %actionoptions = (
- "backup" => { "all" => 1,
- "backupdir" => "=s",
- "clean" => ":-99",
- "dry-run|n" => 1 },
- "candidates" => { },
- "check" => { "use-svn" => 1 },
- "conf" => { "conffile" => "=s",
- "delete" => 1 },
- "dump-tlpdb" => { "local" => 1,
- "remote" => 1 },
- "generate" => { "dest" => "=s",
- "localcfg" => "=s",
- "rebuild-sys" => 1 },
- "get-mirror" => { },
- "gui" => { "load" => 1 },
- "help" => { },
- "info" => { "list" => 1,
- "only-installed" => 1 },
- "init-usertree" => { },
- "install" => { "dry-run|n" => 1,
- "file" => 1,
- "force" => 1,
- "with-doc" => 1,
- "with-src" => 1,
- "no-depends" => 1,
- "no-depends-at-all" => 1,
- "reinstall" => 1},
- "option" => { },
- "paper" => { "list" => 1 },
- "path" => { "w32mode" => "=s" },
- "pinning" => { "all" => 1 },
- "platform" => { "dry-run|n" => 1 },
- "postaction" => { "all" => 1,
- "fileassocmode" => "=i",
- "w32mode" => "=s"},
- "recreate-tlpdb"=> { "platform|arch" => "=s" },
- "remove" => { "dry-run|n" => 1,
- "force" => 1,
- "no-depends" => 1,
- "no-depends-at-all" => 1 },
- "repository" => { "with-platforms" => 1 },
- "restore" => { "all" => 1,
- "backupdir" => "=s",
- "dry-run|n" => 1,
- "force" => 1, },
- "search" => { "all" => 1,
- "file" => 1,
- "global" => 1,
- "word" => 1 },
- "repository" => { },
- "uninstall" => { "force" => 1 },
- "update" => { "all" => 1,
- "backup" => 1,
- "backupdir" => "=s",
- "dry-run|n" => 1,
- "exclude" => "=s@",
- "force" => 1,
- "list" => 1,
- "no-auto-remove" => 1,
- "no-auto-install" => 1,
- "no-depends" => 1,
- "no-depends-at-all" => 1,
- "reinstall-forcibly-removed" => 1,
- "self" => 1 },
- "version" => { },
- "_include_tlpobj" => { },
- );
-
my %optarg;
for my $k (keys %globaloptions) {
if ($globaloptions{$k} eq "1") {
@@ -223,12 +371,15 @@ sub main {
$optarg{"$k" . $globaloptions{$k}} = 1;
}
}
- for my $v (values %actionoptions) {
- for my $k (keys %$v) {
- if ($v->{$k} eq "1") {
- $optarg{$k} = 1;
- } else {
- $optarg{"$k" . $v->{$k}} = 1;
+ for my $v (values %action_specification) {
+ if (defined($v->{'options'})) {
+ my %opts = %{$v->{'options'}};
+ for my $k (keys %opts) {
+ if ($opts{$k} eq "1") {
+ $optarg{$k} = 1;
+ } else {
+ $optarg{"$k" . $opts{$k}} = 1;
+ }
}
}
}
@@ -256,6 +407,7 @@ sub main {
$action = "";
}
}
+ $action = lc($action);
$action = "platform" if ($action eq "arch");
@@ -267,14 +419,14 @@ sub main {
if ($opts{"version"} || (defined $action && $action eq "version")) {
info(give_version());
- finish(0);
+ exit(0);
}
- if (defined($action) && ($action =~ m/^help/i)) {
+ if (defined($action) && $action eq "help") {
$opts{"help"} = 1;
}
- if (defined($action) && ($action =~ m/^print-platform$/i)) {
+ if (defined($action) && $action eq "print-platform") {
print TeXLive::TLUtils::platform(), "\n";
exit 0;
}
@@ -297,7 +449,7 @@ sub main {
# now $action should be part of %actionoptions, otherwise this is
# an error
- if (defined($action) && $action && !exists $actionoptions{$action}) {
+ if (defined($action) && $action && !exists $action_specification{$action}) {
die "$prg: unknown action: $action; try --help if you need it.\n";
}
@@ -357,7 +509,9 @@ sub main {
tlmgr revision $tlmgrrevision
usage: tlmgr OPTION... ACTION ARGUMENT...
where ACTION is one of:\n";
- for my $k (sort keys %actionoptions) {
+ for my $k (sort keys %action_specification) {
+ # don't print internal options
+ next if ($k =~ m/^_/);
print " $k\n";
}
print "\nUse\n tlmgr ACTION --help
@@ -375,11 +529,18 @@ for the full story.\n";
tlwarn("$prg: --machine-readable output not supported for $action\n");
}
+ #
+ # bail out of it is unknown action
+ if (!defined($action_specification{$action})) {
+ tlwarn("$prg: action unknown: $action\n");
+ exit ($F_ERROR);
+ }
+
# check on supported arguments
#
my %suppargs;
- %suppargs = %{$actionoptions{$action}}
- if defined($actionoptions{$action});
+ %suppargs = %{$action_specification{$action}{'options'}}
+ if defined($action_specification{$action}{'options'});
my @notvalidargs;
for my $k (keys %opts) {
my @allargs = keys %suppargs;
@@ -473,9 +634,14 @@ for the full story.\n";
}
}
- execute_action($action, @ARGV);
+ my $ret = execute_action($action, @ARGV);
- # end of main program.
+ if ($ret & $F_ERROR) {
+ tlwarn("tlmgr: an error has occurred. See above messages. Exiting.\n");
+ }
+
+ # end of main program, returns also error codes
+ exit ($ret);
} # end main
@@ -517,112 +683,39 @@ sub execute_action {
# actions which shouldn't have any lasting effects, such as search or
# list, end by calling finish(0), which skips postinstall actions.
- if ($action =~ m/^_include_tlpobj$/) {
- # this is an internal function that should not be used outside
- init_local_db();
- for my $f (@ARGV) {
- my $tlpobj = TeXLive::TLPOBJ->new;
- $tlpobj->from_file($f);
- # we now have to check whether that is a .doc or .src package, so shipping
- # src or doc files from a different package.
- # We should have that package already installed ...
- my $pkg = $tlpobj->name;
- if ($pkg =~ m/^(.*)\.(source|doc)$/) {
- # got a .src or .doc package
- my $type = $2;
- my $mothership = $1;
- my $mothertlp = $localtlpdb->get_package($mothership);
- if (!defined($mothertlp)) {
- tlwarn("We are trying to add ${type} files to a nonexistent package $mothership!\n");
- tlwarn("Trying to continue!\n");
- # the best we can do is rename that package to $mothername and add it!
- $tlpobj->name($mothership);
- # add the src/docfiles tlpobj under the mothership name
- $localtlpdb->add_tlpobj($tlpobj);
- } else {
- if ($type eq "source") {
- $mothertlp->srcfiles($tlpobj->srcfiles);
- $mothertlp->srcsize($tlpobj->srcsize);
- } else {
- # must be "doc"
- $mothertlp->docfiles($tlpobj->docfiles);
- $mothertlp->docsize($tlpobj->docsize);
- }
- # that make sure that the original entry is overwritten
- $localtlpdb->add_tlpobj($mothertlp);
- }
- } else {
- # completely normal package, just add it
- $localtlpdb->add_tlpobj($tlpobj);
- }
- $localtlpdb->save;
+ if (!defined($action_specification{$action})) {
+ tlwarn ("$prg: unknown action: $action; try --help if you need it.\n");
+ return ($F_ERROR);
+ }
+
+ if (!defined($action_specification{$action}{"function"})) {
+ tlwarn ("$prg: action $action defined, but no way to execute it.\n");
+ return ($F_ERROR);
+ }
+
+ my $ret = $F_OK;
+ my $foo = &{$action_specification{$action}{"function"}}();
+ if (defined($foo)) {
+ if ($foo & $F_ERROR) {
+ # warnings etc are given at the highest level, i.e., in main
+ return($foo);
+ }
+ if ($foo & $F_WARNING) {
+ tlwarn("tlmgr: action $action returned a warning.\n");
+ $ret = $foo;
}
- finish(0);
- } elsif ($action =~ m/^get-mirror$/i) {
- my $loc = give_ctan_mirror();
- print "$loc\n";
- finish(0);
- } elsif ($action =~ m/^generate$/i) {
- action_generate();
- } elsif ($action =~ m/^gui$/i) {
- action_gui();
- } elsif ($action =~ m/^platform$/i) {
- action_platform();
- } elsif ($action =~ m/^option$/i) {
- action_option();
- finish(0);
- } elsif ($action =~ m/^repository$/i) {
- action_repository();
- finish(0);
- } elsif ($action =~ m/^pinning$/i) {
- action_pinning();
- finish(0);
- } elsif ($action =~ m/^candidates$/i) {
- action_candidates();
- finish(0);
- } elsif ($action =~ m/^check$/i) {
- action_check();
- } elsif ($action =~ m/^install$/i) {
- action_install();
- } elsif ($action =~ m/^update$/i) {
- action_update();
- } elsif ($action =~ m/^backup$/i) {
- action_backup();
- } elsif ($action =~ m/^restore$/i) {
- action_restore();
- } elsif ($action =~ m/^path$/i) {
- action_path();
- finish(0);
- } elsif ($action =~ m/^search$/i) {
- action_search();
- finish(0);
- } elsif ($action =~ m/^postaction$/i) {
- action_postaction();
- finish(0);
- } elsif ($action =~ m/^conf$/i) {
- action_conf();
- finish(0);
- } elsif ($action =~ m/^dump-tlpdb$/i) {
- action_dumptlpdb();
- finish(0);
- } elsif ($action =~ m/^info$/i) {
- action_info(@ARGV);
- finish(0);
- } elsif ($action =~ m/^init-usertree$/i) {
- action_init_usertree();
- finish(0);
- } elsif ($action =~ m/^remove$/i) {
- action_remove();
- } elsif ($action =~ /^paper$/) {
- action_paper();
- } elsif ($action =~ m/^uninstall$/i) {
- action_uninstall();
- finish(0);
- } elsif ($action =~ m/^recreate-tlpdb$/i) {
- action_recreate_tlpdb();
- finish(0);
} else {
- die "$prg: unknown action $action; try --help if you need it.\n";
+ $ret = $F_OK;
+ tlwarn("tlmgr: didn't get return value from action $action, assuming ok.\n");
+ }
+ my $run_post = 1;
+ if ($ret & $F_NOPOSTACTION) {
+ # clear the postaction bit
+ $ret ^= $F_NOPOSTACTION;
+ $run_post = 0;
+ }
+ if (!$action_specification{$action}{"run-post"}) {
+ $run_post = 0;
}
# close the special log file
@@ -631,13 +724,12 @@ sub execute_action {
close(PACKAGELOG);
}
+ return ($ret) if (!$run_post);
+
# run external programs.
- my $error_count = &handle_execute_actions();
+ $ret |= &handle_execute_actions();
- # done, just in case there are 256 errors.
- # we return here, because finish might return if we are running
- # in the GUI, and we want to pass the error count on to the GUI
- return finish($error_count ? 1 : 0);
+ return $ret;
}
@@ -654,7 +746,7 @@ sub do_cmd_and_check
info("running $cmd ...\n");
my ($out, $ret);
if ($opts{"dry-run"}) {
- $ret = 0;
+ $ret = $F_OK;
$out = "";
} else {
($out, $ret) = TeXLive::TLUtils::run_cmd("$cmd 2>&1");
@@ -662,11 +754,12 @@ sub do_cmd_and_check
if ($ret == 0) {
info("done running $cmd.\n");
log("--output of $cmd:\n$out\n--end of output of $cmd.");
+ return ($F_OK);
} else {
info("\n");
tlwarn("$cmd failed (status $ret), output:\n$out\n");
+ return ($F_ERROR);
}
- return $ret;
}
# run external programs (mktexlsr, updmap-sys, etc.) as specified by the
@@ -848,10 +941,80 @@ sub handle_execute_actions {
$::regenerate_all_formats = 0;
}
- # undefine the global var, otherwise in GUI mode the actions are accumulating
+ # undefine the global var, otherwise in GUI mode the actions
+ # are accumulating
undef %::execute_actions;
- return $errors;
+ if ($errors > 0) {
+ # should we return warning here?
+ return $F_ERROR;
+ } else {
+ return $F_OK;
+ }
+}
+
+
+# GET_MIRROR
+#
+# just return a mirror
+sub action_get_mirror {
+ my $loc = give_ctan_mirror();
+ print "$loc\n";
+ return ($F_OK | $F_NOPOSTACTION);
+}
+
+#
+# includes a .tlpobj in the db, also searchers for sub-tlpobj
+# for doc and source files
+#
+
+# _INCLUDE_TLPOBJ
+#
+# includes a .tlpobj in the db, also searchers for sub-tlpobj
+# for doc and source files
+#
+sub action_include_tlpobj {
+ # this is an internal function that should not be used outside
+ init_local_db();
+ for my $f (@ARGV) {
+ my $tlpobj = TeXLive::TLPOBJ->new;
+ $tlpobj->from_file($f);
+ # we now have to check whether that is a .doc or .src package, so shipping
+ # src or doc files from a different package.
+ # We should have that package already installed ...
+ my $pkg = $tlpobj->name;
+ if ($pkg =~ m/^(.*)\.(source|doc)$/) {
+ # got a .src or .doc package
+ my $type = $2;
+ my $mothership = $1;
+ my $mothertlp = $localtlpdb->get_package($mothership);
+ if (!defined($mothertlp)) {
+ tlwarn("We are trying to add ${type} files to a nonexistent package $mothership!\n");
+ tlwarn("Trying to continue!\n");
+ # the best we can do is rename that package to $mothername and add it!
+ $tlpobj->name($mothership);
+ # add the src/docfiles tlpobj under the mothership name
+ $localtlpdb->add_tlpobj($tlpobj);
+ } else {
+ if ($type eq "source") {
+ $mothertlp->srcfiles($tlpobj->srcfiles);
+ $mothertlp->srcsize($tlpobj->srcsize);
+ } else {
+ # must be "doc"
+ $mothertlp->docfiles($tlpobj->docfiles);
+ $mothertlp->docsize($tlpobj->docsize);
+ }
+ # that make sure that the original entry is overwritten
+ $localtlpdb->add_tlpobj($mothertlp);
+ }
+ } else {
+ # completely normal package, just add it
+ $localtlpdb->add_tlpobj($tlpobj);
+ }
+ $localtlpdb->save;
+ }
+ # no error checking here for now
+ return ($F_OK);
}
@@ -876,6 +1039,7 @@ sub handle_execute_actions {
# account
#
sub action_remove {
+ my $ret = $F_OK;
# we do the following:
# - (not implemented) order collections such that those depending on
# other collections are first removed, and then those which only
@@ -895,7 +1059,7 @@ sub action_remove {
my %already_removed;
my @more_removal;
init_local_db();
- return if !check_on_writable();
+ return($F_ERROR) if !check_on_writable();
info("$prg remove: dry run, no changes will be made\n") if $opts{"dry-run"};
my @packs = @ARGV;
#
@@ -940,6 +1104,7 @@ sub action_remove {
delete($packs{$p});
tlwarn("$prg: not removing $p, needed by " .
join(" ", @needed) . "\n");
+ $ret |= $F_WARNING;
}
} else {
delete($packs{$p});
@@ -951,6 +1116,7 @@ sub action_remove {
next if defined($already_removed{$pkg});
if (!defined($tlp)) {
info("$pkg: package not present, cannot remove\n");
+ $ret |= $F_WARNING;
} else {
# in the first round we only remove collections, nothing else
# but removing collections will remove all dependencies, too
@@ -991,7 +1157,7 @@ sub action_remove {
}
if ($opts{"dry-run"}) {
# stop here, don't do any postinstall actions
- return;
+ return ($ret | $F_NOPOSTACTION);
} else {
$localtlpdb->save;
my @foo = sort keys %already_removed;
@@ -1001,6 +1167,7 @@ sub action_remove {
info("$prg: no packages removed.\n");
}
}
+ return ($ret);
}
@@ -1028,17 +1195,19 @@ sub action_paper {
if $newpaper; # complain if they tried to set, too.
tlwarn("$prg: please specify a program before paper --list, ",
"as in: tlmgr pdftex paper --list\n");
+ return($F_ERROR)
} elsif (!defined($newpaper)) { # tlmgr paper => show all current sizes.
- TeXLive::TLPaper::paper_all($texmfconfig,undef);
+ return TeXLive::TLPaper::paper_all($texmfconfig,undef);
} elsif ($newpaper !~ /^(a4|letter)$/) { # tlmgr paper junk => complain.
$newpaper = "the empty string" if !defined($newpaper);
tlwarn("$prg: expected `a4' or `letter' after paper, not $newpaper\n");
+ return($F_ERROR);
} else { # tlmgr paper {a4|letter} => do it.
- return if !check_on_writable();
- TeXLive::TLPaper::paper_all($texmfconfig,$newpaper);
+ return ($F_ERROR) if !check_on_writable();
+ return (TeXLive::TLPaper::paper_all($texmfconfig,$newpaper));
}
} else { # program-specific paper
@@ -1047,16 +1216,18 @@ sub action_paper {
if (!defined($arg) || $arg ne "paper") {
$arg = "the empty string." if ! $arg;
tlwarn("$prg: expected `paper' after $prog, not $arg\n");
- return;
+ return ($F_ERROR);
}
# the do_paper progs check for the argument --list, so if given
# restore it to the cmd line.
if (@ARGV) {
- return if !check_on_writable();
+ return ($F_ERROR) if !check_on_writable();
}
unshift(@ARGV, "--list") if $opts{"list"};
- TeXLive::TLPaper::do_paper($prog,$texmfconfig,@ARGV);
+ return(TeXLive::TLPaper::do_paper($prog,$texmfconfig,@ARGV));
}
+ # we should not come here anyway
+ return($F_OK);
}
@@ -1071,7 +1242,7 @@ sub action_path {
if (!defined($what) || ($what !~ m/^(add|remove)$/i)) {
$what = "" if ! $what;
tlwarn("$prg: action path requires add or remove, not: $what\n");
- return;
+ return ($F_ERROR);
}
init_local_db();
my $winadminmode = 0;
@@ -1102,7 +1273,7 @@ sub action_path {
if ($winadminmode) {
tlwarn("The TLPDB specifies system wide path adjustments\nbut you don't have admin privileges.\nFor user path adjustment please use\n\t--w32mode user\n");
# and do nothing
- return;
+ return ($F_ERROR);
}
}
} else {
@@ -1116,7 +1287,7 @@ sub action_path {
$winadminmode = 1;
} else {
tlwarn("Unknown --w32admin mode: $opts{w32mode}, should be 'admin' or 'user'\n");
- return;
+ return ($F_ERROR);
}
} else {
# we are non-admin
@@ -1124,22 +1295,23 @@ sub action_path {
$winadminmode = 0;
} elsif ($opts{"w32mode"} eq "admin") {
tlwarn("You don't have the privileges to work in --w32mode admin\n");
- return;
+ return ($F_ERROR);
} else {
tlwarn("Unknown --w32admin mode: $opts{w32mode}, should be 'admin' or 'user'\n");
- return;
+ return ($F_ERROR);
}
}
}
}
+ my $ret = $F_OK;
if ($what =~ m/^add$/i) {
if (win32()) {
- TeXLive::TLUtils::w32_add_to_path(
+ $ret |= TeXLive::TLUtils::w32_add_to_path(
$localtlpdb->root . "/bin/win32",
$winadminmode);
- TeXLive::TLWinGoo::broadcast_env();
+ $ret |= TeXLive::TLWinGoo::broadcast_env();
} else {
- TeXLive::TLUtils::add_symlinks($localtlpdb->root,
+ $ret |= TeXLive::TLUtils::add_symlinks($localtlpdb->root,
$localtlpdb->platform(),
$localtlpdb->option("sys_bin"),
$localtlpdb->option("sys_man"),
@@ -1147,13 +1319,13 @@ sub action_path {
}
} elsif ($what =~ m/^remove$/i) {
if (win32()) {
- TeXLive::TLUtils::w32_remove_from_path(
+ $ret |= TeXLive::TLUtils::w32_remove_from_path(
$localtlpdb->root . "/bin/win32",
$winadminmode);
- TeXLive::TLWinGoo::broadcast_env();
+ $ret |= TeXLive::TLWinGoo::broadcast_env();
} else {
# remove symlinks
- TeXLive::TLUtils::remove_symlinks($localtlpdb->root,
+ $ret |= TeXLive::TLUtils::remove_symlinks($localtlpdb->root,
$localtlpdb->platform(),
$localtlpdb->option("sys_bin"),
$localtlpdb->option("sys_man"),
@@ -1161,9 +1333,12 @@ sub action_path {
}
} else {
tlwarn("\n$prg: Should not happen, action_path what=$what\n");
- exit 1;
+ return ($F_ERROR);
}
- return;
+ # we should not need to run any post actions here, since
+ # that changes only integrations, but no rebuild of formats etc etc
+ # is needed
+ return ($ret | $F_NOPOSTACTION);
}
# DUMP TLPDB
@@ -1187,10 +1362,11 @@ sub action_dumptlpdb {
} else {
tlwarn("tlmgr dump-tlpdb: need exactly one of --local and --remote.\n");
+ return ($F_ERROR);
}
$::machinereadable = $savemr;
- return;
+ return ($F_OK | $F_NOPOSTACTION);
}
# INFO
@@ -1198,6 +1374,7 @@ sub action_dumptlpdb {
sub action_info {
init_local_db();
my ($what,@todo) = @ARGV;
+ my $ret = $F_OK | $F_NOPOSTACTION;
#
# tlmgr info
# tlmgr info collection
@@ -1206,7 +1383,7 @@ sub action_info {
# a short list
if (!defined($what) || ($what =~ m/^(collections|schemes)$/i)) {
show_list_of_packages($what);
- return;
+ return ($F_OK | $F_NOPOSTACTION);
}
# we are still here, so $what is defined and neither collection nor scheme,
# so assume the arguments are package names
@@ -1223,10 +1400,12 @@ sub action_info {
if (defined($tag)) {
if (!$remotetlpdb->is_virtual) {
tlwarn("$prg: specifying implicit tags is not allowed for non-virtual databases!\n");
+ $ret |= $F_WARNING;
next;
} else {
if (!$remotetlpdb->is_repository($tag)) {
tlwarn("$prg: no such repository tag defined: $tag\n");
+ $ret |= $F_WARNING;
next;
}
}
@@ -1237,6 +1416,7 @@ sub action_info {
# we already searched for the package in a specific tag, don't retry
# all candidates!
tlwarn("$prg: Cannot find package $pkg in repository $tag\n");
+ $ret |= $F_WARNING;
next;
}
if ($remotetlpdb->is_virtual) {
@@ -1249,6 +1429,7 @@ sub action_info {
my $first = shift @cand;
if (defined($first)) {
tlwarn("strange, we have a first candidate but no tlp: $pkg\n");
+ $ret |= $F_WARNING;
next;
}
# already shifted away the first element
@@ -1263,7 +1444,7 @@ sub action_info {
my ($t,$r) = split(/\//, $a, 2);
push @aaa, "$pkg" . '@' . $t;
}
- action_info(@aaa);
+ $ret |= action_info(@aaa);
next;
} else {
tlwarn("strange, package listed but no residual candidates: $pkg\n");
@@ -1271,10 +1452,12 @@ sub action_info {
}
} else {
tlwarn("strange, package listed but no candidates: $pkg\n");
+ $ret |= $F_WARNING;
next;
}
}
tlwarn("$prg: cannot find package $pkg\n");
+ $ret |= $F_WARNING;
next;
}
# we want to also show the source if it is known
@@ -1344,6 +1527,7 @@ sub action_info {
my $atlp = $tlpdb->get_package($tlp->name . ".$a");
if (!$atlp) {
tlwarn("$prg: cannot find depending package" . $tlp->name . ".$a\n");
+ $ret |= $F_WARNING;
next;
}
my %abinsz = %{$atlp->binsize};
@@ -1382,6 +1566,7 @@ sub action_info {
my $foo = $tlpdb->get_package($d);
if (!$foo) {
tlwarn ("\nShould not happen, no dependent package $d\n");
+ $ret |= $F_WARNING;
next;
}
if ($d ne $pkg) {
@@ -1417,7 +1602,7 @@ sub action_info {
}
print "\n";
}
- return;
+ return ($ret);
}
@@ -1425,7 +1610,7 @@ sub action_info {
#
sub action_search {
my ($r) = @ARGV;
- my $ret = "";
+ my $ret = $F_OK | $F_NOPOSTACTION;
my $tlpdb;
# check the arguments
my $search_type_nr = 0;
@@ -1433,12 +1618,12 @@ sub action_search {
$search_type_nr++ if $opts{"all"};
if ($search_type_nr > 1) {
tlwarn("$prg: please specify only one thing to search for\n");
- return;
+ return ($F_ERROR);
}
#
if (!defined($r) || !$r) {
tlwarn("$prg: nothing to search for.\n");
- return;
+ return ($F_ERROR);
}
init_local_db();
@@ -1477,7 +1662,7 @@ sub action_search {
}
}
print $ret;
- return;
+ return ($F_OK | $F_NOPOSTACTION);
}
@@ -1538,7 +1723,7 @@ sub restore_one_package {
my $restore_file = "$bd/${pkg}.r${rev}.tar.xz";
if (! -r $restore_file) {
tlwarn("Cannot read $restore_file, no action taken\n");
- return;
+ return ($F_ERROR);
}
$localtlpdb->remove_package($pkg);
TeXLive::TLPDB->_install_package($restore_file , 0, [] ,$localtlpdb);
@@ -1550,6 +1735,9 @@ sub restore_one_package {
TeXLive::TLUtils::announce_execute_actions("enable",
$localtlpdb->get_package($pkg));
$localtlpdb->save;
+ # TODO_ERROCHECKING we should check the return values of the
+ # various calls above
+ return ($F_OK);
}
sub check_backupdir_selection {
@@ -1561,7 +1749,7 @@ sub check_backupdir_selection {
$warntext .= "$prg: backupdir argument\n";
$warntext .= " $opts{'backupdir'}\n";
$warntext .= "is not a directory.\n";
- return (0, $warntext);
+ return ($F_ERROR, $warntext);
}
} else {
# no argument, check for presence in TLPDB
@@ -1577,10 +1765,10 @@ sub check_backupdir_selection {
$warntext = "$prg: backupdir as set in tlpdb\n";
$warntext .= " $opts{'backupdir'}\n";
$warntext .= "is not a directory.\n";
- return (0, $warntext);
+ return ($F_ERROR, $warntext);
}
}
- return 1;
+ return $F_OK;
}
sub action_restore {
@@ -1596,11 +1784,10 @@ sub action_restore {
{
my ($a, $b) = check_backupdir_selection();
- if (!$a) {
+ if ($a & $F_ERROR) {
# in all these cases we want to terminate in the non-gui mode
tlwarn($b);
- tlwarn("$prg: Terminating.\n");
- exit 1;
+ return ($F_ERROR);
}
}
info("$prg restore: dry run, no changes will be made\n") if $opts{"dry-run"};
@@ -1611,17 +1798,17 @@ sub action_restore {
if (defined($pkg) && $opts{"all"}) {
tlwarn("$prg: Specify either --all or individual package(s) ($pkg)\n");
tlwarn("$prg: to restore, not both. Terminating.\n");
- exit 1;
+ return ($F_ERROR);
}
if ($opts{"all"}) {
init_local_db(1);
- return if !check_on_writable();
+ return ($F_ERROR) if !check_on_writable();
if (!$opts{"force"}) {
print "Do you really want to restore all packages to the latest revision found in\n\t$opts{'backupdir'}\n===> (y/N): ";
my $yesno = <STDIN>;
if ($yesno !~ m/^y(es)?$/i) {
print "Ok, cancelling the restore!\n";
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
}
}
for my $p (sort keys %backups) {
@@ -1631,11 +1818,12 @@ sub action_restore {
if (!$opts{"dry-run"}) {
# first remove the package, then reinstall it
# this way we get rid of useless files
+ # TODO_ERRORCHECK needs check for return values!!
restore_one_package($p, $rev, $opts{"backupdir"});
}
}
# localtlpdb already saved, so we are finished
- return;
+ return ($F_OK);
}
#
# intermediate sub
@@ -1669,13 +1857,13 @@ sub action_restore {
} else {
print "No backups available in $opts{'backupdir'}\n";
}
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
}
if (!defined($rev)) {
print "Available backups for $pkg: ";
report_backup_revdate($pkg, %{$backups{$pkg}});
print "\n";
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
}
# we did arrive here, so we try to restore ...
if (defined($backups{$pkg}->{$rev})) {
@@ -1685,7 +1873,7 @@ sub action_restore {
my $yesno = <STDIN>;
if ($yesno !~ m/^y(es)?$/i) {
print "Ok, cancelling the restore!\n";
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
}
}
print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.xz\n";
@@ -1695,9 +1883,11 @@ sub action_restore {
# this way we get rid of useless files
restore_one_package($pkg, $rev, $opts{"backupdir"});
}
+ # TODO_ERRORCHECKING check return value of restore_one_package
+ return ($F_OK);
} else {
print "revision $rev for $pkg is not present in $opts{'backupdir'}\n";
- finish(1);
+ return ($F_ERROR);
}
}
@@ -1725,8 +1915,8 @@ sub action_backup {
my $tlpdb_option = $localtlpdb->option("autobackup");
if (!defined($tlpdb_option)) {
tlwarn ("--clean given without an argument, but no default clean\n");
- tlwarn ("mode specified in the tlpdb, terminating.\n");
- exit 1;
+ tlwarn ("mode specified in the tlpdb.\n");
+ return ($F_ERROR);
}
$opts{"clean"} = $tlpdb_option;
}
@@ -1738,17 +1928,16 @@ sub action_backup {
} else {
tlwarn ("clean mode as specified on the command line or as given by default\n");
tlwarn ("must be an integer larger or equal than -1, terminating.\n");
- exit 1;
+ return($F_ERROR);
}
}
# check the backup dir argument
{
my ($a, $b) = check_backupdir_selection();
- if (!$a) {
+ if ($a & $F_ERROR) {
# in all these cases we want to terminate in the non-gui mode
tlwarn($b);
- tlwarn("$prg: Terminating.\n");
- exit 1;
+ return($F_ERROR);
}
}
@@ -1763,7 +1952,7 @@ sub action_backup {
for my $p (sort keys %backups) {
clear_old_backups ($p, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"});
}
- return 1;
+ return ($F_OK | $F_NOPOSTACTION);
}
# in case we are not cleaning or cleaning only specific packages
@@ -1777,6 +1966,7 @@ sub action_backup {
}
if (!@todo) {
printf "tlmgr backup takes either a list of packages or --all\n";
+ return ($F_ERROR);
}
foreach my $pkg (@todo) {
if ($clean_mode) {
@@ -1791,6 +1981,8 @@ sub action_backup {
}
}
}
+ # TODO_ERRORCHECKING neets checking of the above
+ return ($F_OK);
}
# =====================================================================
@@ -2226,6 +2418,8 @@ sub upd_info {
}
sub action_update {
+ my $ret = $F_OK;
+
init_local_db(1);
$opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
@@ -2237,7 +2431,7 @@ sub action_update {
# other options just change the behaviour
if (!($opts{"list"} || @ARGV || $opts{"all"} || $opts{"self"})) {
tlwarn("tlmgr update: specify --list, --all, --self, or a list of package names.\n");
- return;
+ return ($F_ERROR);
}
init_tlmedia_or_die();
@@ -2249,7 +2443,7 @@ sub action_update {
}
if (!$opts{"list"}) {
- return if !check_on_writable();
+ return ($F_ERROR) if !check_on_writable();
}
# check for updates to tlmgr and die unless either --force or --list or --self
@@ -2266,12 +2460,7 @@ sub action_update {
} elsif ($opts{"list"}) {
# do not warn here
} else {
- if ($::gui_mode) {
- # return here and don't do any updates
- return;
- } else {
- die "$prg: Terminating; please read above warning.\n";
- }
+ return($F_ERROR);
}
}
@@ -2295,6 +2484,7 @@ sub action_update {
tlwarn ("Disabling auto backups.\n");
$localtlpdb->option("autobackup", 0);
$autobackup = 0;
+ $ret |= $F_WARNING;
}
}
}
@@ -2303,11 +2493,10 @@ sub action_update {
# we try to get the default from the tlpdb. If that doesn't work, exit.
if ($opts{"backup"}) {
my ($a, $b) = check_backupdir_selection();
- if (!$a) {
+ if ($a & $F_ERROR) {
# in all these cases we want to terminate in the non-gui mode
tlwarn($b);
- tlwarn("$prg: Terminating.\n");
- exit 1;
+ return ($F_ERROR);
}
}
@@ -2354,6 +2543,7 @@ sub action_update {
info("$prg: no updates for tlmgr present.\n");
} else {
tlwarn("tlmgr update: please specify a list of packages, --all, or --self.\n");
+ return ($F_ERROR);
}
}
@@ -2419,7 +2609,7 @@ sub action_update {
tlwarn("Conflicts have been found:\n");
for (@option_conflict_lines) { tlwarn(" $_"); }
tlwarn("Please resolve these conflicts!\n");
- exit 1;
+ return ($F_ERROR);
}
#
@@ -2476,6 +2666,7 @@ sub action_update {
my $mediatlp = $remotetlpdb->get_package($pkg);
if (!defined($mediatlp)) {
tlwarn("\nShould not happen: $pkg not found in $location\n");
+ $ret |= $F_WARNING;
next;
}
my $mediarev = $mediatlp->revision;
@@ -2583,6 +2774,8 @@ sub action_update {
# first save for each file in the currently installed packages
# to be updated the packages it is contained it (might be more!)
#
+ # TODO WHY WHY is there the next so that all the file move checks
+ # are actually disabled?!?!?!
for my $p (@updated, @removals) {
my $pkg = $localtlpdb->get_package($p);
tlwarn("Should not happen: $p not found in local tlpdb\n") if (!$pkg);
@@ -2781,6 +2974,7 @@ sub action_update {
if (!defined($tlp)) {
tlwarn("$prg: inconsistency on the server:\n");
tlwarn("$prg: tlp for package $pkg cannot be found, please report.\n");
+ $ret |= $F_WARNING;
next;
}
my $unwind_package;
@@ -2897,6 +3091,7 @@ sub action_update {
if ($s <= 0) {
tlwarn("\n$prg: Creation of backup container of $pkg failed.\n");
tlwarn("Continuing to update other packages, please retry...\n");
+ $ret |= $F_WARNING;
# we should try to update other packages at least
next;
}
@@ -2968,11 +3163,17 @@ sub action_update {
$localtlpdb->add_tlpobj($tlpobj);
$localtlpdb->save;
logpackage("restore: $pkg ($rev)");
+ $ret |= $F_WARNING;
tlwarn("Restoring old package state succeeded.\n");
} else {
logpackage("failed restore: $pkg ($rev)");
tlwarn("Restoring of old package did NOT succeed.\n");
tlwarn("Most likely repair: run tlmgr install $pkg and hope.\n");
+ # TODO_ERRORCHECKING
+ # should we return F_ERROR here??? If we would do this, then
+ # no postactions at all would run? Maybe better only to give
+ # a warning
+ $ret |= $F_WARNING;
}
unlink($unwind_package) if $remove_unwind_container;
}
@@ -2996,6 +3197,7 @@ sub action_update {
}
if (!defined($mediatlp)) {
tlwarn("\nShould not happen: $pkg not found in $location\n");
+ $ret |= $F_WARNING;
next;
}
my $mediarev = $mediatlp->revision;
@@ -3102,6 +3304,7 @@ sub action_update {
if ($bad_file) {
tlwarn("$prg: The file $k has disappeared from the critical" .
"package $pkg but is still present in @found_pkgs\n");
+ $ret |= $F_WARNING;
} else {
push @infra_files_to_be_removed, $k;
}
@@ -3151,6 +3354,7 @@ sub action_update {
\@infra_files_to_be_removed, @critical);
if ($ret) {
tlwarn ("$prg: Aborting infrastructure update.\n");
+ $ret |= $F_ERROR;
$restart_tlmgr = 0 if ($opts{"dry-run"});
}
}
@@ -3160,19 +3364,22 @@ sub action_update {
info ("Restarting tlmgr to complete update ...\n");
debug("restarting tlmgr @::SAVEDARGV\n");
exec("tlmgr", @::SAVEDARGV);
- die "cannot restart tlmgr, please retry update";
+ # we need warn here, otherwise perl gives warnings!
+ warn ("$prg: cannot restart tlmgr, please retry update\n");
+ return ($F_ERROR);
}
- # for --dry-run we cannot restart tlmgr (no way to fake successful infra update)
- # instead we call action_update() again and signal this by $opts{"dry-run"} = -1
+ # for --dry-run we cannot restart tlmgr (no way to fake successful
+ # infra update) instead we call action_update() again and signal this
+ # by $opts{"dry-run"} = -1
if ($opts{"dry-run"} && !$opts{"list"} && $restart_tlmgr) {
$opts{"self"} = 0;
$opts{"dry-run"} = -1;
$localtlpdb = undef;
$remotetlpdb = undef;
info ("Restarting tlmgr to complete update ...\n");
- action_update();
- return;
+ $ret |= action_update();
+ return ($ret);
}
# if a real update from default disk location didn't find anything,
@@ -3196,6 +3403,7 @@ To change the default for all future updates, run:
END_DISK_WARN
}
}
+ return ($ret);
}
@@ -3230,11 +3438,16 @@ END_DISK_WARN
#
sub action_install {
init_local_db(1);
- return if !check_on_writable();
+ my $ret = $F_OK;
+ return ($F_ERROR) if !check_on_writable();
# installation from a .tar.xz
if ($opts{"file"}) {
- return $localtlpdb->install_package_files(@ARGV);
+ if ($localtlpdb->install_package_files(@ARGV)) {
+ return ($ret);
+ } else {
+ return ($F_ERROR);
+ }
}
# if we are still here, we are installing from some repository
@@ -3251,7 +3464,7 @@ sub action_install {
} else {
if ($::gui_mode) {
# return here and don't do any updates
- return;
+ return ($F_ERROR);
} else {
die "$prg: Terminating; please see warning above!\n";
}
@@ -3319,6 +3532,7 @@ sub action_install {
($packs{$pkg} ? $packs{$pkg} : undef));
if (!defined($mediatlp)) {
tlwarn("$prg install: package $pkg not present in repository.\n");
+ $ret |= $F_WARNING;
next;
}
if (defined($localtlpdb->get_package($pkg))) {
@@ -3340,7 +3554,7 @@ sub action_install {
}
}
# return if there is nothing to install!
- return if (!@todo);
+ return ($ret) if (!@todo);
my $orig_do_src = $localtlpdb->option("install_srcfiles");
my $orig_do_doc = $localtlpdb->option("install_docfiles");
@@ -3419,13 +3633,14 @@ sub action_install {
if ($opts{"dry-run"}) {
# stop here, don't do any postinstall actions
- return(0);
+ return($ret | $F_NOPOSTACTION);
} else {
# reset option if --with-src argument was given
$localtlpdb->option("install_srcfiles", $orig_do_src) if $opts{'with-src'};
$localtlpdb->option("install_docfiles", $orig_do_doc) if $opts{'with-doc'};
$localtlpdb->save if ($opts{'with-src'} || $opts{'with-doc'});
}
+ return ($ret);
}
sub show_list_of_packages {
@@ -3739,25 +3954,25 @@ sub action_repository {
print "\n";
}
}
- return;
+ return ($F_OK);
}
if ($what eq "add") {
my $p = shift @ARGV;
if (!defined($p)) {
tlwarn("$prg: no repository given (to add)\n");
- return;
+ return ($F_ERROR);
}
# check if it is either url or absolute path
if (($p !~ m!^(http|ftp)://!i) &&
!File::Spec->file_name_is_absolute($p)) {
tlwarn("$prg: neither http/ftp URL nor absolute path, no action: $p\n");
- return;
+ return ($F_ERROR);
}
my $t = shift @ARGV;
$t = $p if (!defined($t));
if (defined($repos{$t})) {
tlwarn("$prg: repository or its tag already defined, no action: $p\n");
- return;
+ return ($F_ERROR);
}
# TODO more checks needed?
# if there was till now only *one* repository and that without
@@ -3780,13 +3995,13 @@ sub action_repository {
} else {
print "$prg: added repository with tag $t: $p\n";
}
- return;
+ return ($F_OK);
}
if ($what eq "remove") {
my $p = shift @ARGV;
if (!defined($p)) {
tlwarn("$prg: no repository given (to remove)\n");
- return;
+ return ($F_ERROR);
}
my $found = 0;
for my $k (keys %repos) {
@@ -3797,12 +4012,15 @@ sub action_repository {
}
if (!$found) {
tlwarn("$prg: repository not defined, cannot remove: $p\n");
+ return ($F_ERROR);
} else {
$localtlpdb->option("location", array_to_repository(%repos));
$localtlpdb->save;
print "$prg: removed repository: $p\n";
+ return ($F_OK);
}
- return;
+ # no reached
+ return ($F_OK);
}
if ($what eq "set") {
# TODO TODO
@@ -3810,18 +4028,18 @@ sub action_repository {
%repos = repository_to_array("@ARGV");
$localtlpdb->option("location", array_to_repository(%repos));
$localtlpdb->save;
- return;
+ return ($F_OK);
}
# we are still here, unknown command to repository
tlwarn("$prg: unknown subaction for tlmgr repository: $what\n");
- return;
+ return ($F_ERROR);
}
sub action_candidates {
my $what = shift @ARGV;
if (!defined($what)) {
tlwarn("$prg: candidates needs a package name as argument\n");
- return;
+ return ($F_ERROR);
}
init_local_db();
init_tlmedia_or_die();
@@ -3844,8 +4062,9 @@ sub action_candidates {
}
} else {
print "Package $what not found.\n";
+ return ($F_WARNING);
}
- return;
+ return ($F_OK);;
}
# OPTION
@@ -3854,6 +4073,7 @@ sub action_option {
my $what = shift @ARGV;
$what = "show" unless defined($what);
init_local_db();
+ my $ret = $F_OK;
if ($what =~ m/^show$/i) {
for my $o (keys %{$localtlpdb->options}) {
# ignore some things which are w32 specific
@@ -3872,6 +4092,7 @@ sub action_option {
}
} else {
tlwarn ("$prg: option $o not supported\n");
+ $ret |= $F_WARNING;
}
}
} elsif ($what =~ m/^showall$/i) {
@@ -3897,7 +4118,7 @@ sub action_option {
# the option argument matches the name
my $val = shift @ARGV;
if (defined($val)) {
- return if !check_on_writable();
+ return ($F_ERROR) if !check_on_writable();
# set new value
# here we have to care for some special cases
if ($what eq $TLPDBOptions{"location"}->[2]) {
@@ -3985,6 +4206,7 @@ sub action_option {
}
} else {
tlwarn ("Unknown type of option $opt: $TLPDBOptions{$opt}->[0]\n");
+ return ($F_ERROR);
}
}
$localtlpdb->save;
@@ -3996,6 +4218,7 @@ sub action_option {
close(TOFD);
} else {
tlwarn("Cannot save 00texlive.installation to $::maintree/tlpkg/tlpobj/00texlive.installation.tlpobj\n");
+ $ret |= $F_WARNING;
}
}
} else {
@@ -4012,9 +4235,10 @@ sub action_option {
}
if (!$found) {
tlwarn("$prg: option $what not supported!\n");
+ return ($F_ERROR);
}
}
- return;
+ return ($ret);
}
@@ -4051,7 +4275,7 @@ sub action_platform {
}
print "Already installed platforms are marked with (i)\n";
print "You can add new platforms with: tlmgr platform add ARCH1 ARCH2...\n";
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
} elsif ($what =~ m/^add$/i) {
return if !check_on_writable();
init_tlmedia_or_die();
@@ -4367,7 +4591,7 @@ Error message from creating MainWindow:
sub action_uninstall {
if (win32()) {
printf STDERR "Please use \"Add/Remove Programs\" from the Control Panel to removing TeX Live!\n";
- finish(1);
+ return ($F_ERROR);
}
return if !check_on_writable();
my $force = defined($opts{"force"}) ? $opts{"force"} : 0;
@@ -4377,7 +4601,7 @@ sub action_uninstall {
my $yesno = <STDIN>;
if ($yesno !~ m/^y(es)?$/i) {
print "Ok, cancelling the removal!\n";
- finish(0);
+ return ($F_OK | $F_NOPOSTACTION);
}
}
print ("Ok, removing the whole installation:\n");
@@ -4549,7 +4773,11 @@ sub action_check {
} else {
print "No idea how to check that: $what\n";
}
- finish($ret);
+ if ($ret) {
+ return ($F_ERROR);
+ } else {
+ return ($F_OK);
+ }
}
# check file coverage in both direction.
@@ -5342,9 +5570,10 @@ sub init_local_db {
if (!setup_programs("$Master/tlpkg/installer", $localtlpdb->platform)) {
tlwarn("Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n");
if (defined($should_i_die) && $should_i_die) {
- finish(1);
+ return ($F_ERROR);
} else {
tlwarn("Continuing anyway ...\n");
+ return ($F_WARNING);
}
}
# let cmd line options override the settings in localtlpdb
@@ -5677,11 +5906,6 @@ sub finish {
print "$prg: exiting unsuccessfully (status $ret).\n";
}
- if ($opts{"pause"}) {
- print "Press Enter to exit the program.\n";
- <STDIN>;
- }
-
if ($::gui_mode) {
return $ret;
} else {