From e0d7ae48bf5c441b6c4510e52cc70d06c8be0b9f Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 19 Jan 2009 22:09:34 +0000 Subject: tlmgr2 -> tlmgr git-svn-id: svn://tug.org/texlive/trunk@11917 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/tlmgr.pl | 2131 +++++++----- Master/texmf/scripts/texlive/tlmgr1.pl | 2958 +++++++++++++++++ Master/texmf/scripts/texlive/tlmgr2.pl | 3395 -------------------- Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl | 2 +- Master/texmf/scripts/texlive/tlmgrgui/gui-arch1.pl | 94 + Master/texmf/scripts/texlive/tlmgrgui/gui-arch2.pl | 94 - .../texmf/scripts/texlive/tlmgrgui/gui-config.pl | 166 +- .../texmf/scripts/texlive/tlmgrgui/gui-config1.pl | 268 ++ .../texmf/scripts/texlive/tlmgrgui/gui-config2.pl | 270 -- Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl | 756 ++++- Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl | 78 + Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl | 713 ---- 12 files changed, 5466 insertions(+), 5459 deletions(-) create mode 100755 Master/texmf/scripts/texlive/tlmgr1.pl delete mode 100755 Master/texmf/scripts/texlive/tlmgr2.pl create mode 100644 Master/texmf/scripts/texlive/tlmgrgui/gui-arch1.pl delete mode 100644 Master/texmf/scripts/texlive/tlmgrgui/gui-arch2.pl create mode 100644 Master/texmf/scripts/texlive/tlmgrgui/gui-config1.pl delete mode 100644 Master/texmf/scripts/texlive/tlmgrgui/gui-config2.pl create mode 100755 Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl delete mode 100755 Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl (limited to 'Master/texmf') diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 14a7fe1c47c..a81dea15635 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -1,10 +1,21 @@ #!/usr/bin/env perl # $Id$ # -# Copyright 2008 Norbert Preining +# Copyright 2008, 2009 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. # +# TODO: +# - in GUI mode updating bin-texlive/texlive.infra DOES work without +# the warning, but it does NOT force to restart the GUI. THAT IS BAD!!! +# +# - when tlmgr2.pl is shipped globally as tlmgr.pl we can switch the +# installer from using either texconfig paper or texlua ... to +# tlmgr paper letter which will work on all platforms transparently. +# +# - tlmgr should have a "progress" bar for the update --all and install +# etc options, echoing number of total packages etc etc. +# my $svnrev = '$Revision$'; my $datrev = '$Date$'; @@ -18,91 +29,172 @@ $datrev =~ s/^.*Date: //; $datrev =~ s/ \(.*$//; $tlmgrrevision .= " ($datrev)"; - -my $Master; +our $Master; BEGIN { $^W = 1; - $Master = `kpsewhich -var-value=SELFAUTOPARENT`; - chomp($Master); + # make subprograms (including kpsewhich) have the right path: + ($mydir = $0) =~ s,/[^/]*$,,; + $ENV{"PATH"} = "$mydir:$ENV{PATH}"; + # + chomp($Master = `kpsewhich -var-value=SELFAUTOPARENT`); + # + # make Perl find our packages first: unshift (@INC, "$Master/tlpkg"); + unshift (@INC, "$Master/texmf/scripts/texlive"); } -use TeXLive::TLPOBJ; -use TeXLive::TLPDB; +use Cwd qw/abs_path/; +use Pod::Usage; +use Getopt::Long qw(:config no_autoabbrev permute); +use strict; + use TeXLive::TLConfig; use TeXLive::TLMedia; +use TeXLive::TLPDB; +use TeXLive::TLPOBJ; +use TeXLive::TLPostActions; use TeXLive::TLUtils; use TeXLive::TLWinGoo; -use TeXLive::TLPostActions; -TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 - merge_into copy log debug)); -use Cwd qw/abs_path/; -use Pod::Usage; -use Getopt::Long qw(:config no_autoabbrev require_order); -use strict; +TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 dirname + mkdirhier merge_into copy log debug)); -# used variables -# the TLMedia from which we install/update -my $tlmediasrc; -# the tlpdb of the install media -my $tlpdb; -# the local tlpdb -my $localtlpdb; -# a hash for saving the options saved into the local tlpdb -my %options; -# the location from where we install -my $location; - -# each action uses this. -my @getopt_configure_subopts = qw(no_pass_through permute); +use TeXLive::TLPaper; -# option variables -my $opt_location; -my $opt_help = 0; -my $opt_version = 0; -my $opt_gui = 0; -my $opt_gui_lang; -my $opt_packagelogfile; -my $opt_pause = 0; +binmode(STDOUT, ":utf8"); +binmode(STDERR, ":utf8"); + +our $tlmediasrc; # media from which we install/update +our $tlmediatlpdb; +our $location; # location from which the new packages come +our $localtlpdb; # local installation which we are munging +my %options; # TL options from local tlpdb +# flags for machine-readable form +our $FLAG_REMOVE = "d"; +our $FLAG_FORCIBLE_REMOVED = "f"; +our $FLAG_UPDATE = "u"; +our $FLAG_REVERSED_UPDATE = "r"; +our $FLAG_AUTOINSTALL = "a"; + +# option variables +$::gui_mode = 0; +$::machinereadable = 0; + +my %globaloptions = ( + "gui" => 1, + "gui-lang" => "=s", + "location" => "=s", + "machine-readable" => 1, + "package-logfiles" => "=s", + "pause" => 1, + "version" => 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" => ":-99", + "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 }, + "paper" => { "list" => 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, - "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)) { + $action = $opts{"gui"} ? "gui" : ""; +} -if (!defined($action) && $opt_gui) { - $action = "gui"; +ddebug("action = $action\n"); +for my $k (keys %opts) { + ddebug("$k => $opts{$k}\n"); +} +ddebug("arguments: @ARGV\n") if @ARGV; + +sub give_version { + if (!defined($::version_string)) { + $::version_string = ""; + $::version_string .= "tlmgr revision $tlmgrrevision\n"; + $::version_string .= "tlmgr using installation: $Master\n"; + if (open (REL_TL, "$Master/release-texlive.txt")) { + # print first and last lines, which have the TL version info. + my @rel_tl = ; + $::version_string .= $rel_tl[0]; + $::version_string .= $rel_tl[$#rel_tl]; + close (REL_TL); + } + } + return $::version_string; } -if ($opt_version || (defined $action && $action eq "version")) { - print "tlmgr revision $tlmgrrevision\n"; - print "tlmgr using installation: $Master\n"; - if (open (REL_TL, "$Master/release-texlive.txt")) { - # print first and last lines, which have the TL version info. - my @rel_tl = ; - print $rel_tl[0]; - print $rel_tl[$#rel_tl]; - close (REL_TL); - } +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) || !$action) && !$opts{"help"}) { die "$0: missing action; try --help if you need it.\n"; } -if ($opt_help) { +if ($opts{"help"}) { # perldoc does ASCII emphasis on the output, so it's nice to use it. # But not all Unix platforms have it, and on Windows our Config.pm # can apparently interfere, so always skip it there. @@ -113,12 +205,59 @@ if ($opt_help) { pod2usage("-exitstatus" => 0, "-verbose" => 2, @noperldoc); } +# unify arguments so that the $action contains paper in all cases +# and push the first arg back to @ARGV for action_paper processing +if ($action =~ /^(paper|xdvi|pdftex|dvips|dvipdfmx?|context)$/) { + unshift(@ARGV, $action); + $action = "paper"; +} + +# --machine-readable is only supported by update. +# +if ($::machinereadable && $action ne "update") { + tlwarn("tlmgr: --machine-readable output not supported for $action\n"); +} + +# 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}) && !defined($globaloptions{$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 + my @noperldoc = (); + if (win32() || ! TeXLive::TLUtils::which("perldoc")) { + @noperldoc = ("-noperldoc", "1"); + } + pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1, @noperldoc); +} + # 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")) { @@ -128,160 +267,185 @@ if (!open(PACKAGELOG, ">>$packagelogfile")) { } my $loadmediasrcerror = "Cannot load TeX Live database from "; -my %ret; -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/^(.*)\.(src|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 not existing 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 "src") { - $mothertlp->srcfiles($tlpobj->srcfiles); - $mothertlp->srcsize($tlpobj->srcsize); +execute_action($action, @ARGV); +# end of main program. + + + +sub execute_action { + my ($action, @argv) = @_; + my %ret; + + # we have to set @ARGV to the @argv since many of the action_* subs + # use GetOption + @ARGV = @argv; + + # 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/^(.*)\.(src|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 not existing 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 { - # must be "doc" - $mothertlp->docfiles($tlpobj->docfiles); - $mothertlp->docsize($tlpobj->docsize); + if ($type eq "src") { + $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); } - # that make sure that the original entry is overwritten - $localtlpdb->add_tlpobj($mothertlp); + } else { + # completely normal package, just add it + $localtlpdb->add_tlpobj($tlpobj); } - } else { - # completely normal package, just add it - $localtlpdb->add_tlpobj($tlpobj); + $localtlpdb->save; } - $localtlpdb->save; + finish(0); + } elsif ($action =~ m/^get-mirror$/i) { + my $loc = give_ctan_mirror(); + print "$loc\n"; + finish(0); + } elsif ($action =~ m/^generate$/i) { + merge_into(\%ret, action_generate()); + } elsif ($action =~ m/^gui$/i) { + action_gui(); + } elsif ($action =~ m/^arch$/i) { + merge_into(\%ret, action_arch()); + } elsif ($action =~ m/^option$/i) { + merge_into(\%ret, action_option()); + finish(0); + } elsif ($action =~ m/^list$/i) { + merge_into(\%ret, action_list()); + finish(0); + } elsif ($action =~ m/^check$/i) { + merge_into(\%ret, action_check()); + } elsif ($action =~ m/^install$/i) { + merge_into(\%ret, action_install()); + } elsif ($action =~ m/^update$/i) { + merge_into(\%ret, action_update()); + } elsif ($action =~ m/^backup$/i) { + merge_into(\%ret, action_backup()); + } elsif ($action =~ m/^restore$/i) { + merge_into(\%ret, action_restore()); + } elsif ($action =~ m/^symlinks$/i) { + merge_into(\%ret, action_symlinks()); + finish(0); + } elsif ($action =~ m/^search$/i) { + merge_into(\%ret, action_search()); + finish(0); + } elsif ($action =~ m/^show$/i) { + merge_into(\%ret, action_show()); + finish(0); + } elsif ($action =~ m/^remove$/i) { + merge_into(\%ret, action_remove()); + } elsif ($action =~ /^paper$/) { + merge_into(\%ret, action_paper()); + } elsif ($action =~ m/^uninstall$/i) { + merge_into(\%ret, action_uninstall()); + finish(0); + } else { + die "$0: unknown action: $action; try --help if you need it.\n"; } - finish(0); -} elsif ($action =~ m/^generate$/i) { - merge_into(\%ret, action_generate()); -} elsif ($action =~ m/^gui$/i) { - action_gui(); -} elsif ($action =~ m/^arch$/i) { - merge_into(\%ret, action_arch()); -} elsif ($action =~ m/^option$/i) { - merge_into(\%ret, action_option()); - # should we do postinstall stuff? - finish(0); -} elsif ($action =~ m/^list$/i) { - merge_into(\%ret, action_list()); - # should we do postinstall stuff? - finish(0); -} elsif ($action =~ m/^check$/i) { - merge_into(\%ret, action_check()); -} elsif ($action =~ m/^install$/i) { - merge_into(\%ret, action_install()); -} elsif ($action =~ m/^update$/i) { - merge_into(\%ret, action_update()); -} elsif ($action =~ m/^backup$/i) { - merge_into(\%ret, action_backup()); -} elsif ($action =~ m/^restore$/i) { - merge_into(\%ret, action_restore()); -} elsif ($action =~ m/^search$/i) { - merge_into(\%ret, action_search()); - finish(0); -} elsif ($action =~ m/^show$/i) { - merge_into(\%ret, action_show()); - finish(0); -} elsif ($action =~ m/^remove$/i) { - merge_into(\%ret, action_remove()); -} 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) { - action_gui("config"); + + # close the special log file + if ($packagelogfile && !$::gui_mode) { + info("tlmgr: package log updated at $packagelogfile\n") if $packagelogged; + close(PACKAGELOG); } - init_local_db(); - my $TEXMFMAIN = `kpsewhich -var-value=TEXMFMAIN`; - chomp $TEXMFMAIN; - my @cmdline = ("texlua", "$TEXMFMAIN/scripts/texlive/texconf.tlu", "--prog", "tlmgr","--sys"); - if (!$localtlpdb->option_create_formats) { - push @cmdline, "--noformat"; - } - push @cmdline, $action, @ARGV; - system(@cmdline); -} elsif ($action =~ m/^uninstall$/i) { - merge_into(\%ret, action_uninstall()); - finish(0); -} else { - die "$0: unknown action: $action\n"; -} -# main action is done, now clean up. + # run external programs. + my $error_count = &handle_ret_hash(%ret); -# close the special log file -if ($packagelogfile) { - print "tlmgr: package log updated at $packagelogfile\n" if $packagelogged; - close(PACKAGELOG); + # done, just in case there are 256 errors. + finish($error_count ? 1 : 0); } -# run external programs. -my $error_count = &handle_ret_hash(%ret); - -# done. -finish($error_count ? 1 : 0); # just in case there are 256 errors. - -# -# run external programs based on the RET hash we've accumulated. -# We return the number of unsuccessful runs, zero if all went well. + +# run external programs (mktexlsr, updmap-sys, etc.) as specified by the +# keys in the RET hash. We return the number of unsuccessful runs, zero +# if all ok. # -sub handle_ret_hash -{ +# If the "map" key is specified, the value may be a reference to a list +# of map command strings to pass to updmap, e.g., "enable Map=ascii.map". +# +sub handle_ret_hash { my (%ret) = @_; my $errors = 0; - if (defined($ret{'mktexlsr'})) { - print "running mktexlsr\n"; + if (exists $ret{'mktexlsr'}) { + info("running mktexlsr\n"); $errors += system("mktexlsr"); } - if (defined($ret{'map'})) { + if (exists $ret{'map'}) { + # We run updmap-sys instead of calling our create_updmap() function + # (as we do for formats and languages), because many users run + # updmap themselves (not using our local cfg feature), since that's + # been the documented way to add fonts for many years. If we called + # create_updmap, such user maps would be lost. foreach my $m (@{$ret{'map'}}) { - print "$m\n"; - $errors += system("updmap-sys --nomkmap --nohash --$m"); + my $cmd = "updmap-sys --nomkmap --nohash --$m"; + info("running $cmd\n"); + $errors += system($cmd); } - $errors += system("mktexlsr"); - $errors += system("updmap-sys"); + info("running updmap-sys once more\n"); + $errors += system("updmap-sys"); # runs mktexlsr. } - chomp (my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`); - chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`); + chomp(my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`); + chomp(my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`); - if (defined($ret{'format'})) { - print "regenerating fmtutil.cnf\n"; + # format means create missing formats (because a new one was added). + # format-regenerate is used when the paper size changes. In that + # case, if option_create_formats is set, we simply want to generate + # all formats; if not, then we only want to refresh existing ones. + # + my $opt_fmt = $localtlpdb->option_create_formats; + if (exists $ret{'format'}) { + info("regenerating fmtutil.cnf in $TEXMFSYSVAR\n"); TeXLive::TLUtils::create_fmtutil($localtlpdb, - "$TEXMFSYSVAR/web2c/fmtutil.cnf", - "$TEXMFLOCAL/web2c/fmtutil-local.cnf"); - # run fmtutil-sys only if the option for building formats is set. - if ($localtlpdb->option_create_formats) { - print "running fmtutil-sys --missing\n"; + "$TEXMFSYSVAR/web2c/fmtutil.cnf", + "$TEXMFLOCAL/web2c/fmtutil-local.cnf"); + if ($opt_fmt && !$ret{'format-regenerate'}) { + info("running fmtutil-sys --missing\n"); $errors += system("fmtutil-sys", "--missing"); } } + # + if (exists $ret{'format-regenerate'}) { + my $a = $opt_fmt ? "--all" : "--refresh"; + info("running fmtutil-sys $a to regenerate formats\n"); + $errors += system("fmtutil-sys", $a); + } - if (defined($ret{'language'})) { + if (exists $ret{'language'}) { for my $ext ("dat", "def") { my $lang = "language.$ext"; - print "regenerating $lang\n"; + info("regenerating $lang\n"); my $arg1 = "$TEXMFSYSVAR/tex/generic/config/language.$ext"; my $arg2 = "$TEXMFLOCAL/tex/generic/config/language-local.dat"; @@ -295,16 +459,17 @@ sub handle_ret_hash # Use full path for external command, except on Windows. $lang = "$TEXMFSYSVAR/tex/generic/config/$lang"; } - # run fmtutil-sys only if the option for building formats is set. if ($localtlpdb->option_create_formats) { - print "running fmtutil-sys --byhyphen $lang\n"; + info("running fmtutil-sys --byhyphen $lang\n"); $errors += system("fmtutil-sys", "--byhyphen", $lang); } } } + return $errors / 256; # we were accumulating wait statuses } + # # remove_package removes a single package with all files (including the # tlpobj files) and the entry from the tlpdb. @@ -386,6 +551,7 @@ sub remove_package { return \%ret; } + # REMOVE # # tlmgr remove foo bar baz @@ -407,7 +573,7 @@ sub remove_package { # account # sub action_remove { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("remove"); } # we do the following: @@ -426,20 +592,11 @@ sub action_remove { # . 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 @@ -458,24 +615,24 @@ sub action_remove { # 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 { @@ -492,7 +649,7 @@ sub action_remove { my $tlp = $localtlpdb->get_package($pkg); next if defined($already_removed{$pkg}); if (!defined($tlp)) { - print "$pkg: package not present, cannot remove\n"; + info("$pkg: package not present, cannot remove\n"); } else { # in the first round we only remove collections, nothing else # but removing collections will remove all dependencies, too @@ -501,7 +658,7 @@ sub action_remove { 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; @@ -527,7 +684,7 @@ sub action_remove { 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) { @@ -539,28 +696,79 @@ sub action_remove { } } } - if ($opt_dry) { + if ($opts{"dry-run"}) { # stop here, don't do any postinstall actions return; } else { $localtlpdb->save; my @foo = sort keys %already_removed; if (@foo) { - print "tlmgr: actually removed these packages: @foo\n"; + info("tlmgr: actually removed these packages: @foo\n"); } else { - print "tlmgr: no packages removed.\n"; + info("tlmgr: no packages removed.\n"); } return(\%ret); } } + +# PAPER +# ARGV can look like: +# paper a4 +# paper letter +# [xdvi|...|context] paper [help|papersize|--list] +# +sub action_paper { + my %ret = (); + action_gui("config") if $opts{"gui"}; + + init_local_db(); + chomp(my $texmfsysconfig = `kpsewhich -var-value=TEXMFSYSCONFIG`); + $ENV{"TEXMFCONFIG"} = $texmfsysconfig; + + my $action = shift @ARGV; + if ($action =~ m/^paper$/i) { # generic paper + my $newpaper = shift @ARGV; + if ($opts{"list"}) { # tlmgr paper --list => complain. + tlwarn("tlmgr: ignoring paper setting to $newpaper with --list\n") + if $newpaper; # complain if they tried to set, too. + tlwarn("tlmgr: please specify a program before paper --list, ", + "as in: tlmgr pdftex paper --list\n"); + + } elsif (!defined($newpaper)) { # tlmgr paper => show all current sizes. + TeXLive::TLPaper::paper_all($texmfsysconfig,undef); + + } elsif ($newpaper !~ /^(a4|letter)$/) { # tlmgr paper junk => complain. + $newpaper = "the empty string" if !defined($newpaper); + tlwarn("tlmgr: expected `a4' or `letter' after paper, not $newpaper\n"); + + } else { # tlmgr paper {a4|letter} => do it. + merge_into(\%ret,TeXLive::TLPaper::paper_all($texmfsysconfig,$newpaper)); + } + + } else { # program-specific paper + my $prog = $action; # first argument is the program to change + my $arg = shift @ARGV; # get "paper" argument + if (!defined($arg) || $arg ne "paper") { + $arg = "the empty string." if ! $arg; + tlwarn("tlmgr: expected `paper' after $prog, not $arg\n"); + return; + } + # the do_paper progs check for the argument --list, so if given + # restore it to the cmd line. + unshift(@ARGV, "--list") if $opts{"list"}; + merge_into(\%ret, TeXLive::TLPaper::do_paper($prog,$texmfsysconfig,@ARGV)); + } + return \%ret; +} + + +# SHOW +# sub action_show { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } - 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) { @@ -597,7 +805,7 @@ sub action_show { 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 @@ -638,24 +846,45 @@ sub action_show { return; } +# SYMLINKS +# +sub action_symlinks { + my %ret; + my $what = shift @ARGV; + if (!defined($what) || ($what !~ m/^(add|remove)$/i)) { + tlwarn("action symlinks needs one argument, either add or remove\n"); + return; + } + init_local_db(); + if ($what =~ m/^add$/i) { + $localtlpdb->add_symlinks(); + } elsif ($what =~ m/^remove$/i) { + # remove symlinks + $localtlpdb->remove_symlinks(); + } else { + # that should not happen + tlwarn("that should not happen, action_symlinks what=$what\n"); + exit 1; + } + return; +} + +# SEARCH +# sub action_search { - my $opt_global = 0; - my $opt_file = 0; - Getopt::Long::Configure(@getopt_configure_subopts); - GetOptions("global" => \$opt_global, - "file" => \$opt_file) or pod2usage(2); + my %ret; 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"; @@ -678,6 +907,7 @@ sub action_search { return; } + # RESTORE # sub action_restore { @@ -687,52 +917,45 @@ sub action_restore { # lists all revisions of pkg # tlmgr restore --backupdir dir pkg rev # restores pkg to revision rev - 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$/); $backups{$1}->{$2} = 1; } - my $ret; my ($pkg, $rev) = @ARGV; if (!defined($pkg)) { if (keys %backups) { @@ -743,7 +966,7 @@ sub action_restore { print "@rs\n"; } } else { - print "No backups available in $opt_backupdir\n"; + print "No backups available in $opts{'backupdir'}\n"; } finish(0); } @@ -755,7 +978,7 @@ sub action_restore { } # 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) { @@ -763,33 +986,30 @@ sub action_restore { 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; $tlpobj->from_file($localtlpdb->root . "/tlpkg/tlpobj/$pkg.tlpobj"); $localtlpdb->add_tlpobj($tlpobj); - $ret = $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable"); + merge_into(\%ret, $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable")); $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; + return \%ret; } sub action_backup { 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 @@ -797,36 +1017,30 @@ sub action_backup { # 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 - # 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 + # do nothing. + # We have set clean to clean:-99 which makes -99 the default value + # if only --clean is given without any argument + # !defined($opts{"clean"}) -> no --clean given + # $opts{"clean"} = -99 -> --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"} == -99) { # 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"); @@ -834,11 +1048,11 @@ sub action_backup { } } # 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 { @@ -848,8 +1062,8 @@ sub action_backup { } } 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 { @@ -858,10 +1072,10 @@ sub action_backup { 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 { @@ -873,7 +1087,7 @@ sub action_backup { my %ret; my @todo; - if ($opt_all) { + if ($opts{"all"}) { @todo = $localtlpdb->list_packages; } else { @todo = @ARGV; @@ -884,68 +1098,68 @@ sub action_backup { } 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); } } } return(\%ret); } -sub open_w32_updater { - my $root = shift; - open UPDATER, ">" . $root . "/tlpkg/installer/updater.bat" - or die "Cannot create updater.bat: $!"; - print UPDATER <<'EOF'; -rem update program, can savely removed after it has been done -set tlupdate=%~dp0 -set tldrive=%~d0 - -%tldrive% -cd %tlupdate% -rem now we are in .../tlpkg/installer -rem create tar.exe backup -copy tar.exe tarsave.exe -cd .. -cd .. -rem now we are in the root - -EOF -; - $::UPDATER = \*UPDATER; -} $::updater_started = 0; # -sub add_w32_updater { - my ($tlp, $opt_dry) = @_; - sub do_one { - my $pkg = shift; - print $::UPDATER < temp\\$pkg.tar -tlpkg\\installer\\tarsave.exe -x -f temp\\$pkg.tar -call tlmgr _include_tlpobj tlpkg\\tlpobj\\$pkg.tlpobj -del temp\\$pkg.tar.lzma -del temp\\$pkg.tar -EOF -; - } - +sub grow_w32_updater { + my ($tlp, $dry, $oldrev, $newrev) = @_; my $pkg = $tlp->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; + $::updater_string = <<'EOF'; +@echo off +rem Update script for TeX-Live infrastructure +rem called automatically after creation by tlmgr.bat wrapper +rem left only for inspection, can be safely removed + +setlocal +cd /d %~dp0 +rem now we are in .../tlpkg/installer +rem create tar.exe backup +>nul copy tar.exe tarsave.exe +cd ..\.. +rem now we are in the root +rem get location of the log file +for /f "delims=" %%D in ('kpsewhich -var-value=TEXMFSYSVAR') do set "web2c=%%~fD\web2c\" +rem set up perl environment +set PERL5LIB=%cd%\tlpkg\tlperl\lib + +echo Performing an update of TeX-Live infrastructure +echo In case of a disaster download and run: +echo http://mirror.ctan.org/systems/texlive/tlnet/2008/update-tlmgr-latest.exe +echo Do not close this window +EOF +; + } + sub do_one {# moved down to 'preserve' the flow of the batch script upon reading + my ($pkg, $oldrev, $newrev) = @_; + $::updater_string .= " +tlpkg\\installer\\lzma\\lzmadec.win32.exe < temp\\$pkg.tar.lzma > temp\\$pkg.tar +tlpkg\\installer\\tarsave.exe -x -f temp\\$pkg.tar +tlpkg\\tlperl\\bin\\perl.exe texmf\\scripts\\texlive\\tlmgr.pl _include_tlpobj tlpkg\\tlpobj\\$pkg.tlpobj +echo update: $pkg ($oldrev -^> $newrev) +>>%web2c%tlmgr.log echo [%date% %time%] update: $pkg ($oldrev -^> $newrev) +del temp\\$pkg.tar.lzma temp\\$pkg.tar +"; } # these packages cannot be upgrade on w32 # so we have to create a update program @@ -988,14 +1202,14 @@ EOF tlwarn ("Couldn't get $pkg.tar.lzma, that is bad\n"); } else { # add lines to the un-archiver - do_one ($pkg); + do_one ($pkg, $oldrev, $newrev); } if ($do_src) { if (! -r "$temp/$pkg.src.tar.lzma") { tlwarn ("Couldn't get $pkg.src.tar.lzma, that is bad\n"); } else { # add lines to the un-archiver - do_one ("$pkg.src"); + do_one ("$pkg.src", $oldrev, $newrev); } } if ($do_doc) { @@ -1003,32 +1217,26 @@ EOF tlwarn ("Couldn't get $pkg.doc.tar.lzma, that is bad\n"); } else { # add lines to the un-archiver - do_one ("$pkg.doc"); + do_one ("$pkg.doc", $oldrev, $newrev); } } } } -sub close_w32_updater { +sub write_w32_updater { if ($::updater_started) { - my $desktop_path = TeXLive::TLWinGoo::desktop_path(); - $desktop_path =~ s!/!\\!g; - print $::UPDATER "del tlpkg\\installer\\tarsave.exe\n"; - print $::UPDATER "pause\n"; - print $::UPDATER "del \"$desktop_path\\TeX Live Updater Final Step.lnk\"\n"; - print $::UPDATER "rem del /s /q temp\n"; - print $::UPDATER "del \"\%~f0\""; - close ($::UPDATER); - # create a desktop shortcut - add_desktop_shortcut( - $localtlpdb->root, - 'TeX Live Updater Final Step', - '', # the icon - $localtlpdb->root.'/tlpkg/installer/updater.bat', - '', # no args - '', # any non-null value to hide command-prompt - ); - tlwarn("UPDATER has been created, please execute\n"); + $::updater_string .= <<'EOF'; + +del tlpkg\installer\tarsave.exe +rem rmdir temp +EOF +; + open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater.bat" + or die "Cannot create updater.bat: $!"; + # print STDOUT $::updater_string; + print UPDATER $::updater_string; + close UPDATER; + tlwarn("UPDATER script has been created:\n"); tlwarn(" " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n"); } } @@ -1050,47 +1258,43 @@ sub close_w32_updater { # tlmgr update --no-depends-at-all foo # will absolutely only update foo not even taking .ARCH into account # -# TLMedia->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever +# TLMedia->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever # anymore. That has all to be done by hand. # +sub machine_line { + my ($flag1) = @_; + my $ret = 0; + if ($flag1 eq "-ret") { + $ret = 1; + shift; + } + my ($pkg, $flag, $lrev, $rrev, @args) = @_; + $lrev ||= "-"; + $rrev ||= "-"; + $flag ||= "?"; + my $str = "$pkg\t$flag\t$lrev\t$rrev\t" . join("\t", @args) . "\n"; + return($str) if $ret; + print $str; +} + 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; - my $nrupdated = 0; + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; 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) { @@ -1110,21 +1314,26 @@ sub action_update { } if ($other_updates_asked_for) { if (check_for_critical_updates($localtlpdb, $mediatlpdb)) { - if ($opt_force) { + if ($opts{"force"}) { tlwarn("$0: Continuing due to --force.\n"); - } elsif ($opt_list) { + } elsif ($opts{"list"}) { # do not warn here } else { - die "$0: Exiting, please read above warning.\n"; + if ($::gui_mode) { + # return here and don't do any updates + return; + } else { + die "$0: Exiting, please read above warning.\n"; + } } } } # 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; } @@ -1133,18 +1342,18 @@ sub action_update { 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"); @@ -1156,14 +1365,14 @@ sub action_update { # 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 @@ -1180,9 +1389,9 @@ sub action_update { } # 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; @@ -1191,7 +1400,7 @@ sub action_update { # 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; @@ -1242,39 +1451,29 @@ sub action_update { 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; } - - # - # we have to remove all the stuff before we install other packages - # to support moving of files from one package to another. - # remove the packages that have disappeared: - for my $p (keys %removals) { - if ($opt_noremove) { - info("not removing $p due to -no-remove (removed on server)\n"); - } else { - info("remove $p (removed on server)\n"); - } - if (!($opt_dry or $opt_list or $opt_noremove)) { - merge_into(\%ret, &remove_package($p, $localtlpdb)); - logpackage("remove: $p"); - } - } - + # don't do anything if we have been invoced in a strange way if (!@todo) { 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"}; + + # + # we first collect the list of packages to be actually updated or installed + my @updated; + my @new; + my @addlines; foreach my $pkg (sort @todo) { next if ($pkg =~ m/^00texlive/); @@ -1291,12 +1490,19 @@ sub action_update { # will be in the dependency expansion, and we want it. my $newpkg_coll = $newpkgs{$pkg} || $newpkgs{$pkg_noarch}; if ($forcerm_coll) { - info("skipping forcibly removed package $pkg\n"); + if ($::machinereadable) { + # TODO should we add a revision number + push @addlines, + machine_line("-ret", $pkg, $FLAG_FORCIBLE_REMOVED, "-", "-", "-"); + } else { + info("skipping forcibly removed package $pkg\n"); + } next; } elsif ($newpkg_coll) { # do nothing here, it will be reported below. } elsif (defined($removals{$pkg})) { # skipping this package, it has been removed due to server removal + # and has already been removed next; } else { tlwarn("\ntlmgr: $pkg mentioned, neither new nor forcibly removed\n"); @@ -1309,20 +1515,112 @@ sub action_update { next; } my $mediarev = $mediatlp->revision; - info("auto-install: $pkg\n"); - next if ($opt_dry || $opt_list); - my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); - if (ref $foo) { - # installation succeeded because we got a reference - merge_into (\%ret, $foo); - logpackage("auto-install new: $pkg ($mediarev)"); - $nrupdated++; + push @new, $pkg; + next; + } + my $rev = $tlp->revision; + my $mediatlp = $mediatlpdb->get_package($pkg); + if (!defined($mediatlp)) { + debug("$pkg cannot be found in $location\n"); + next; + } + my $mediarev = $mediatlp->revision; + if ($rev < $mediarev) { + push @updated, $pkg; + } elsif ($rev > $mediarev) { + if ($::machinereadable) { + push @addlines, + machine_line("-ret", $pkg, $FLAG_REVERSED_UPDATE, $rev, $mediarev, "-"); + } else { + info("$pkg: local revision ($rev) is newer than revision in $location" + . " ($mediarev), not updating.\n"); + } + } + } + for my $i (sort @new) { + debug("$i new package\n"); + } + for my $i (sort @updated) { + debug("$i upd package\n"); + } + + # number calculation + my $totalnr = $#new + $#updated + 2; + my $nrupdated = 0; + my $currnr = 1; + # sizes_of_packages returns the sizes of *all* packages if nothing + # is passed over, so if @new and @updated both are empty we will + # get something wrong back, namely the total size of all packages + my %sizes; + if ($totalnr > 0) { + %sizes = %{$mediatlpdb->sizes_of_packages( + $localtlpdb->option_install_srcfiles, + $localtlpdb->option_install_docfiles, + @new, @updated )}; + } else { + $sizes{'__TOTAL__'} = 0; + } + + print "total-bytes\t$sizes{'__TOTAL__'}\n" if $::machinereadable; + print "end-of-header\n" if $::machinereadable; + + # print deferred machine-readable lines after the header + for (@addlines) { print; } + + # + # we have to remove all the stuff before we install other packages + # to support moving of files from one package to another. + # remove the packages that have disappeared: + for my $p (keys %removals) { + if ($opts{"no-remove"}) { + info("not removing $p due to -no-remove (removed on server)\n"); + } else { + if ($::machinereadable) { + # TODO version numbers + machine_line($p, $FLAG_REMOVE, "-", "-", "-"); } else { - tlwarn("$0: couldn't install new package $pkg\n"); + info("remove $p (removed on server)\n"); } + } + if (!($opts{"dry-run"} or $opts{"list"} or $opts{"no-remove"})) { + merge_into(\%ret, &remove_package($p, $localtlpdb)); + logpackage("remove: $p"); + } + } + + + # install all the new packages first + for my $pkg (sort @new) { + # install new packages + my $mediatlp = $mediatlpdb->get_package($pkg); + if (!defined($mediatlp)) { + tlwarn("\nShould not happen: $pkg not found in $location\n"); next; } + my $mediarev = $mediatlp->revision; + if ($::machinereadable) { + machine_line($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg}); + } else { + info("[$currnr/$totalnr] auto-install: $pkg\n"); + } + $currnr++; + next if ($opts{"dry-run"} || $opts{"list"}); + my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); + if (ref $foo) { + # installation succeeded because we got a reference + merge_into (\%ret, $foo); + logpackage("auto-install new: $pkg ($mediarev)"); + $nrupdated++; + } else { + tlwarn("$0: couldn't install new package $pkg\n"); + } + } + # + foreach my $pkg (sort @updated) { + next if ($pkg =~ m/^00texlive/); + my $tlp = $localtlpdb->get_package($pkg); + # we checked already that this package is present! my $unwind_package; my $remove_unwind_container = 0; my $rev = $tlp->revision; @@ -1332,110 +1630,114 @@ sub action_update { next; } my $mediarev = $mediatlp->revision; - if ($rev < $mediarev) { - $nrupdated++; - if ($opt_list) { - info("$pkg: local: $rev, source: $mediarev\n"); + $nrupdated++; + if ($opts{"list"}) { + if ($::machinereadable) { + machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}); } else { - if ($opt_backup && !$opt_dry) { - $tlp->make_container("lzma", $root, - $opt_backupdir, "${pkg}.r" . $tlp->revision); - $unwind_package = - "$opt_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); - } + info("$pkg: local: $rev, source: $mediarev\n"); + } + } else { + if ($opts{"backup"} && !$opts{"dry-run"}) { + $tlp->make_container("lzma", $root, + $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); + $unwind_package = + "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.lzma"; + + if ($autobackup) { + # in case we do auto backups we remove older backups + clear_old_backups($pkg, $opts{"backupdir"}, $autobackup); } + } - if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { - add_w32_updater($mediatlp, $opt_dry); + if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { + grow_w32_updater($mediatlp, $opts{"dry-run"}, $rev, $mediarev); + } else { + if ($::machinereadable) { + machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}); + } else { + info("[$currnr/$totalnr] update: $pkg ($rev -> $mediarev)"); + } + $currnr++; + if ($opts{"dry-run"}) { + info("\n") unless $::machinereadable; + next; } else { - info("update: $pkg ($rev -> $mediarev)"); - if ($opt_dry) { - info("\n"); + info(" ... ") unless $::machinereadable; # more to come + } + + if (!$unwind_package) { + # no backup was made, so let us create a temporary .tar file + # of the package + my $tlp = $localtlpdb->get_package($pkg); + my ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp, + "__BACKUP_${pkg}.r" . $tlp->revision); + if ($s <= 0) { + tlwarn("\n$0: Creation of backup container of $pkg failed.\n"); + tlwarn("Continuing to update other packages, please retry...\n"); + # we should try to update other packages at least next; - } else { - info(" ... "); # more to come } - - if (!$unwind_package) { - # no backup was made, so let us create a temporary .tar file - # of the package - my $tlp = $localtlpdb->get_package($pkg); - my ($s, $m, $fullname) = $tlp->make_container("tar", $root, $temp, - "__BACKUP_${pkg}.r" . $tlp->revision); - if ($s <= 0) { - tlwarn("\n$0: Creation of backup container of $pkg failed.\n"); - tlwarn("Continuing to update other packages, please retry...\n"); - # we should try to update other packages at least - next; - } + $remove_unwind_container = 1; + $unwind_package = "$fullname"; + } + # first remove the package, then reinstall it + # this way we get rid of useless files + # force the deinstallation since we will reinstall it + # + # the remove_package should also remove empty dirs in case + # a dir is changed into a file + merge_into(\%ret, &remove_package($pkg, $localtlpdb)); + my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); + if (ref $foo) { + # installation succeeded because we got a reference + merge_into (\%ret, $foo); + logpackage("update: $pkg ($rev -> $mediarev)"); + unlink($unwind_package) if $remove_unwind_container; + } else { + # install_package returned a scalar, so error. + # now in fact we should do some cleanup, removing files and + # dirs from the new package before re-installing the old one. + # TODO + logpackage("failed update: $pkg ($rev -> $mediarev)"); + tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n"); + if (win32()) { + # w32 is notorious for not releasing a file immediately + # we experienced permission denied errors + my $newname = $unwind_package; + $newname =~ s/__BACKUP/___BACKUP/; + copy ("-f", $unwind_package, $newname); + # try to remove the file if has been created by us + unlink($unwind_package) if $remove_unwind_container; + # and make sure that the temporary file is removed in any case $remove_unwind_container = 1; - $unwind_package = "$fullname"; + $unwind_package = $newname; } - # first remove the package, then reinstall it - # this way we get rid of useless files - # force the deinstallation since we will reinstall it - # - # the remove_package should also remove empty dirs in case - # a dir is changed into a file - merge_into(\%ret, &remove_package($pkg, $localtlpdb)); - my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); - if (ref $foo) { - # installation succeeded because we got a reference - merge_into (\%ret, $foo); - logpackage("update: $pkg ($rev -> $mediarev)"); - unlink($unwind_package) if $remove_unwind_container; + my $instret = TeXLive::TLMedia->_install_package("$unwind_package", + [], $localtlpdb); + if ($instret) { + # now we have to include the tlpobj + my $tlpobj = TeXLive::TLPOBJ->new; + $tlpobj->from_file($root . "/tlpkg/tlpobj/$pkg.tlpobj"); + $localtlpdb->add_tlpobj($tlpobj); + $localtlpdb->save; + logpackage("restore: $pkg ($rev)"); + tlwarn("Restoring old package state succeeded.\n"); } else { - # install_package returned a scalar, so error. - # now in fact we should do some cleanup, removing files and - # dirs from the new package before re-installing the old one. - # TODO - logpackage("failed update: $pkg ($rev -> $mediarev)"); - tlwarn("\n\nInstallation of new version of $pkg did fail, trying to unwind.\n"); - if (win32()) { - # w32 is notorious for not releasing a file immediately - # we experienced permission denied errors - my $newname = $unwind_package; - $newname =~ s/__BACKUP/___BACKUP/; - copy ("-f", $unwind_package, $newname); - # try to remove the file if has been created by us - unlink($unwind_package) if $remove_unwind_container; - # and make sure that the temporary file is removed in any case - $remove_unwind_container = 1; - $unwind_package = $newname; - } - my $instret = TeXLive::TLMedia->_install_package("$unwind_package", - [], $localtlpdb); - if ($instret) { - # now we have to include the tlpobj - my $tlpobj = TeXLive::TLPOBJ->new; - $tlpobj->from_file($root . "/tlpkg/tlpobj/$pkg.tlpobj"); - $localtlpdb->add_tlpobj($tlpobj); - $localtlpdb->save; - logpackage("restore: $pkg ($rev)"); - tlwarn("Restoring old package state succeeded.\n"); - } else { - logpackage("restore failed: $pkg ($rev)"); - tlwarn("Restoring of old package did NOT succeed.\n"); - tlwarn("Most likely repair: run tlmgr install $pkg and hope.\n"); - } - unlink($unwind_package) if $remove_unwind_container; + logpackage("restore failed: $pkg ($rev)"); + tlwarn("Restoring of old package did NOT succeed.\n"); + tlwarn("Most likely repair: run tlmgr install $pkg and hope.\n"); } - info("done\n"); + unlink($unwind_package) if $remove_unwind_container; } + info("done\n") unless $::machinereadable; } - } elsif ($rev > $mediarev) { - print "$pkg: local revision ($rev) is newer than revision in $location" - . " ($mediarev), not updating.\n"; - next; } } + # that already checks whether we actually have to do something - close_w32_updater(); - if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opt_all) { + write_w32_updater(); + 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"); @@ -1447,6 +1749,7 @@ sub action_update { return(\%ret); } + # INSTALL # # tlmgr install foo bar baz @@ -1477,48 +1780,47 @@ sub action_update { # anymore! That has all to be done by hand. # sub action_install { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("install"); } 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, !$opt_force)) { - die "not continuing, please see warning above!"; + if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) { + if ($opts{"force"}) { + tlwarn("Continuing due to --force\n"); + } else { + if ($::gui_mode) { + # return here and don't do any updates + return; + } else { + die "tlmgr: Not continuing, please see warning above!\n"; + } + } } - $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"); @@ -1526,12 +1828,12 @@ sub action_install { } } 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); } @@ -1575,15 +1877,41 @@ sub action_list { return; } - + +# OPTION +# sub action_option { - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("config"); } my $what = shift @ARGV; $what = "show" unless defined($what); init_local_db(); - if ($what =~ m/^location$/i) { + if ($what =~ m/^show$/i) { + print "Default installation location (location): ", + $localtlpdb->option_location, "\n"; + print "Create formats on installation (formats): ", + ($localtlpdb->option_create_formats ? "yes" : "no"), "\n"; + print "Install documentation files (docfiles): ", + ($localtlpdb->option_install_docfiles ? "yes": "no"), "\n"; + print "Install source files (srcfiles): ", + ($localtlpdb->option_install_srcfiles ? "yes": "no"), "\n"; + print "Destination for symlinks for binaries (sys_bin): ", + $localtlpdb->option_sys_bin, "\n" + if $localtlpdb->option_sys_bin; + print "Destination for symlinks for man pages (sys_man): ", + $localtlpdb->option_sys_man, "\n" + if $localtlpdb->option_sys_man; + print "Destination for symlinks for info docs (sys_info): ", + $localtlpdb->option_sys_info, "\n" + if $localtlpdb->option_sys_info; + print "Directory for backups (backupdir): ", + $localtlpdb->option("backupdir"), "\n" + if $localtlpdb->option("backupdir"); + print "Number of backups to keep (autobackup): ", + $localtlpdb->option("autobackup"), "\n" + if $localtlpdb->option("autobackup"); + } elsif ($what =~ m/^location$/i) { # changes the default location my $loc = shift @ARGV; if ($loc) { @@ -1602,70 +1930,92 @@ sub action_option { $localtlpdb->option_location($loc); $localtlpdb->save; } else { - info("Default installation location: " - . $localtlpdb->option_location . "\n"); + info("Default installation location: ", + $localtlpdb->option_location, "\n"); } } elsif ($what =~ m/^docfiles$/i) { # changes the default docfiles my $loc = shift @ARGV; if (defined($loc)) { - print "Defaulting to", ($loc ? "" : " not"), - " installing documentation files.\n"; + info("tlmgr: defaulting to", ($loc ? "" : " not"), + " installing documentation files.\n"); $localtlpdb->option_install_docfiles($loc); $localtlpdb->save; } else { - print "Install documentation files: ", - $localtlpdb->option_install_docfiles, "\n"; + info("Install documentation files: ", + $localtlpdb->option_install_docfiles, "\n"); } } elsif ($what =~ m/^srcfiles$/i) { # changes the default srcfiles my $loc = shift @ARGV; if (defined($loc)) { - print "Defaulting to", ($loc ? "" : " not"), - " installing source files.\n"; + info("tlmgr: defaulting to", ($loc ? "" : " not"), + " installing source files.\n"); $localtlpdb->option_install_srcfiles($loc); $localtlpdb->save; } else { - print "Install source files: ", - $localtlpdb->option_install_srcfiles, "\n"; + info("Install source files: ", + $localtlpdb->option_install_srcfiles, "\n"); } } elsif ($what =~ m/^formats$/i) { # changes the default formats my $loc = shift @ARGV; if (defined($loc)) { - print "Defaulting to", ($loc ? "" : " not"), - " generating format files on installation.\n"; + info("tlmgr: defaulting to", ($loc ? "" : " not"), + " generating format files on installation.\n"); $localtlpdb->option_create_formats($loc); $localtlpdb->save; } else { - print "Create formats on installation: ", - $localtlpdb->option_create_formats, "\n"; + info("Create formats on installation: ", + $localtlpdb->option_create_formats, "\n"); } - } elsif ($what =~ m/^show$/i) { - print "Default installation location (location): ", - $localtlpdb->option_location, "\n"; - print "Create formats on installation (formats): ", - ($localtlpdb->option_create_formats ? "yes" : "no"), "\n"; - print "Install documentation files (docfiles): ", - ($localtlpdb->option_install_docfiles ? "yes": "no"), "\n"; - print "Install source files (srcfiles): ", - ($localtlpdb->option_install_srcfiles ? "yes": "no"), "\n"; - print "Directory for backups (backupdir): ", - $localtlpdb->option("backupdir"), "\n" - if $localtlpdb->option("backupdir"); - print "Number of backups to keep (autobackup): ", - $localtlpdb->option("autobackup"), "\n" - if $localtlpdb->option("autobackup"); - } else { + } elsif ($what =~ m/^sys_man$/i) { + # changes the default sys_man + my $loc = shift @ARGV; + if (defined($loc)) { + info("tlmgr: setting destination for symlinks to man pages to $loc\n"); + $localtlpdb->option_sys_man ($loc); + $localtlpdb->save; + } else { + info("Destination for symlinks to man pages: ", + $localtlpdb->option_sys_man, "\n"); + } + } elsif ($what =~ m/^sys_info$/i) { + # changes the default sys_info + my $loc = shift @ARGV; + if (defined($loc)) { + info("tlmgr: setting destination for symlinks to info pages to $loc\n"); + $localtlpdb->option_sys_info ($loc); + $localtlpdb->save; + } else { + info("Default destination for symlinks to info pages: ", + $localtlpdb->option_sys_info, "\n"); + } + } elsif ($what =~ m/^sys_bin$/i) { + # changes the default sys_bin + my $loc = shift @ARGV; + if (defined($loc)) { + info("tlmgr: setting destination for symlinks to binaries to $loc\n"); + $localtlpdb->option_sys_bin ($loc); + $localtlpdb->save; + } else { + info("Default destination for symlinks to binaries: ", + $localtlpdb->option_sys_bin, "\n"); + } + } elsif (member($what, @AllowedConfigOptions)) { + # for all further options not handled above, we check whether they + # appear in the list of allowed options; if they do, we set/read + # the values, otherwise we warn. my $val = shift @ARGV; if (defined($val)) { - print "Setting option $what to $val.\n"; + info("tlmgr: setting option $what to $val.\n"); $localtlpdb->option($what,$val); $localtlpdb->save; } else { - print "Option $what = ", $localtlpdb->option($what), "\n";; + info("Option $what = ", $localtlpdb->option($what), "\n"); } - #warn "Setting other options currently not supported, please edit texlive.tlpdb!"; + } else { + tlwarn "Option $what is currently not supported.\n"; } return; } @@ -1675,18 +2025,15 @@ sub action_option { # sub action_arch { if ($^O=~/^MSWin(32|64)$/i) { - printf STDERR "action `arch' not supported on Windows\n"; + warn("action `arch' not supported on Windows\n"); } - if ($opt_gui) { + if ($opts{"gui"}) { action_gui("arch"); } 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 @@ -1729,8 +2076,8 @@ sub action_arch { if ($dep =~ m/^(.*)\.ARCH$/) { # we have to install something foreach my $a (@todoarchs) { - if ($opt_dry) { - print "Installing $pkg.$a\n"; + if ($opts{"dry-run"}) { + info("Installing $pkg.$a\n"); } else { info("install: $pkg.$a\n"); merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb)); @@ -1759,11 +2106,12 @@ sub action_arch { return(\%ret); } + +# GENERATE +# 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; init_local_db(); @@ -1813,105 +2161,79 @@ sub action_generate { return; } -# set global $location variable. -# if we cannot read tlpdb, die if arg SHOULD_I_DIE is true. + +# GUI # -sub init_local_db { - my ($should_i_die) = @_; - $localtlpdb = TeXLive::TLPDB->new ("root" => $Master); - die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); - # setup the programs, for w32 we need the shipped wget/lzma etc, so we - # pass the location of these files to setup_programs. - my $ret = setup_programs("$Master/tlpkg/installer", - $localtlpdb->option_platform); - if ($ret == -1) { - tlwarn("no binary of lzmadec for $::_platform_ detected.\n"); - if (defined($should_i_die) && $should_i_die) { - exit 1; - } else { - tlwarn("Continuing anyway ...\n"); - } - } - if (!$ret) { - 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); +sub action_gui { + my ($guiscreen) = @_; + # yes, two times to make perl warnings shut up ... + $::guiscreen = $guiscreen; + $::guiscreen = $guiscreen; + unshift (@INC, "$Master/texmf/scripts/texlive/tlmgrgui"); + eval { require Tk; }; + if ($@) { + # that didn't work out, give some usefull error message and stop + my $tkmissing = 0; + if ($@ =~ /^Can\'t locate Tk\.pm/) { + $tkmissing = 1; + } + if ($tkmissing) { + if ($^O=~/^MSWin(32|64)$/i) { + # that should not happen, we are shipping Tk!! + require Win32; + my $msg = "Cannot load Tk, that should not happen as we ship it!\nHow did you start tlmgrgui??\n(Error message: $@)\n"; + Win32::MsgBox($msg, 1|Win32::MB_ICONSTOP(), "Warning"); + } else { + printf STDERR " +Cannot load Tk, thus the GUI cannot be started! +The Perl/Tk module is not shipped with the TeX Live installation. +You have to install it to get tlmgr GUI running. See +http://tug.org/texlive/distro.html for more details. + +"; + } } else { - tlwarn("Continuing anyway ...\n"); + printf STDERR "Problem loading Tk: $@\n"; } + exit 1; } - # let cmd line options override the settings in localtlpdb - my $loc = $localtlpdb->option_location; - if (defined($loc)) { - $location = $loc; - } - if (defined($opt_location)) { - $location = $opt_location; - } - if (!defined($location)) { - die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!"); - } - if ($location =~ m/^ctan$/i) { - $location = "$TeXLive::TLConfig::TeXLiveURL"; - } - # we normalize the path only if it is - # - neither a URL starting with http or ftp - # - if we are on windows it does not start with Drive: - if (! ( $location =~ m!^(http|ftp)://!i || - (win32() && $location =~ m!^.:!) ) ) { - # seems to be a local path, try to normalize it - my $testloc = abs_path($location); - # however, if we were given a url, that will get "normalized" to the - # empty string, it not being a path. Restore the original value if so. - $location = $testloc if $testloc; + + # now check that we can actually create a top level window, + # on darwin the X server might not be started, or on unix we are working + # on a console, or whatever. + eval { my $foo = Tk::MainWindow->new; $foo->destroy; }; + if ($@) { + printf STDERR "perl/Tk unusable, cannot create main windows. +That could be a consequence of not having X Windows installed or started! +Error message from creating MainWindow: + $@ +"; + exit 1; } -} -sub action_gui { - my ($guiscreen) = @_; - my $perlbin = "perl"; - my $perlbinquote = "perl"; - my $perlscript = "$Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl"; - if ($^O=~/^MSWin(32|64)$/i) { - $ENV{'PERL5LIB'} = "$Master/tlpkg/tlperl/lib"; - $perlbin = "$Master/tlpkg/tlperl/bin/perl.exe"; - $perlbinquote = "\"$Master/tlpkg/tlperl/bin/perl.exe\""; - $perlbinquote =~ s!/!\\!g; - $perlscript = "\"$perlscript\""; - $perlscript =~ s!/!\\!g; - } - my @cmdline; - push @cmdline, $perlbinquote, $perlscript; - push @cmdline, "--lang", "$opt_gui_lang" - if (defined($opt_gui_lang)); - push @cmdline, "--location", "$opt_location" - if (defined($opt_location)); - push @cmdline, "--logfile", "$::LOGFILENAME" - if (defined($::LOGFILENAME)); - push @cmdline, "-v" if ($::opt_verbosity > 0); - push @cmdline, "-v" if ($::opt_verbosity > 1); - push @cmdline, "-q" if ($::opt_quiet > 0); - if (defined($guiscreen)) { - if (($guiscreen eq "install") || ($guiscreen eq "update")) { - push @cmdline, "--load"; - } - push @cmdline, "--guiscreen", $guiscreen; - } - exec $perlbin @cmdline; - die("Cannot execute the GUI script\n"); + # be sure that sub actions do *not* finish + $::gui_mode = 1; + # also unset the $opts{"gui"} to make recursive calls to action_* not starting + # another GUI instance (or better trying to ...) + $opts{"gui"} = 0; + + require("tlmgrgui2.pl"); + # should not be reached + exit(1); } + +# UNINSTALL +# sub action_uninstall { if (win32()) { 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): "; @@ -1922,120 +2244,35 @@ sub action_uninstall { } } print ("Ok, removing the whole installation:\n"); - init_local_db; - my $tlpdb = $localtlpdb; - my $opt_symlinks = 0; - my ($sys_bin,$sys_info,$sys_man); - my ($texdir,$texmflocal,$texmfhome,$texmfsysvar); - if ($tlpdb) { - $sys_bin = $tlpdb->option_sys_bin; - $sys_man = $tlpdb->option_sys_man; - $sys_info= $tlpdb->option_sys_info; - $opt_symlinks = $tlpdb->option_create_symlinks; - $texdir = $Master; - $texmfhome = `kpsewhich -var-value=TEXMFHOME`; chomp($texmfhome); - $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`; chomp($texmfsysvar); - $texmflocal = `kpsewhich -var-value=TEXMFLOCAL`; chomp($texmflocal); - } else { - die("cannot find tlpdb in $Master"); - } - # remove the links missing - if ($opt_symlinks) { - my @files; - if ((-d "$sys_bin") && (-w "$sys_bin")) { - my $plat_bindir; - if (-l "$sys_bin/pdftex") { - my $fullpath = readlink("$sys_bin/pdftex"); - if ($fullpath =~ m;^$Master/bin/(.*)/[^/]*$;) { - $plat_bindir = $1; - } - } else { - warn "$sys_bin/pdftex not present or not a link, not removing any link of binaries!\n"; - } - if ($plat_bindir) { - @files = `ls "$Master/bin/$plat_bindir"`; - chomp(@files); - foreach my $f (@files) { - next if (! -r "$sys_bin/$f"); - if ((-l "$sys_bin/$f") && - (readlink("$sys_bin/$f") =~ m;^$Master/bin/$plat_bindir/;)) { - unlink("$sys_bin/$f"); - } else { - warn ("not removing $sys_bin/$f, not a link or wrong destination!\n"); - } - } - } - `rmdir "$sys_bin" 2>/dev/null`; - } else { - warn "destination of bin symlink $sys_bin not writable, no removal of links of bin files done!\n"; - } - # info files - if (-w $sys_info) { - @files = `ls "$Master/texmf/doc/info"`; - chomp(@files); - foreach my $f (@files) { - next if (! -r "$sys_info/$f"); - if ((-l "$sys_info/$f") && - (readlink("$sys_info/$f") =~ m;^$Master/texmf/doc/info/;)) { - unlink("$sys_info/$f"); - } else { - warn ("not removing $sys_info/$f, not a link or wrong destination!\n"); - } - } - `rmdir "$sys_info" 2>/dev/null`; - } else { - warn "destination of info symlink $sys_info not writable, no removal of links of info files done!\n"; - } - # man files - if (-w $sys_man) { - my $foo = `(cd "$Master/texmf/doc/man" && echo *)`; - my @mans = split ' ', $foo; - chomp(@mans); - foreach my $m (@mans) { - my $mandir = "$Master/texmf/doc/man/$m"; - next unless -d $mandir; - next unless -d "$sys_man/$m"; - @files = `ls "$mandir"`; - chomp(@files); - foreach my $f (@files) { - next if (! -r "$sys_man/$m/$f"); - if ((-l "$sys_man/$m/$f") && - (readlink("$sys_man/$m/$f") =~ m;^$Master/texmf/doc/man/$m/;)) { - unlink("$sys_man/$m/$f"); - } else { - warn ("not removing $sys_man/$m/$f, not a link or wrong destination!\n"); - } - } - # ignore errors, it might be not empty - `rmdir "$sys_man/$m" 2>/dev/null`; - } - `rmdir "$sys_man" 2>/dev/null`; - } else { - warn "destination of man symlink $sys_man not writable, no removal of links of man files done!\n"; - } - } - # + init_local_db(); + $localtlpdb->remove_symlinks; # now do remove the rest - system("rm", "-rf", "$texdir/texmf-dist"); - system("rm", "-rf", "$texdir/texmf-doc"); - system("rm", "-rf", "$texdir/texmf-var"); - system("rm", "-rf", "$texdir/texmf"); - system("rm", "-rf", "$texdir/tlpkg"); - system("rm", "-rf", "$texdir/bin"); - if (-d "$texdir/temp") { - system("rmdir", "--ignore-fail-on-non-empty", "$texdir/temp"); - } - unlink("$texdir/install-tl.log"); + system("rm", "-rf", "$Master/texmf-dist"); + system("rm", "-rf", "$Master/texmf-doc"); + system("rm", "-rf", "$Master/texmf-var"); + system("rm", "-rf", "$Master/texmf"); + system("rm", "-rf", "$Master/tlpkg"); + system("rm", "-rf", "$Master/bin"); + system("rm", "-rf", "$Master/readme-html.dir"); + system("rm", "-rf", "$Master/readme-txt.dir"); + for my $f (qw/doc.html index.html LICENSE.CTAN LICENSE.TL README + README.usergroups release-texlive.txt texmf.cnf/) { + system("rm", "-f", "$Master/$f"); + } + if (-d "$Master/temp") { + system("rmdir", "--ignore-fail-on-non-empty", "$Master/temp"); + } + unlink("$Master/install-tl.log"); # should we do that???? - system("rm", "-rf", "$texdir/texmf-config"); - system("rmdir", "--ignore-fail-on-non-empty", "$texdir"); + system("rm", "-rf", "$Master/texmf-config"); + system("rmdir", "--ignore-fail-on-non-empty", "$Master"); } +# CHECK +# 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(); @@ -2053,7 +2290,6 @@ sub action_check { finish($ret); } -# # check file coverage, roughly equivalent to tlpkg/bin/check-file-coverage # sub check_files { @@ -2108,14 +2344,13 @@ sub check_files { my $arch = $localtlpdb->option_platform; return $ret if ($arch eq "win32" || $arch eq "universal-darwin"); - # # do check that all files in the trees are covered # my @IgnorePatterns = qw! .mkisofsrc$ autorun.inf$ support/ source/ setuptl/ texmf-dist/ls-R$ texmf-doc/ls-R$ texmf/ls-R$ - tlpkg/tlpsrc tlpkg/bin tlpkg/lib/ tlpkg/libexec tlpkg/tests/ tlpkg/etc/ + tlpkg/tlpsrc tlpkg/bin tlpkg/lib/ tlpkg/libexec tlpkg/tests/ tlpkg/etc tlpkg/texlive.tlpdb tlpkg/tlpobj texmf-var/ @@ -2166,7 +2401,6 @@ sub check_files { return($ret); } -# # check collections # sub check_collections { @@ -2186,34 +2420,90 @@ sub check_collections { } -# + +# Subroutines galore. +# +# set global $location variable. +# if we cannot read tlpdb, die if arg SHOULD_I_DIE is true. +# +sub init_local_db { + my ($should_i_die) = @_; + $localtlpdb = TeXLive::TLPDB->new ("root" => $Master); + die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); + # setup the programs, for w32 we need the shipped wget/lzma etc, so we + # pass the location of these files to setup_programs. + my $ret = setup_programs("$Master/tlpkg/installer", + $localtlpdb->option_platform); + if ($ret == -1) { + tlwarn("no binary of lzmadec for $::_platform_ detected.\n"); + if (defined($should_i_die) && $should_i_die) { + exit 1; + } else { + tlwarn("Continuing anyway ...\n"); + } + } + if (!$ret) { + 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); + } else { + tlwarn("Continuing anyway ...\n"); + } + } + # let cmd line options override the settings in localtlpdb + my $loc = $localtlpdb->option_location; + if (defined($loc)) { + $location = $loc; + } + 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!"); + } + if ($location =~ m/^ctan$/i) { + $location = "$TeXLive::TLConfig::TeXLiveURL"; + } + # we normalize the path only if it is + # - neither a URL starting with http or ftp + # - if we are on windows it does not start with Drive: + if (! ( $location =~ m!^(http|ftp)://!i || + (win32() && $location =~ m!^.:!) ) ) { + # seems to be a local path, try to normalize it + my $testloc = abs_path($location); + # however, if we were given a url, that will get "normalized" to the + # empty string, it not being a path. Restore the original value if so. + $location = $testloc if $testloc; + } +} + + # initialize the global $tlmediasrc object, or die. # uses the global $location. # sub init_tlmedia { - if ($location =~ m/^($TeXLiveServerURL|ctan$)/) { - $location = give_ctan_mirror(); - } - info("tlmgr: installation location $location\n"); - # $tlmediasrc is a global variable - $tlmediasrc = TeXLive::TLMedia->new($location); - die($loadmediasrcerror . $location) unless defined($tlmediasrc); -} + if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { + # nothing to be done + } else { + if ($location =~ m/^($TeXLiveServerURL|ctan$)/) { + $location = give_ctan_mirror(); + } + # that "location-url" line should not be changed since GUI programs + # depend on it. + print "location-url\t$location\n" if $::machinereadable; + info("tlmgr: installation location $location\n"); -# -# the logpackage function -# if the packagelog variable is set then write to PACKAGELOG filehandle -# -sub logpackage { - if ($packagelogfile) { - $packagelogged++; - my $tim = localtime(); - print PACKAGELOG "[$tim] @_\n"; + # $tlmediasrc is a global variable + $tlmediasrc = TeXLive::TLMedia->new($location); + $tlmediatlpdb = $tlmediasrc->tlpdb; + die($loadmediasrcerror . $location) unless defined($tlmediasrc); } } -# -# finish # evaluates only the -pause option, and then exits. +# finish handles the -pause option (wait for input from stdin), +# and then exits unless the global $::gui_mode is set, in which case we +# merely return. +# sub finish { my ($ret) = @_; @@ -2221,29 +2511,42 @@ sub finish { print "tlmgr: exiting unsuccessfully (status $ret).\n"; } - if ($opt_pause) { - print "Please press to exit the program.\n"; + if ($opts{"pause"}) { + print "Press Enter to exit the program.\n"; ; } - exit($ret); + if ($::gui_mode) { + return($ret); + } else { + exit($ret); + } } +# if the packagelog variable is set then write to PACKAGELOG filehandle +# +sub logpackage { + if ($packagelogfile) { + $packagelogged++; + my $tim = localtime(); + print PACKAGELOG "[$tim] @_\n"; + } +} # clear the backup dir for $pkg and keep only $autobackup packages # 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); @@ -2253,14 +2556,13 @@ sub clear_old_backups 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++; } } -# # check for updates to tlcritical packages # sub check_for_critical_updates @@ -2308,7 +2610,6 @@ sub check_for_critical_updates } -# # return all the directories from which all content will be removed # # idea: @@ -2432,6 +2733,12 @@ Windows via the registry, on Unix via C). If that fails you can select a different language by giving this option a two-letter language code. +=item B<--machine-readable> + +In lieu of the normal output intended for human consumption, write to +standard output in a fixed format more suitable for machine parsing. +See the L section below for details. + =item B<--package-logfile> I B logs all package actions (install, remove, update, failed @@ -2547,8 +2854,8 @@ written to the terminal. This is a more detailed report than C<--list>. =item B<--force> If updates to tlmgr itself (that is, the infrastructure packages) are -present, tlmgr will not perform the update unless this option (or -C<--list>) is given. +present, tlmgr will not perform the update unless this option is given. +(C<--list> is still performed regardless of this option.) =item B<--no-remove> @@ -2725,6 +3032,9 @@ Possible values for I are: C (install source files), C (default directory for backups), C (number of backups to keep). + C (location where binaries are linked to by action symlinks) + C (location where man pages are linked to by action symlinks) + C (location where info pages are linked to by action symlinks) Perhaps the most common use of C