Index: tlmgr2.pl =================================================================== --- tlmgr2.pl (revision 11641) +++ tlmgr2.pl (working copy) @@ -82,7 +82,7 @@ mkdirhier merge_into copy log debug)); use Cwd qw/abs_path/; use Pod::Usage; -use Getopt::Long qw(:config no_autoabbrev require_order); +use Getopt::Long qw(:config no_autoabbrev permute); use strict; require("papersize-setting.pl"); @@ -110,9 +110,6 @@ # stubs for setting paper sizes our %papersetting_subs; -# each action uses this. -my @getopt_configure_subopts = qw(no_pass_through permute); - # flags for machine readable form our $FLAG_REMOVE = "d"; our $FLAG_FORCIBLE_REMOVED = "f"; @@ -121,33 +118,94 @@ our $FLAG_AUTOINSTALL = "a"; # option variables -my $opt_location; -my $opt_help = 0; -my $opt_version = 0; -my $opt_gui = 0; -our $opt_gui_lang; -my $opt_packagelogfile; -my $opt_pause = 0; $::machinereadable = 0; +my %globaloptions = ( + "location" => "=s", + "gui" => 1, + "gui-lang" => "=s", + "package-logfiles" => "=s", + "machine-readable" => 1, + "version" => 1, + "pause" => 1, + "help|h|?" => 1); + +my %actionoptions = ( + "remove" => { "no-depends" => 1, + "no-depends-at-all" => 1, + "force" => 1, + "dry-run|n" => 1 }, + "show" => { "list" => 1 }, + "search" => { "global" => 1, + "file" => 1 }, + "restore" => { "backupdir" => "=s", + "dry-run|n" => 1, + "force" => 1 }, + "backup" => { "backupdir" => "=s", + "clean" => ":s", + "all" => 1, + "dry-run|n" => 1 }, + "update" => { "no-depends" => 1, + "no-depends-at-all" => 1, + "all" => 1, + "list" => 1, + "no-remove" => 1, + "force" => 1, + "backupdir" => "=s", + "backup" => 1, + "dry-run|n" => 1 }, + "install" => { "no-depends" => 1, + "no-depends-at-all" => 1, + "reinstall" => 1, + "force" => 1, + "dry-run|n" => 1 }, + "arch" => { "dry-run|n" => 1 }, + "generate" => { "localcfg" => "=s", + "dest" => "=s" }, + "uninstall"=> { "force" => 1 }, + "check" => { "use-svn" => 1 } + ); + +my %optarg; +for my $k (keys %globaloptions) { + if ($globaloptions{$k} eq "1") { + $optarg{$k} = 1; + } else { + $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; + } + } +} TeXLive::TLUtils::process_logging_options(); -GetOptions("location=s" => \$opt_location, - "gui" => \$opt_gui, - "gui-lang=s" => \$opt_gui_lang, - "package-logfile=s" => \$opt_packagelogfile, - # for machine readable we use a global variable so that - # the perl modules can check for that, too, more easily - "machine-readable" => \$::machinereadable, - "version" => \$opt_version, - "pause" => \$opt_pause, - "h|help|?" => \$opt_help) or pod2usage(2); +our %opts; + +GetOptions(\%opts, keys(%optarg)) or pod2usage(2); + +$::machinereadable = $opts{"machine-readable"} + if (defined($opts{"machine-readable"})); + my $action = shift; -if (!defined($action) && $opt_gui) { +if (!defined($action) && $opts{"gui"}) { $action = "gui"; } +ddebug("action = $action\n"); +for my $k (keys %opts) { + ddebug("$k => $opts{$k}\n"); +} +if (@ARGV) { + ddebug("arguments: @ARGV\n"); +} + sub give_version { if (!defined($::version_string)) { $::version_string = ""; @@ -165,23 +223,23 @@ } -if ($opt_version || (defined $action && $action eq "version")) { +if ($opts{"version"} || (defined $action && $action eq "version")) { info( give_version() ); finish(0); } if (defined($action) && ($action =~ m/^help/i)) { - $opt_help = 1; + $opts{"help"} = 1; } -if (!defined($action) && !$opt_help) { +if (!defined($action) && !$opts{"help"}) { die "$0: missing action; try --help if you need it.\n"; } # Often Windows will not have perldoc, but some Unix-based # installations may lack it also. We want to use it if we have it, to # get ASCII emphasis. -if ($opt_help) { +if ($opts{"help"}) { if (TeXLive::TLUtils::which("perldoc")) { pod2usage(-exitstatus => 0, -verbose => 2); } else { @@ -189,12 +247,47 @@ } } +# +# check on supported arguments +# +my %suppargs; +%suppargs = %{$actionoptions{$action}} + if defined($actionoptions{$action}); +my @notvalidargs; +for my $k (keys %opts) { + my $kk = $k; + if ($k eq "n" || $k eq "dry-run") { + $kk = "dry-run|n"; + } + if (!defined($suppargs{$kk})) { + push @notvalidargs, $k; + } +} +if (@notvalidargs) { + my $msg = + "The following arguments are not supported for the action $action:\n"; + for my $c (@notvalidargs) { + $msg .= " $c"; + } + $msg .= "\n"; + # here we should call pod2usage actually with the argument + # -verbose => 99 + # -sections => "ACTIONS/$action.*" + # to show the correct invocation of the action + if (TeXLive::TLUtils::which("perldoc")) { + pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1); + } else { + pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1, -noperldoc => 1); + } +} + # besides doing normal logging if -logfile is specified, we try to log # package related actions (install, remove, update) to # the package-log file TEXMFSYSVAR/web2c/tlmgr.log my $packagelogged = 0; # how many msgs we logged chomp (my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`); -my $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log"; +my $packagelogfile = $opts{"package-logfile"}; +$packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log"; # # Try to open the packagelog file, but do NOT die when that does not work if (!open(PACKAGELOG, ">>$packagelogfile")) { @@ -295,7 +388,7 @@ } elsif (($action eq "paper") || ($action eq "dvips") || ($action eq "xdvi") || ($action eq "pdftex") || ($action eq "dvipdfm") || ($action eq "dvipdfmx") || ($action eq "context")) { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } @ARGV = ( $action, @ARGV); @@ -485,7 +578,7 @@ # account # sub action_remove { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("remove"); } tlwarn("machine-readable output not supported for remove\n") @@ -506,20 +599,11 @@ # . remove the package # my %ret; - my $opt_nodepends = 0; - my $opt_reallynodepends = 0; - my $opt_force = 0; - my $opt_dry = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("no-depends" => \$opt_nodepends, - "no-depends-at-all" => \$opt_reallynodepends, - "force" => \$opt_force, - "n|dry-run" => \$opt_dry) or pod2usage(2); - $opt_nodepends = 1 if $opt_reallynodepends; + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my %already_removed; my @more_removal; init_local_db(); - info("remove: dry run, no changes will be made\n") if $opt_dry; + info("remove: dry run, no changes will be made\n") if $opts{"dry-run"}; my @packs = @ARGV; # # we have to be carefull not to remove too many packages. The idea is @@ -538,24 +622,24 @@ # cmd line, but it isn't because someone else asks for it), warn the # user that it is still needed # - # remove all .ARCH dependencies, too, unless $opt_reallynodepends - @packs = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @packs) unless $opt_reallynodepends; - # remove deps unless $opt_nodepends - @packs = $localtlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opt_nodepends; + # remove all .ARCH dependencies, too, unless $opts{"no-depends-at-all"} + @packs = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @packs) unless $opts{"no-depends-at-all"}; + # remove deps unless $opts{"no-depends"} + @packs = $localtlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; my %allpacks; for my $p ($localtlpdb->list_packages) { $allpacks{$p} = 1; } for my $p (@packs) { delete($allpacks{$p}); } my @neededpacks = $localtlpdb->expand_dependencies($localtlpdb, keys %allpacks); my %packs; my %origpacks; - my @origpacks = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opt_reallynodepends; + my @origpacks = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; for my $p (@origpacks) { $origpacks{$p} = 1; } for my $p (@packs) { $packs{$p} = 1; } for my $p (@neededpacks) { if (defined($origpacks{$p})) { # that package was asked for to be removed on the cmd line my @needed = $localtlpdb->needed_by($p); - if ($opt_force) { + if ($opts{"force"}) { info("tlmgr: $p is needed by " . join(" ", @needed) . "\n"); info("tlmgr: still removing it due to --force\n"); } else { @@ -581,7 +665,7 @@ if ($tlp->category eq "Collection") { my %foo; info ("remove $pkg\n"); - if ($opt_dry) { + if ($opts{"dry-run"}) { # we need to set $foo to something positive otherwise # the rest will not be run in dry_run mode $foo{'mktexlsr'} = 1; @@ -607,7 +691,7 @@ foreach my $pkg (sort @more_removal) { if (!defined($already_removed{$pkg})) { info ("remove $pkg\n"); - if (!$opt_dry) { + if (!$opts{"dry-run"}) { my %foo; merge_into(\%foo, &remove_package($pkg, $localtlpdb)); if (keys %foo) { @@ -619,7 +703,7 @@ } } } - if ($opt_dry) { + if ($opts{"dry-run"}) { # stop here, don't do any postinstall actions return; } else { @@ -642,7 +726,7 @@ # sub action_paper { my %ret; - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } tlwarn("machine-readable output not supported for paper\n") @@ -690,14 +774,11 @@ sub action_show { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } tlwarn("machine-readable output not supported for show\n") if $::machinereadble; - my $opt_list = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("list" => \$opt_list) or pod2usage(2); init_local_db(); my $tlmediatlpdb; foreach my $pkg (@ARGV) { @@ -734,7 +815,7 @@ print "Installed: ", ($installed ? "Yes" : "No"), "\n"; print "Revision: ", $tlp->revision, "\n" if ($installed); print "Collection: ", @colls, "\n" if (@colls); - if ($opt_list) { + if ($opts{"list"}) { print "Included files, by type:\n"; # if the package has a .ARCH dependency we also list the files for # those packages @@ -776,26 +857,21 @@ } sub action_search { - my $opt_global = 0; - my $opt_file = 0; my %ret; tlwarn("machine-readable output not supported for search\n") if $::machinereadble; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("global" => \$opt_global, - "file" => \$opt_file) or pod2usage(2); my $r = shift @ARGV; my $ret = ""; my $tlpdb; init_local_db(); - if ($opt_global) { + if ($opts{"global"}) { init_tlmedia(); $tlpdb = $tlmediasrc->tlpdb; } else { $tlpdb = $localtlpdb; } foreach my $pkg ($tlpdb->list_packages) { - if ($opt_file) { + if ($opts{"file"}) { my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files); if (@ret) { print "$pkg:\n"; @@ -829,47 +905,40 @@ # restores pkg to revision rev tlwarn("machine-readable output not supported for restore\n") if $::machinereadble; - my $opt_backupdir; - my $opt_force; - my $opt_dry = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("backupdir=s" => \$opt_backupdir, - "n|dry-run" => \$opt_dry, - "force" => \$opt_force) or pod2usage(2); my %ret; # check the backup dir argument - if ($opt_backupdir) { - my $ob = abs_path($opt_backupdir); - $ob && ($opt_backupdir = $ob); - if (! -d $opt_backupdir) { - tlwarn ("backupdir argument $opt_backupdir is not a directory.\n"); + if ($opts{"backupdir"}) { + my $ob = abs_path($opts{"backupdir"}); + $ob && ($opts{"backupdir"} = $ob); + if (! -d $opts{"backupdir"}) { + tlwarn ("backupdir argument $opts{'backupdir'} is not a directory.\n"); tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } } else { # no argument, check for presence in TLPDB - $opt_backupdir = $localtlpdb->option("backupdir"); - if (!$opt_backupdir) { + $opts{"backupdir"} = $localtlpdb->option("backupdir"); + if (!$opts{"backupdir"}) { tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } # we are stil here, there is something set in tlpdb - my $ob = abs_path($opt_backupdir); - $ob && ($opt_backupdir = $ob); - if (! -d $opt_backupdir) { - tlwarn ("backupdir as set in tlpdb $opt_backupdir is not a directory.\n"); + my $ob = abs_path($opts{"backupdir"}); + $ob && ($opts{"backupdir"} = $ob); + if (! -d $opts{"backupdir"}) { + tlwarn ("backupdir as set in tlpdb $opts{'backupdir'} is not a directory.\n"); tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } } - info("restore: dry run, no changes will be made\n") if $opt_dry; + info("restore: dry run, no changes will be made\n") if $opts{"dry"}; # initialize the hash(packages) of hash(revisions) my %backups; - opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!"; + opendir (DIR, $opts{"backupdir"}) || die "opendir($opts{'backupdir'}) failed: $!"; my @dirents = readdir (DIR); - closedir (DIR) || warn "closedir($opt_backupdir) failed: $!"; + closedir (DIR) || warn "closedir($opts{'backupdir'}) failed: $!"; for my $dirent (@dirents) { next if (-d $dirent); next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.lzma$/); @@ -885,7 +954,7 @@ print "@rs\n"; } } else { - print "No backups available in $opt_backupdir\n"; + print "No backups available in $opts{'backupdir'}\n"; } finish(0); } @@ -897,7 +966,7 @@ } # we did arrive here, so we try to restore ... if (defined($backups{$pkg}->{$rev})) { - if (!$opt_force) { + if (!$opts{"force"}) { print "Do you really want to restore $pkg to revision $rev (y/N): "; my $yesno = ; if ($yesno !~ m/^y(es)?$/i) { @@ -905,14 +974,14 @@ finish(0); } } - print "Restoring $pkg, $rev from $opt_backupdir/${pkg}.r${rev}.tar.lzma\n"; - if (!$opt_dry) { + print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.lzma\n"; + if (!$opts{"dry"}) { init_local_db(1); # first remove the package, then reinstall it # this way we get rid of useless files - $opt_backupdir = abs_path($opt_backupdir); + $opts{"backupdir"} = abs_path($opts{"backupdir"}); merge_into(\%ret, &remove_package($pkg, $localtlpdb)); - TeXLive::TLMedia->_install_package("$opt_backupdir/${pkg}.r${rev}.tar.lzma" , [] ,$localtlpdb); + TeXLive::TLMedia->_install_package("$opts{'backupdir'}/${pkg}.r${rev}.tar.lzma" , [] ,$localtlpdb); logpackage("restore: $pkg ($rev)"); # now we have to read the .tlpobj file and add it to the DB my $tlpobj = TeXLive::TLPOBJ->new; @@ -922,7 +991,7 @@ $localtlpdb->save; } } else { - print "revision $rev for $pkg is not present in $opt_backupdir\n"; + print "revision $rev for $pkg is not present in $opts{'backupdir'}\n"; } return \%ret; } @@ -931,9 +1000,6 @@ tlwarn("machine-readable output not supported for backup\n") if $::machinereadble; init_local_db(1); - my $opt_dry = 0; - my $opt_all = 0; - my $opt_backupdir; # --clean argument # can be either -1 ... don't clean # 0 ... remove all backups @@ -941,36 +1007,29 @@ # that parallels the value of autoclean in the configuration # we have to be careful, because if simply --clean is given, we should # check for the value saved in the tlpdb, and if that is not present - # do nothing. But Getopt::Long with clean:i leaves 0 in $opt_clean if + # do nothing. But Getopt::Long with clean:i leaves 0 in $opts{"clean"} if # it is present. So - # !defined($opt_clean) -> no --clean given - # $opt_clean = "" -> --clean without argument given, check tlpdb - # $opt_clean = -1, 0, N -> --clean=N given, check argument + # !defined($opts{"clean"}) -> no --clean given + # $opts{"clean"} = "" -> --clean without argument given, check tlpdb + # $opts{"clean"} = -1, 0, N -> --clean=N given, check argument # - my $opt_clean; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("all" => \$opt_all, - "backupdir=s" => \$opt_backupdir, - "clean:s" => \$opt_clean, - "n|dry-run" => \$opt_dry, - ) or pod2usage(2); my $clean_mode = 0; - $clean_mode = 1 if defined($opt_clean); + $clean_mode = 1 if defined($opts{"clean"}); if ($clean_mode) { - if ($opt_clean eq "") { + if ($opts{"clean"} eq "") { # we need to check the tlpdb - $opt_clean = $localtlpdb->option("autobackup"); - if (!$opt_clean) { + $opts{"clean"} = $localtlpdb->option("autobackup"); + if (!$opts{"clean"}) { tlwarn ("--clean given without an argument, but no default clean\n"); tlwarn ("mode specified in the tlpdb, terminating.\n"); exit 1; } } - # now $opt_clean is something, but maybe not a number, check for + # now $opts{"clean"} is something, but maybe not a number, check for # validity - if ($opt_clean =~ m/^(-1|[0-9]+)$/) { + if ($opts{"clean"} =~ m/^(-1|[0-9]+)$/) { # get rid of leading zeros etc etc - $opt_clean = $opt_clean + 0; + $opts{"clean"} = $opts{"clean"} + 0; } 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"); @@ -978,11 +1037,11 @@ } } # check the backup dir argument - if ($opt_backupdir) { - my $ob = abs_path($opt_backupdir); - $ob && ($opt_backupdir = $ob); - if (! -d $opt_backupdir) { - tlwarn ("backupdir argument $opt_backupdir is not a directory.\n"); + if ($opts{"backupdir"}) { + my $ob = abs_path($opts{"backupdir"}); + $ob && ($opts{"backupdir"} = $ob); + if (! -d $opts{"backupdir"}) { + tlwarn ("backupdir argument $opts{'backupdir'} is not a directory.\n"); if ($clean_mode) { tlwarn ("Cannot clean a non existing directory, terminating.\n"); } else { @@ -992,8 +1051,8 @@ } } else { # no argument, check for presence in TLPDB - $opt_backupdir = $localtlpdb->option("backupdir"); - if (!$opt_backupdir) { + $opts{"backupdir"} = $localtlpdb->option("backupdir"); + if (!$opts{"backupdir"}) { if ($clean_mode) { tlwarn ("Cannot clean an unknown directory, terminating.\n"); } else { @@ -1002,10 +1061,10 @@ exit 1; } # we are stil here, there is something set in tlpdb - my $ob = abs_path($opt_backupdir); - $ob && ($opt_backupdir = $ob); - if (! -d $opt_backupdir) { - tlwarn ("backupdir as set in tlpdb $opt_backupdir is not a directory.\n"); + my $ob = abs_path($opts{"backupdir"}); + $ob && ($opts{"backupdir"} = $ob); + if (! -d $opts{"backupdir"}) { + tlwarn ("backupdir as set in tlpdb $opts{'backupdir'} is not a directory.\n"); if ($clean_mode) { tlwarn ("Cannot clean a non existing directory, terminating.\n"); } else { @@ -1017,7 +1076,7 @@ my %ret; my @todo; - if ($opt_all) { + if ($opts{"all"}) { @todo = $localtlpdb->list_packages; } else { @todo = @ARGV; @@ -1028,14 +1087,14 @@ } foreach my $pkg (@todo) { if ($clean_mode) { - clear_old_backups ($pkg, $opt_backupdir, $opt_clean, $opt_dry); + clear_old_backups ($pkg, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"}); } else { my $tlp = $localtlpdb->get_package($pkg); - info("saving current status of $pkg to $opt_backupdir${pkg}.r" . - $tlp->revision . ".\n"); - if (!$opt_dry) { + info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" . + $tlp->revision . "tar.lzma\n"); + if (!$opts{"dry-run"}) { $tlp->make_container("lzma", $localtlpdb->root, - $opt_backupdir, "${pkg}.r" . $tlp->revision); + $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); } } } @@ -1069,7 +1128,7 @@ # sub add_w32_updater { - my ($tlp, $opt_dry) = @_; + my ($tlp, $dry) = @_; sub do_one { my $pkg = shift; print $::UPDATER <name; - # that could be more intelligent for decent $opt_dry output + # that could be more intelligent for decent $dry output my $root = $localtlpdb->root; my $temp = "$root/temp"; - return if $opt_dry; + return if $dry; if (!$::updater_started) { open_w32_updater($root); $::updater_started = 1; @@ -1206,43 +1265,24 @@ } sub action_update { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("update"); } init_local_db(1); # initialize the TLMedia from $location - my $opt_nodepends = 0; - my $opt_reallynodepends = 0; - my $opt_dry = 0; - my $opt_all = 0; - my $opt_list = 0; - my $opt_noremove = 0; - my $opt_backupdir; - my $opt_backup = 0; - my $opt_force = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("no-depends" => \$opt_nodepends, - "no-depends-at-all" => \$opt_reallynodepends, - "all" => \$opt_all, - "list" => \$opt_list, - "no-remove" => \$opt_noremove, - "force" => \$opt_force, - "backupdir=s" => \$opt_backupdir, - "backup" => \$opt_backup, - "n|dry-run" => \$opt_dry) or pod2usage(2); - $opt_nodepends = 1 if $opt_reallynodepends; + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my $nrupdated = 0; my %ret; init_tlmedia(); my $mediatlpdb = $tlmediasrc->tlpdb; - info("update: dry run, no changes will be made\n") if $opt_dry; + info("update: dry run, no changes will be made\n") if $opts{"dry-run"}; # if the update is not for one of the critical packages then do # check for updates to tlmgr and die unless either --force or --list # is given my $other_updates_asked_for = 0; - if ($opt_all) { + if ($opts{"all"}) { $other_updates_asked_for = 1; } else { for my $p (@ARGV) { @@ -1262,9 +1302,9 @@ } if ($other_updates_asked_for) { if (check_for_critical_updates($localtlpdb, $mediatlpdb)) { - if ($opt_force) { + if ($opts{"force"}) { tlwarn("Continuing due to --force\n"); - } elsif ($opt_list) { + } elsif ($opts{"list"}) { # do not warn here } else { if ($::gui_mode) { @@ -1279,9 +1319,9 @@ # do backup dir checking now so that we don't run into troubles # later, and exit if that doesn't work - if ($opt_backupdir) { - $opt_backupdir = abs_path($opt_backupdir); - if (! -d $opt_backupdir) { + if ($opts{"backupdir"}) { + $opts{"backupdir"} = abs_path($opts{"backupdir"}); + if (! -d $opts{"backupdir"}) { tlwarn("Argument for --backupdir must be an existing directory. Terminating.\n"); exit 1; } @@ -1290,18 +1330,18 @@ my $autobackup = 0; # check for the tlpdb option autobackup, and if present and true (!= 0) # assume we are doing backups - if (!$opt_backup) { + if (!$opts{"backup"}) { $autobackup = $localtlpdb->option("autobackup"); if ($autobackup) { # check the format, we currently allow only natural numbers, and -1 if ($autobackup eq "-1") { debug ("Automatic backups activated, keeping \\infty backups.\n"); - $opt_backup = 1; + $opts{"backup"} = 1; } elsif ($autobackup eq "0") { debug ("Automatic backups disabled.\n"); } elsif ($autobackup =~ m/^[0-9]+$/) { debug ("Automatic backups activated, keeping $autobackup backups.\n"); - $opt_backup = 1; + $opts{"backup"} = 1; } else { tlwarn ("Option autobackup can only be an integer >= -1.\n"); tlwarn ("Disabling auto backups.\n"); @@ -1313,14 +1353,14 @@ # cmd line --backup, we check for --backupdir, and if that is not given # we try to get the default from the tlpdb. If that doesn't work, exit. - if ($opt_backup) { + if ($opts{"backup"}) { my $diebackupdir = 0; - if (!$opt_backupdir) { - $opt_backupdir = $localtlpdb->option("backupdir"); - if ($opt_backupdir) { + if (!$opts{"backupdir"}) { + $opts{"backupdir"} = $localtlpdb->option("backupdir"); + if ($opts{"backupdir"}) { # check again: - $opt_backupdir = abs_path($opt_backupdir); - $diebackupdir = 1 if (! -d $opt_backupdir); + $opts{"backupdir"} = abs_path($opts{"backupdir"}); + $diebackupdir = 1 if (! -d $opts{"backupdir"}); } else { # not set in the tlpdb, and not set on cmd line, but asked for # --backup @@ -1337,9 +1377,9 @@ } # finally, if we have --backupdir, but no --backup, just enable it - $opt_backup = 1 if $opt_backupdir; + $opts{"backup"} = 1 if $opts{"backupdir"}; - debug("Doing backups to $opt_backupdir\n") if $opt_backup; + debug("Doing backups to $opts{'backupdir'}\n") if $opts{"backup"}; # these two variables are used throughout this function my $root = $localtlpdb->root; @@ -1348,7 +1388,7 @@ # remove old _BACKUP packages that have piled up in temp # they can be recognized by their name starting with __BACKUP_ for my $f (<$temp/__BACKUP_*>) { - unlink($f) unless $opt_dry; + unlink($f) unless $opts{"dry-run"}; } my @todo; @@ -1399,7 +1439,7 @@ debug ("tlmgr: deleted : " . join("\n\t",keys %removals) . "\n"); debug ("tlmgr: forced : " . join("\n\t",keys %forcermpkgs) . "\n"); - if ($opt_all || $opt_list) { + if ($opts{"all"} || $opts{"list"}) { @todo = $localtlpdb->list_packages; } else { @todo = @ARGV; @@ -1410,7 +1450,7 @@ # to support moving of files from one package to another. # remove the packages that have disappeared: for my $p (keys %removals) { - if ($opt_noremove) { + if ($opts{"no-remove"}) { info("not removing $p due to -no-remove (removed on server)\n"); } else { if ($::machinereadable) { @@ -1420,7 +1460,7 @@ info("remove $p (removed on server)\n"); } } - if (!($opt_dry or $opt_list or $opt_noremove)) { + if (!($opts{"dry-run"} or $opts{"list"} or $opts{"no-remove"})) { merge_into(\%ret, &remove_package($p, $localtlpdb)); logpackage("remove: $p"); } @@ -1430,13 +1470,13 @@ tlwarn("tlmgr update: please specify a list of packages or --all.\n"); } - # update all .ARCH dependencies, too, unless $opt_reallynodepends: + # update all .ARCH dependencies, too, unless $opts{"no-depends-at-all"}: @todo = $mediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo) - unless $opt_reallynodepends; + unless $opts{"no-depends-at-all"}; # - # update general deps unless $opt_nodepends: + # update general deps unless $opts{"no-depends"}: @todo = $mediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo) - unless $opt_nodepends; + unless $opts{"no-depends"}; foreach my $pkg (sort @todo) { next if ($pkg =~ m/^00texlive/); @@ -1481,7 +1521,7 @@ } else { info("auto-install: $pkg\n"); } - next if ($opt_dry || $opt_list); + next if ($opts{"dry-run"} || $opts{"list"}); my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); if (ref $foo) { # installation succeeded because we got a reference @@ -1505,30 +1545,30 @@ my $mediarev = $mediatlp->revision; if ($rev < $mediarev) { $nrupdated++; - if ($opt_list) { + if ($opts{"list"}) { if ($::machinereadable) { machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev); } else { info("$pkg: local: $rev, source: $mediarev\n"); } } else { - if ($opt_backup && !$opt_dry) { + if ($opts{"backup"} && !$opts{"dry-run"}) { $tlp->make_container("lzma", $root, - $opt_backupdir, "${pkg}.r" . $tlp->revision); + $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); $unwind_package = - "$opt_backupdir/${pkg}.r" . $tlp->revision . ".tar.lzma"; + "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.lzma"; if ($autobackup) { # in case we do auto backups we remove older backups - clear_old_backups($pkg, $opt_backupdir, $autobackup); + clear_old_backups($pkg, $opts{"backupdir"}, $autobackup); } } if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { - add_w32_updater($mediatlp, $opt_dry); + add_w32_updater($mediatlp, $opts{"dry-run"}); } else { info("update: $pkg ($rev -> $mediarev)"); - if ($opt_dry) { + if ($opts{"dry-run"}) { info("\n"); next; } else { @@ -1614,7 +1654,7 @@ } # that already checks whether we actually have to do something close_w32_updater(); - if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opt_all) { + if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opts{"all"}) { # for all but net updates we warn if nothing is updated tlwarn("\nNothing to update.\n"); tlwarn("\nYour installation is set up to look on the disk for updates.\n"); @@ -1656,31 +1696,21 @@ # anymore! That has all to be done by hand. # sub action_install { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("install"); } tlwarn("machine-readable output not supported for install\n") if $::machinereadble; init_local_db(1); # initialize the TLMedia from $location - my $opt_nodepends = 0; - my $opt_reallynodepends = 0; - my $opt_dry = 0; - my $opt_reinstall = 0; - my $opt_force = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("no-depends" => \$opt_nodepends, - "no-depends-at-all" => \$opt_reallynodepends, - "reinstall" => \$opt_reinstall, - "force" => \$opt_force, - "n|dry-run" => \$opt_dry) or pod2usage(2); + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my %ret; init_tlmedia(); my $tlmediatlpdb = $tlmediasrc->tlpdb; # check for updates to tlmgr itself, and die unless --force is given if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) { - if ($opt_force) { + if ($opts{"force"}) { tlwarn("Continuing due to --force\n"); } else { if ($::gui_mode) { @@ -1692,23 +1722,23 @@ } } - $opt_nodepends = 1 if $opt_reallynodepends; - info("install: dry run, no changes will be made\n") if $opt_dry; + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; + info("install: dry run, no changes will be made\n") if $opts{"dry-run"}; my @packs = @ARGV; - # first expand the .ARCH dependencies unless $opt_reallynodepends - @packs = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opt_reallynodepends; - # now expand all others unless $opt_nodepends - # if $opt_reinstall do not collection->collection dependencies - if ($opt_reinstall) { - @packs = $tlmediatlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opt_nodepends; + # first expand the .ARCH dependencies unless $opts{"no-depends-at-all"} + @packs = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; + # now expand all others unless $opts{"no-depends"} + # if $opts{"reinstall"} do not collection->collection dependencies + if ($opts{"reinstall"}) { + @packs = $tlmediatlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; } else { - @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opt_nodepends; + @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"}; } foreach my $pkg (sort @packs) { my $re = ""; if (defined($localtlpdb->get_package($pkg))) { - if ($opt_reinstall) { + if ($opts{"reinstall"}) { $re = "re"; } else { debug("already installed: $pkg\n"); @@ -1716,12 +1746,12 @@ } } info("${re}install: $pkg\n"); - if (!$opt_dry) { + if (!$opts{"dry-run"}) { merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb)); logpackage("${re}install: $pkg"); } } - if ($opt_dry) { + if ($opts{"dry-run"}) { # stop here, don't do any postinstall actions return(0); } @@ -1768,7 +1798,7 @@ } sub action_option { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } tlwarn("machine-readable output not supported for option\n") @@ -1874,18 +1904,15 @@ if ($^O=~/^MSWin(32|64)$/i) { warn("action `arch' not supported on Windows\n"); } - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("arch"); } tlwarn("machine-readable output not supported for arch\n") if $::machinereadble; my %ret; - my $opt_dry = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("n|dry-run" => \$opt_dry) or pod2usage(2); my $what = shift @ARGV; init_local_db(1); - info("arch: dry run, no changes will be made\n") if $opt_dry; + info("arch: dry run, no changes will be made\n") if $opts{"dry-run"}; $what || ($what = "list"); if ($what =~ m/^list$/i) { # list the available architectures @@ -1928,7 +1955,7 @@ if ($dep =~ m/^(.*)\.ARCH$/) { # we have to install something foreach my $a (@todoarchs) { - if ($opt_dry) { + if ($opts{"dry-run"}) { info("Installing $pkg.$a\n"); } else { info("install: $pkg.$a\n"); @@ -1959,10 +1986,8 @@ } sub action_generate { - my $localconf = ""; - my $dest = ""; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("localcfg=s" => \$localconf, "dest=s" => \$dest,) or pod2usage(2); + my $dest = defined($opts{"dest"}) ? $opts{"dest"} : ""; + my $localconf = defined($opts{"localcfg"}) ? $opts{"localcfg"} : ""; my $what = shift @ARGV; tlwarn("machine-readable output not supported for generate\n") if $::machinereadble; @@ -2037,8 +2062,8 @@ if (defined($loc)) { $location = $loc; } - if (defined($opt_location)) { - $location = $opt_location; + if (defined($opts{"location"})) { + $location = $opts{"location"}; } if (!defined($location)) { die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!"); @@ -2108,9 +2133,9 @@ # be sure that sub actions do *not* finish $::gui_mode = 1; - # also unset the $opt_gui to make recursive calls to action_* not starting + # also unset the $opts{"gui"} to make recursive calls to action_* not starting # another GUI instance (or better trying to ...) - $opt_gui = 0; + $opts{"gui"} = 0; require("tlmgrgui2.pl"); # should not be reached @@ -2122,12 +2147,10 @@ printf STDERR "Please use \"Add/Remove Programs\" from the Control Panel to removing TeX Live!\n"; finish(1); } - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("uninstall"); } - my $force = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("force" => \$force) or pod2usage(2); + my $force = defined($opts{"force"}) ? $opts{"force"} : 0; if (!$force) { print("If you answer yes here the whole TeX Live installation will be removed!\n"); print "Remove TeX Live (y/N): "; @@ -2249,9 +2272,7 @@ sub action_check { - my $svn = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("use-svn" => \$svn) or pod2usage(2); + my $svn = defined($opts{"use-svn"}) ? $opts{"use-svn"} : 0; my $what = shift @ARGV; $what || ($what = "all"); init_local_db(); @@ -2448,7 +2469,7 @@ print "tlmgr: exiting unsuccessfully (status $ret).\n"; } - if ($opt_pause) { + if ($opts{"pause"}) { print "Please press to exit the program.\n"; ; } @@ -2465,16 +2486,16 @@ # mind that with $autobackup == 0 all packages are cleared sub clear_old_backups { - my ($pkg, $opt_backupdir, $autobackup, $opt_dry) = @_; + my ($pkg, $backupdir, $autobackup, $dry) = @_; my $dryrun = 0; - $dryrun = 1 if ($opt_dry); + $dryrun = 1 if ($dry); # keep arbitrary many backups return if ($autobackup == -1); - opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!"; + opendir (DIR, $backupdir) || die "opendir($backupdir) failed: $!"; my @dirents = readdir (DIR); - closedir (DIR) || warn "closedir($opt_backupdir) failed: $!"; + closedir (DIR) || warn "closedir($backupdir) failed: $!"; my @backups; for my $dirent (@dirents) { next if (-d $dirent); @@ -2484,8 +2505,8 @@ my $i = 1; for my $e (reverse sort {$a <=> $b} @backups) { if ($i > $autobackup) { - info ("Removing backup $opt_backupdir/$pkg.r$e.tar.lzma\n"); - unlink("$opt_backupdir/$pkg.r$e.tar.lzma") unless $dryrun; + info ("Removing backup $backupdir/$pkg.r$e.tar.lzma\n"); + unlink("$backupdir/$pkg.r$e.tar.lzma") unless $dryrun; } $i++; } @@ -2972,7 +2993,7 @@ option value is used (if set). The C option (de)activates the automatic generation of -backups. Its value is an integer. If C is C<-1<, backups +backups. Its value is an integer. If C is C<-1>, backups will not be removed by default. If C is 0 or positive, it specifies the number of backups to be kept. Thus, backups are disabled with 0 as the values. Index: tlmgrgui/tlmgrgui2.pl =================================================================== --- tlmgrgui/tlmgrgui2.pl (revision 11640) +++ tlmgrgui/tlmgrgui2.pl (working copy) @@ -24,6 +24,7 @@ # our %TRANS; our $LANG; +our %opts; $TRANS{'en'} = { about => "About", @@ -143,8 +144,8 @@ my $opt_screen = $::guiscreen; -if (defined($opt_gui_lang)) { - $LANG = $opt_gui_lang; +if (defined($opts{"gui-lang"})) { + $LANG = $opts{"gui-lang"}; } else { if ($^O =~ /^MSWin(32|64)$/i) { # trying to deduce automatically the country code