summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-01-19 22:09:34 +0000
committerNorbert Preining <preining@logic.at>2009-01-19 22:09:34 +0000
commite0d7ae48bf5c441b6c4510e52cc70d06c8be0b9f (patch)
treecfa3aa297b83e0124b587c8210bd9d6973743836 /Master
parent5fa9b92e3aceb82b4b0730c725d86424f0e1af78 (diff)
tlmgr2 -> tlmgr
git-svn-id: svn://tug.org/texlive/trunk@11917 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rwxr-xr-xMaster/bin/win32/tlmgr.bat28
-rwxr-xr-xMaster/bin/win32/tlmgr1.bat8
-rwxr-xr-xMaster/bin/win32/tlmgr2.bat24
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl2131
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr1.pl (renamed from Master/texmf/scripts/texlive/tlmgr2.pl)2131
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl2
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui/gui-arch1.pl (renamed from Master/texmf/scripts/texlive/tlmgrgui/gui-arch2.pl)2
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui/gui-config.pl166
-rw-r--r--Master/texmf/scripts/texlive/tlmgrgui/gui-config1.pl (renamed from Master/texmf/scripts/texlive/tlmgrgui/gui-config2.pl)166
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl756
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl78
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl713
-rw-r--r--Master/tlpkg/tlpsrc/00texlive.core.tlpsrc10
-rw-r--r--Master/tlpkg/tlpsrc/bin-texlive.tlpsrc8
14 files changed, 3115 insertions, 3108 deletions
diff --git a/Master/bin/win32/tlmgr.bat b/Master/bin/win32/tlmgr.bat
index fe949613d7c..3227c961498 100755
--- a/Master/bin/win32/tlmgr.bat
+++ b/Master/bin/win32/tlmgr.bat
@@ -1,8 +1,24 @@
@echo off
-rem tl-w32-starter.bat
-rem universal script starter, batch file part
-rem this program calls the tl-w32-wrapper.texlua
+rem Advanced started for tlmgr2 with auto-update
+rem Copyright 2009 by Tomasz M. Trzeciak <t.m.trzeciak@googlemail.com>
+rem Public Domain
+rem
+
setlocal
-set ownpath=%~dp0%
-texlua "%ownpath%tl-w32-wrapper.texlua" "%~dpn0" %*
-endlocal
+rem TL installation root
+for %%P in ("%~dp0..\..") do set "tlroot=%%~fP"
+
+rem Start tlmgr
+set PERL5LIB=%tlroot%\tlpkg\tlperl\lib
+"%tlroot%\tlpkg\tlperl\bin\perl.exe" "%tlroot%\texmf\scripts\texlive\tlmgr2.pl" %*
+
+rem Check for updater script
+set "updater=%tlroot%\tlpkg\installer\updater.bat"
+if not exist "%updater%" exit /b
+if exist "%updater%.bat" del "%updater%.bat"
+ren "%updater%" updater.bat.bat
+if errorlevel 1 exit /b 1
+
+rem Run updater script
+endlocal & call "%updater%.bat" & exit /b
+
diff --git a/Master/bin/win32/tlmgr1.bat b/Master/bin/win32/tlmgr1.bat
new file mode 100755
index 00000000000..fe949613d7c
--- /dev/null
+++ b/Master/bin/win32/tlmgr1.bat
@@ -0,0 +1,8 @@
+@echo off
+rem tl-w32-starter.bat
+rem universal script starter, batch file part
+rem this program calls the tl-w32-wrapper.texlua
+setlocal
+set ownpath=%~dp0%
+texlua "%ownpath%tl-w32-wrapper.texlua" "%~dpn0" %*
+endlocal
diff --git a/Master/bin/win32/tlmgr2.bat b/Master/bin/win32/tlmgr2.bat
deleted file mode 100755
index 3227c961498..00000000000
--- a/Master/bin/win32/tlmgr2.bat
+++ /dev/null
@@ -1,24 +0,0 @@
-@echo off
-rem Advanced started for tlmgr2 with auto-update
-rem Copyright 2009 by Tomasz M. Trzeciak <t.m.trzeciak@googlemail.com>
-rem Public Domain
-rem
-
-setlocal
-rem TL installation root
-for %%P in ("%~dp0..\..") do set "tlroot=%%~fP"
-
-rem Start tlmgr
-set PERL5LIB=%tlroot%\tlpkg\tlperl\lib
-"%tlroot%\tlpkg\tlperl\bin\perl.exe" "%tlroot%\texmf\scripts\texlive\tlmgr2.pl" %*
-
-rem Check for updater script
-set "updater=%tlroot%\tlpkg\installer\updater.bat"
-if not exist "%updater%" exit /b
-if exist "%updater%.bat" del "%updater%.bat"
-ren "%updater%" updater.bat.bat
-if errorlevel 1 exit /b 1
-
-rem Run updater script
-endlocal & call "%updater%.bat" & exit /b
-
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 = <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 = <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 = <STDIN>;
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 <<EOF;
-tlpkg\\installer\\lzma\\lzmadec.win32.exe < temp\\$pkg.tar.lzma > 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 <ENTER> to exit the program.\n";
+ if ($opts{"pause"}) {
+ print "Press Enter to exit the program.\n";
<STDIN>;
}
- 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<LC_MESSAGES>). 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</"MACHINE-READABLE OUTPUT"> section below for details.
+
=item B<--package-logfile> I<file>
B<tlmgr> 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<key> are:
C<srcfiles> (install source files),
C<backupdir> (default directory for backups),
C<autobackup> (number of backups to keep).
+ C<sys_bin> (location where binaries are linked to by action symlinks)
+ C<sys_man> (location where man pages are linked to by action symlinks)
+ C<sys_info> (location where info pages are linked to by action symlinks)
Perhaps the most common use of C<option> is if you originally installed from
DVD, and want to permanently change the installation to get further
@@ -2749,24 +3059,45 @@ with 0 as the values.
In the C<--clean> mode of the C<backup> action this option also
specifies the number to be kept.
+=head2 symlinks [add|remove]
+
+Adds or removes symlinks for binaries, man pages, and info pages in the
+directories specified by the respective options (see above).
+
=head2 paper
=over 4
-=item B<paper a4>
-
-=item B<paper letter>
+=item B<paper [a4|letter]>
-=item B<[xdvi|dvips|pdftex|dvipdfm|dvipdfmx|context] paper [help|I<papersize>|--list]>
+=item B<S<xdvi|pdftex|dvips|dvipdfmx|dvipdfm|context paper [I<papersize>|--list]>>
=back
-Configures the system wide paper settings, either for all programs at
-once (first two forms), or just for the specified program (third
-form). The third form with C<--list> outputs all known papersizes for the
-specified program.
+With no arguments (C<tlmgr paper>), shows the default paper size setting
+for all known programs.
+
+With one argument (e.g., C<tlmgr paper a4>), sets the default for all
+known programs to that paper size.
+
+With a program given as the first argument and no paper size specified
+(e.g., C<tlmgr dvips paper>), shows the default paper size for that
+program.
+
+With a program given as the first argument and a paper size as the last
+argument (e.g., C<tlmgr dvips paper a4>), set the default for that
+program to that paper size.
+
+With a program given as the first argument and C<--list> given as the
+last argument (e.g., C<tlmgr dvips paper --list>), shows all valid paper
+sizes for that program. The first size shown is the default.
+Incidentally, this syntax of having a specific program name before the
+C<paper> keyword may seem strange. It is inherited from the
+longstanding C<texconfig> script, which supports other configuration
+settings for some programs, notably C<dvips>. C<tlmgr> does not support
+those extra settings at present.
=head2 arch list|add I<arch>...
@@ -2868,7 +3199,7 @@ Do not ask for confirmation, remove immediately.
=back
-=head2 generate
+=head2 generate [I<option>]... I<what>
=over 4
@@ -2884,24 +3215,28 @@ Do not ask for confirmation, remove immediately.
=back
-The I<generate> action overwrites any manual changes made in the
+The C<generate> action overwrites any manual changes made in the
respective files: it recreates them from scratch.
-For fmtutil and the language files, this is normal, and both the TeX
+For C<fmtutil> and the language files, this is normal, and both the TeX
Live installer and C<tlmgr> routinely call I<generate> for them.
-For updmap, however, neither the installer nor C<tlmgr> use I<generate>,
-because the result would be to disable all maps which have been manually
-installed via C<updmap-sys --enable>, e.g., for proprietary or local
-fonts. Only the changes in the C<--localcfg> file mentioned below are
-incorporated by I<generate>.
-
-On the other hand, if you only use the fonts and font packages within
-TeX Live, there is nothing wrong with using I<generate updmap>. Indeed,
-we use it to generate the C<updmap.cfg> file that is maintained in the
-live source repository.
-
-In more detail: I<generate> remakes any of the four config files
+For C<updmap>, however, neither the installer nor C<tlmgr> use
+C<generate>, because the result would be to disable all maps which have
+been manually installed via S<C<updmap-sys --enable>>, e.g., for
+proprietary or local fonts. Only the changes in the C<--localcfg> file
+mentioned below are incorporated by I<generate>. Furthermore, C<tlmgr>
+updates and maintains the final C<updmap.cfg> in C<TEXMFSYSCONFIG> (the
+others use C<TEXMFSYSVAR>) because that is the location that
+C<updmap-sys> (via C<tcfmgr>) uses.
+
+Notwithstanding the above, if you only use the fonts and font packages
+within TeX Live, and maintain your local fonts (if any) with the local
+config file, there is nothing wrong with using C<generate updmap>.
+Indeed, we use it ourselves to generate the C<updmap.cfg> file that is
+maintained in the live source repository.
+
+In more detail: C<generate> remakes any of the four config files
C<language.dat>, C<language.def>, C<fmtutil.cnf>, and C<updmap.cfg> from
the information present in the local TLPDB. If the files
C<language-local.dat>, C<language-local.def>, C<fmtutil-local.cnf>, or
@@ -2920,7 +3255,8 @@ Options:
=item B<--dest> I<output file>
specifies the output file (defaults to the respective location in
-C<TEXMFSYSVAR>). If B<--dest> is given to C<generate language>, its
+C<TEXMFSYSVAR> for C<language*> and C<fmtutil>, and C<TEXMFSYSCONFIG>
+for C<updmap>). If B<--dest> is given to C<generate language>, its
value will be used for the C<language.dat> output, and C<.def> will be
appended to the value for the name of the C<language.def> output file.
(This is just to avoid overwriting; if you want a specific name for each
@@ -2929,15 +3265,116 @@ output file, we recommend invoking C<tlmgr> twice.)
=item B<--localcfg> I<local conf file>
specifies the (optional) local additions (defaults to the respective
-location in C<TEXMFSYSVAR>).
+location in C<TEXMFLOCAL>).
=back
The respective locations are as follows:
- C<tex/generic/config/language.dat> (and C<language-local.dat>)
- C<tex/generic/config/language.def> (and C<language-local.def>)
- C<web2c/fmtutil.cnf> (and C<fmtutil-local.cnf>)
- C<web2c/updmap.cfg> (and C<updmap-local.cfg>)
+
+ tex/generic/config/language.dat (and language-local.dat);
+ tex/generic/config/language.def (and language-local.def);
+ web2c/fmtutil.cnf (and fmtutil-local.cnf);
+ web2c/updmap.cfg (and updmap-local.cfg).
+
+
+=head1 MACHINE-READABLE OUTPUT
+
+Given the C<--machine-readable> option, C<tlmgr> writes to stdout in the
+fixed line-oriented format described here, and the usual informational
+messages for human consumption are written to stderr (normally they are
+written to stdout). The idea is that a program can get all the
+information it needs by reading stdout.
+
+Currently this option only applies to the L<update|/"update
+[I<option>]... [I<pkg>]..."> action. The output format is as follows:
+
+ fieldname "\t" value
+ ...
+ "end-of-header"
+ pkgname status localrev serverrev size
+ ...
+
+Currently the header section contains two fields. The field name and
+value are separated by a tab. Line endings may be LF or CRLF depending
+on the current platform.
+
+=over 4
+
+=item C<location-url> I<location>
+
+The I<location> may be a url (including C<file:///foo/bar/...>), or a
+directory name (C</foo/bar>). It is the server repository from which
+the new package information was drawn.
+
+=item C<total-bytes> I<count>
+
+The I<count> is simply a decimal number, the sum of all the packages
+given subsequently that need updating or installing.
+
+=back
+
+Then comes a line with only the literal string C<end-of-header>.
+
+Each following line until EOF reports on one package. The fields on
+each line are separated by a tab. Here are the fields.
+
+=over 4
+
+=item I<pkgname>
+
+The TeX Live package identifier, with a possible architecture suffix for
+executables. For instance, C<pdftex> and C<pdftex.i386-linux> are
+given as two separate packages, one on each line.
+
+=item I<status>
+
+The status of the package update. One character, as follows:
+
+=over 8
+
+=item C<d>
+
+The package was removed on the server.
+
+=item C<f>
+
+The package was removed on the server even though a collection depended
+on it. (E.g., the user ran C<tlmgr remove --force>.)
+
+=item C<u>
+
+Normal update is needed.
+
+=item C<r>
+
+Reversed non-update: the locally-installed version is newer than the
+version on the server.
+
+=item C<a>
+
+Automatically-determined need for installation, the package is new on
+the server and is (most probably) part of an installed collection.
+
+=back
+
+=item I<localrev>
+
+The revision number of the installed package.
+
+=item I<serverrev>
+
+The revision number of the package on the server.
+
+=item I<size>
+
+The size in bytes of the package on the server.
+
+=back
+
+
+
+If you are developing a program that uses this output, and find that
+changes would be helpful, do not hesitate to write the mailing list.
=head1 AUTHORS AND COPYRIGHT
diff --git a/Master/texmf/scripts/texlive/tlmgr2.pl b/Master/texmf/scripts/texlive/tlmgr1.pl
index 8bb82837756..14a7fe1c47c 100755
--- a/Master/texmf/scripts/texlive/tlmgr2.pl
+++ b/Master/texmf/scripts/texlive/tlmgr1.pl
@@ -1,21 +1,10 @@
#!/usr/bin/env perl
# $Id$
#
-# Copyright 2008, 2009 Norbert Preining
+# Copyright 2008 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$';
@@ -29,172 +18,91 @@ $datrev =~ s/^.*Date: //;
$datrev =~ s/ \(.*$//;
$tlmgrrevision .= " ($datrev)";
-our $Master;
+
+my $Master;
BEGIN {
$^W = 1;
- # 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:
+ $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($Master);
unshift (@INC, "$Master/tlpkg");
- unshift (@INC, "$Master/texmf/scripts/texlive");
}
-use Cwd qw/abs_path/;
-use Pod::Usage;
-use Getopt::Long qw(:config no_autoabbrev permute);
-use strict;
-
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
use TeXLive::TLConfig;
use TeXLive::TLMedia;
-use TeXLive::TLPDB;
-use TeXLive::TLPOBJ;
-use TeXLive::TLPostActions;
use TeXLive::TLUtils;
use TeXLive::TLWinGoo;
-TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 dirname
- mkdirhier merge_into copy log debug));
-
-use TeXLive::TLPaper;
-
-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
+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;
-# 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";
+# 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);
# 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();
+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;
-our %opts;
-
-GetOptions(\%opts, keys(%optarg)) or pod2usage(2);
-
-$::machinereadable = $opts{"machine-readable"}
- if (defined($opts{"machine-readable"}));
+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);
my $action = shift;
-if (!defined($action)) {
- $action = $opts{"gui"} ? "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 = <REL_TL>;
- $::version_string .= $rel_tl[0];
- $::version_string .= $rel_tl[$#rel_tl];
- close (REL_TL);
- }
- }
- return $::version_string;
+if (!defined($action) && $opt_gui) {
+ $action = "gui";
}
-if ($opts{"version"} || (defined $action && $action eq "version")) {
- info(give_version());
+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 = <REL_TL>;
+ print $rel_tl[0];
+ print $rel_tl[$#rel_tl];
+ close (REL_TL);
+ }
finish(0);
}
if (defined($action) && ($action =~ m/^help/i)) {
- $opts{"help"} = 1;
+ $opt_help = 1;
}
-if ((!defined($action) || !$action) && !$opts{"help"}) {
+if (!defined($action) && !$opt_help) {
die "$0: missing action; try --help if you need it.\n";
}
-if ($opts{"help"}) {
+if ($opt_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.
@@ -205,59 +113,12 @@ if ($opts{"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 = $opts{"package-logfile"};
-$packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log";
+my $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log";
#
# Try to open the packagelog file, but do NOT die when that does not work
if (!open(PACKAGELOG, ">>$packagelogfile")) {
@@ -267,185 +128,160 @@ if (!open(PACKAGELOG, ">>$packagelogfile")) {
}
my $loadmediasrcerror = "Cannot load TeX Live database from ";
+my %ret;
-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);
+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);
} else {
- 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);
+ # must be "doc"
+ $mothertlp->docfiles($tlpobj->docfiles);
+ $mothertlp->docsize($tlpobj->docsize);
}
- } else {
- # completely normal package, just add it
- $localtlpdb->add_tlpobj($tlpobj);
+ # that make sure that the original entry is overwritten
+ $localtlpdb->add_tlpobj($mothertlp);
}
- $localtlpdb->save;
+ } else {
+ # completely normal package, just add it
+ $localtlpdb->add_tlpobj($tlpobj);
}
- 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";
+ $localtlpdb->save;
}
-
- # close the special log file
- if ($packagelogfile && !$::gui_mode) {
- info("tlmgr: package log updated at $packagelogfile\n") if $packagelogged;
- close(PACKAGELOG);
+ 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");
}
+ 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";
+}
- # run external programs.
- my $error_count = &handle_ret_hash(%ret);
+# main action is done, now clean up.
- # done, just in case there are 256 errors.
- finish($error_count ? 1 : 0);
+# close the special log file
+if ($packagelogfile) {
+ print "tlmgr: package log updated at $packagelogfile\n" if $packagelogged;
+ close(PACKAGELOG);
}
+# run external programs.
+my $error_count = &handle_ret_hash(%ret);
-
-# 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.
-#
-# 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".
+# 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.
#
-sub handle_ret_hash {
+sub handle_ret_hash
+{
my (%ret) = @_;
my $errors = 0;
- if (exists $ret{'mktexlsr'}) {
- info("running mktexlsr\n");
+ if (defined($ret{'mktexlsr'})) {
+ print "running mktexlsr\n";
$errors += system("mktexlsr");
}
- 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.
+ if (defined($ret{'map'})) {
foreach my $m (@{$ret{'map'}}) {
- my $cmd = "updmap-sys --nomkmap --nohash --$m";
- info("running $cmd\n");
- $errors += system($cmd);
+ print "$m\n";
+ $errors += system("updmap-sys --nomkmap --nohash --$m");
}
- info("running updmap-sys once more\n");
- $errors += system("updmap-sys"); # runs mktexlsr.
+ $errors += system("mktexlsr");
+ $errors += system("updmap-sys");
}
- 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`);
- # 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");
+ if (defined($ret{'format'})) {
+ print "regenerating fmtutil.cnf\n";
TeXLive::TLUtils::create_fmtutil($localtlpdb,
- "$TEXMFSYSVAR/web2c/fmtutil.cnf",
- "$TEXMFLOCAL/web2c/fmtutil-local.cnf");
- if ($opt_fmt && !$ret{'format-regenerate'}) {
- info("running fmtutil-sys --missing\n");
+ "$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";
$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 (exists $ret{'language'}) {
+ if (defined($ret{'language'})) {
for my $ext ("dat", "def") {
my $lang = "language.$ext";
- info("regenerating $lang\n");
+ print "regenerating $lang\n";
my $arg1 = "$TEXMFSYSVAR/tex/generic/config/language.$ext";
my $arg2 = "$TEXMFLOCAL/tex/generic/config/language-local.dat";
@@ -459,17 +295,16 @@ 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) {
- info("running fmtutil-sys --byhyphen $lang\n");
+ print "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.
@@ -551,7 +386,6 @@ sub remove_package {
return \%ret;
}
-
# REMOVE
#
# tlmgr remove foo bar baz
@@ -573,7 +407,7 @@ sub remove_package {
# account
#
sub action_remove {
- if ($opts{"gui"}) {
+ if ($opt_gui) {
action_gui("remove");
}
# we do the following:
@@ -592,11 +426,20 @@ sub action_remove {
# . remove the package
#
my %ret;
- $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
+ 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;
my %already_removed;
my @more_removal;
init_local_db();
- info("remove: dry run, no changes will be made\n") if $opts{"dry-run"};
+ info("remove: dry run, no changes will be made\n") if $opt_dry;
my @packs = @ARGV;
#
# we have to be carefull not to remove too many packages. The idea is
@@ -615,24 +458,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 $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"};
+ # 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;
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 $opts{"no-depends-at-all"};
+ my @origpacks = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opt_reallynodepends;
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 ($opts{"force"}) {
+ if ($opt_force) {
info("tlmgr: $p is needed by " . join(" ", @needed) . "\n");
info("tlmgr: still removing it due to --force\n");
} else {
@@ -649,7 +492,7 @@ sub action_remove {
my $tlp = $localtlpdb->get_package($pkg);
next if defined($already_removed{$pkg});
if (!defined($tlp)) {
- info("$pkg: package not present, cannot remove\n");
+ print "$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
@@ -658,7 +501,7 @@ sub action_remove {
if ($tlp->category eq "Collection") {
my %foo;
info ("remove $pkg\n");
- if ($opts{"dry-run"}) {
+ if ($opt_dry) {
# we need to set $foo to something positive otherwise
# the rest will not be run in dry_run mode
$foo{'mktexlsr'} = 1;
@@ -684,7 +527,7 @@ sub action_remove {
foreach my $pkg (sort @more_removal) {
if (!defined($already_removed{$pkg})) {
info ("remove $pkg\n");
- if (!$opts{"dry-run"}) {
+ if (!$opt_dry) {
my %foo;
merge_into(\%foo, &remove_package($pkg, $localtlpdb));
if (keys %foo) {
@@ -696,79 +539,28 @@ sub action_remove {
}
}
}
- if ($opts{"dry-run"}) {
+ if ($opt_dry) {
# stop here, don't do any postinstall actions
return;
} else {
$localtlpdb->save;
my @foo = sort keys %already_removed;
if (@foo) {
- info("tlmgr: actually removed these packages: @foo\n");
+ print "tlmgr: actually removed these packages: @foo\n";
} else {
- info("tlmgr: no packages removed.\n");
+ print "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 ($opts{"gui"}) {
+ if ($opt_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) {
@@ -805,7 +597,7 @@ sub action_show {
print "Installed: ", ($installed ? "Yes" : "No"), "\n";
print "Revision: ", $tlp->revision, "\n" if ($installed);
print "Collection: ", @colls, "\n" if (@colls);
- if ($opts{"list"}) {
+ if ($opt_list) {
print "Included files, by type:\n";
# if the package has a .ARCH dependency we also list the files for
# those packages
@@ -846,45 +638,24 @@ 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 %ret;
+ 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 $r = shift @ARGV;
my $ret = "";
my $tlpdb;
init_local_db();
- if ($opts{"global"}) {
+ if ($opt_global) {
init_tlmedia();
$tlpdb = $tlmediasrc->tlpdb;
} else {
$tlpdb = $localtlpdb;
}
foreach my $pkg ($tlpdb->list_packages) {
- if ($opts{"file"}) {
+ if ($opt_file) {
my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files);
if (@ret) {
print "$pkg:\n";
@@ -907,7 +678,6 @@ sub action_search {
return;
}
-
# RESTORE
#
sub action_restore {
@@ -917,45 +687,52 @@ sub action_restore {
# lists all revisions of pkg
# tlmgr restore --backupdir dir pkg rev
# restores pkg to revision rev
- my %ret;
+ 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);
# check the backup dir argument
- 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 ($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");
tlwarn ("Don't know from where to restore backups, terminating.\n");
exit 1;
}
} else {
# no argument, check for presence in TLPDB
- $opts{"backupdir"} = $localtlpdb->option("backupdir");
- if (!$opts{"backupdir"}) {
+ $opt_backupdir = $localtlpdb->option("backupdir");
+ if (!$opt_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($opts{"backupdir"});
- $ob && ($opts{"backupdir"} = $ob);
- if (! -d $opts{"backupdir"}) {
- tlwarn ("backupdir as set in tlpdb $opts{'backupdir'} is not a directory.\n");
+ 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");
tlwarn ("Don't know from where to restore backups, terminating.\n");
exit 1;
}
}
- info("restore: dry run, no changes will be made\n") if $opts{"dry"};
+ info("restore: dry run, no changes will be made\n") if $opt_dry;
# initialize the hash(packages) of hash(revisions)
my %backups;
- opendir (DIR, $opts{"backupdir"}) || die "opendir($opts{'backupdir'}) failed: $!";
+ opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!";
my @dirents = readdir (DIR);
- closedir (DIR) || warn "closedir($opts{'backupdir'}) failed: $!";
+ closedir (DIR) || warn "closedir($opt_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) {
@@ -966,7 +743,7 @@ sub action_restore {
print "@rs\n";
}
} else {
- print "No backups available in $opts{'backupdir'}\n";
+ print "No backups available in $opt_backupdir\n";
}
finish(0);
}
@@ -978,7 +755,7 @@ sub action_restore {
}
# we did arrive here, so we try to restore ...
if (defined($backups{$pkg}->{$rev})) {
- if (!$opts{"force"}) {
+ if (!$opt_force) {
print "Do you really want to restore $pkg to revision $rev (y/N): ";
my $yesno = <STDIN>;
if ($yesno !~ m/^y(es)?$/i) {
@@ -986,30 +763,33 @@ sub action_restore {
finish(0);
}
}
- print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.lzma\n";
- if (!$opts{"dry"}) {
+ print "Restoring $pkg, $rev from $opt_backupdir/${pkg}.r${rev}.tar.lzma\n";
+ if (!$opt_dry) {
init_local_db(1);
# first remove the package, then reinstall it
# this way we get rid of useless files
- $opts{"backupdir"} = abs_path($opts{"backupdir"});
+ $opt_backupdir = abs_path($opt_backupdir);
merge_into(\%ret, &remove_package($pkg, $localtlpdb));
- TeXLive::TLMedia->_install_package("$opts{'backupdir'}/${pkg}.r${rev}.tar.lzma" , [] ,$localtlpdb);
+ TeXLive::TLMedia->_install_package("$opt_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);
- merge_into(\%ret, $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable"));
+ $ret = $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable");
$localtlpdb->save;
}
} else {
- print "revision $rev for $pkg is not present in $opts{'backupdir'}\n";
+ print "revision $rev for $pkg is not present in $opt_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
@@ -1017,30 +797,36 @@ 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.
- # 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
+ # 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
#
+ 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($opts{"clean"});
+ $clean_mode = 1 if defined($opt_clean);
if ($clean_mode) {
- if ($opts{"clean"} == -99) {
+ if ($opt_clean eq "") {
# we need to check the tlpdb
- $opts{"clean"} = $localtlpdb->option("autobackup");
- if (!$opts{"clean"}) {
+ $opt_clean = $localtlpdb->option("autobackup");
+ if (!$opt_clean) {
tlwarn ("--clean given without an argument, but no default clean\n");
tlwarn ("mode specified in the tlpdb, terminating.\n");
exit 1;
}
}
- # now $opts{"clean"} is something, but maybe not a number, check for
+ # now $opt_clean is something, but maybe not a number, check for
# validity
- if ($opts{"clean"} =~ m/^(-1|[0-9]+)$/) {
+ if ($opt_clean =~ m/^(-1|[0-9]+)$/) {
# get rid of leading zeros etc etc
- $opts{"clean"} = $opts{"clean"} + 0;
+ $opt_clean = $opt_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");
@@ -1048,11 +834,11 @@ sub action_backup {
}
}
# check the backup dir argument
- 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 ($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 ($clean_mode) {
tlwarn ("Cannot clean a non existing directory, terminating.\n");
} else {
@@ -1062,8 +848,8 @@ sub action_backup {
}
} else {
# no argument, check for presence in TLPDB
- $opts{"backupdir"} = $localtlpdb->option("backupdir");
- if (!$opts{"backupdir"}) {
+ $opt_backupdir = $localtlpdb->option("backupdir");
+ if (!$opt_backupdir) {
if ($clean_mode) {
tlwarn ("Cannot clean an unknown directory, terminating.\n");
} else {
@@ -1072,10 +858,10 @@ sub action_backup {
exit 1;
}
# we are stil here, there is something set in tlpdb
- 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");
+ 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");
if ($clean_mode) {
tlwarn ("Cannot clean a non existing directory, terminating.\n");
} else {
@@ -1087,7 +873,7 @@ sub action_backup {
my %ret;
my @todo;
- if ($opts{"all"}) {
+ if ($opt_all) {
@todo = $localtlpdb->list_packages;
} else {
@todo = @ARGV;
@@ -1098,68 +884,68 @@ sub action_backup {
}
foreach my $pkg (@todo) {
if ($clean_mode) {
- clear_old_backups ($pkg, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"});
+ clear_old_backups ($pkg, $opt_backupdir, $opt_clean, $opt_dry);
} else {
my $tlp = $localtlpdb->get_package($pkg);
- info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" .
- $tlp->revision . "tar.lzma\n");
- if (!$opts{"dry-run"}) {
+ info("saving current status of $pkg to $opt_backupdir${pkg}.r" .
+ $tlp->revision . ".\n");
+ if (!$opt_dry) {
$tlp->make_container("lzma", $localtlpdb->root,
- $opts{"backupdir"}, "${pkg}.r" . $tlp->revision);
+ $opt_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 grow_w32_updater {
- my ($tlp, $dry, $oldrev, $newrev) = @_;
+sub add_w32_updater {
+ my ($tlp, $opt_dry) = @_;
+ sub do_one {
+ my $pkg = shift;
+ print $::UPDATER <<EOF;
+tlpkg\\installer\\lzma\\lzmadec.win32.exe < temp\\$pkg.tar.lzma > 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
+;
+ }
+
my $pkg = $tlp->name;
- # that could be more intelligent for decent $dry output
+ # that could be more intelligent for decent $opt_dry output
my $root = $localtlpdb->root;
my $temp = "$root/temp";
- return if $dry;
+ return if $opt_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\\tlmgr2.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
@@ -1202,14 +988,14 @@ del temp\\$pkg.tar.lzma temp\\$pkg.tar
tlwarn ("Couldn't get $pkg.tar.lzma, that is bad\n");
} else {
# add lines to the un-archiver
- do_one ($pkg, $oldrev, $newrev);
+ do_one ($pkg);
}
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", $oldrev, $newrev);
+ do_one ("$pkg.src");
}
}
if ($do_doc) {
@@ -1217,26 +1003,32 @@ del temp\\$pkg.tar.lzma temp\\$pkg.tar
tlwarn ("Couldn't get $pkg.doc.tar.lzma, that is bad\n");
} else {
# add lines to the un-archiver
- do_one ("$pkg.doc", $oldrev, $newrev);
+ do_one ("$pkg.doc");
}
}
}
}
-sub write_w32_updater {
+sub close_w32_updater {
if ($::updater_started) {
- $::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");
+ 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");
tlwarn(" " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n");
}
}
@@ -1258,43 +1050,47 @@ EOF
# tlmgr update --no-depends-at-all foo
# will absolutely only update foo not even taking .ARCH into account
#
-# TLMedia->install_package INSTALLS ONLY ONE PACKAGE, no deps whatsoever
+# TLMedia->install_package does ONLY INSTALL 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 ($opts{"gui"}) {
+ if ($opt_gui) {
action_gui("update");
}
init_local_db(1);
# initialize the TLMedia from $location
- $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
+ 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;
my %ret;
init_tlmedia();
my $mediatlpdb = $tlmediasrc->tlpdb;
- info("update: dry run, no changes will be made\n") if $opts{"dry-run"};
+ info("update: dry run, no changes will be made\n") if $opt_dry;
# 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 ($opts{"all"}) {
+ if ($opt_all) {
$other_updates_asked_for = 1;
} else {
for my $p (@ARGV) {
@@ -1314,26 +1110,21 @@ sub action_update {
}
if ($other_updates_asked_for) {
if (check_for_critical_updates($localtlpdb, $mediatlpdb)) {
- if ($opts{"force"}) {
+ if ($opt_force) {
tlwarn("$0: Continuing due to --force.\n");
- } elsif ($opts{"list"}) {
+ } elsif ($opt_list) {
# do not warn here
} else {
- if ($::gui_mode) {
- # return here and don't do any updates
- return;
- } else {
- die "$0: Exiting, please read above warning.\n";
- }
+ 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 ($opts{"backupdir"}) {
- $opts{"backupdir"} = abs_path($opts{"backupdir"});
- if (! -d $opts{"backupdir"}) {
+ if ($opt_backupdir) {
+ $opt_backupdir = abs_path($opt_backupdir);
+ if (! -d $opt_backupdir) {
tlwarn("Argument for --backupdir must be an existing directory. Terminating.\n");
exit 1;
}
@@ -1342,18 +1133,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 (!$opts{"backup"}) {
+ if (!$opt_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");
- $opts{"backup"} = 1;
+ $opt_backup = 1;
} elsif ($autobackup eq "0") {
debug ("Automatic backups disabled.\n");
} elsif ($autobackup =~ m/^[0-9]+$/) {
debug ("Automatic backups activated, keeping $autobackup backups.\n");
- $opts{"backup"} = 1;
+ $opt_backup = 1;
} else {
tlwarn ("Option autobackup can only be an integer >= -1.\n");
tlwarn ("Disabling auto backups.\n");
@@ -1365,14 +1156,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 ($opts{"backup"}) {
+ if ($opt_backup) {
my $diebackupdir = 0;
- if (!$opts{"backupdir"}) {
- $opts{"backupdir"} = $localtlpdb->option("backupdir");
- if ($opts{"backupdir"}) {
+ if (!$opt_backupdir) {
+ $opt_backupdir = $localtlpdb->option("backupdir");
+ if ($opt_backupdir) {
# check again:
- $opts{"backupdir"} = abs_path($opts{"backupdir"});
- $diebackupdir = 1 if (! -d $opts{"backupdir"});
+ $opt_backupdir = abs_path($opt_backupdir);
+ $diebackupdir = 1 if (! -d $opt_backupdir);
} else {
# not set in the tlpdb, and not set on cmd line, but asked for
# --backup
@@ -1389,9 +1180,9 @@ sub action_update {
}
# finally, if we have --backupdir, but no --backup, just enable it
- $opts{"backup"} = 1 if $opts{"backupdir"};
+ $opt_backup = 1 if $opt_backupdir;
- debug("Doing backups to $opts{'backupdir'}\n") if $opts{"backup"};
+ debug("Doing backups to $opt_backupdir\n") if $opt_backup;
# these two variables are used throughout this function
my $root = $localtlpdb->root;
@@ -1400,7 +1191,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 $opts{"dry-run"};
+ unlink($f) unless $opt_dry;
}
my @todo;
@@ -1451,29 +1242,39 @@ sub action_update {
debug ("tlmgr: deleted : " . join("\n\t",keys %removals) . "\n");
debug ("tlmgr: forced : " . join("\n\t",keys %forcermpkgs) . "\n");
- if ($opts{"all"} || $opts{"list"}) {
+ if ($opt_all || $opt_list) {
@todo = $localtlpdb->list_packages;
} else {
@todo = @ARGV;
}
- # don't do anything if we have been invoced in a strange way
+
+ #
+ # 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");
+ }
+ }
+
if (!@todo) {
tlwarn("tlmgr update: please specify a list of packages or --all.\n");
}
- # update all .ARCH dependencies, too, unless $opts{"no-depends-at-all"}:
+ # update all .ARCH dependencies, too, unless $opt_reallynodepends:
@todo = $mediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo)
- unless $opts{"no-depends-at-all"};
+ unless $opt_reallynodepends;
#
- # update general deps unless $opts{"no-depends"}:
+ # update general deps unless $opt_nodepends:
@todo = $mediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo)
- unless $opts{"no-depends"};
-
- #
- # we first collect the list of packages to be actually updated or installed
- my @updated;
- my @new;
- my @addlines;
+ unless $opt_nodepends;
foreach my $pkg (sort @todo) {
next if ($pkg =~ m/^00texlive/);
@@ -1490,19 +1291,12 @@ sub action_update {
# will be in the dependency expansion, and we want it.
my $newpkg_coll = $newpkgs{$pkg} || $newpkgs{$pkg_noarch};
if ($forcerm_coll) {
- 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");
- }
+ 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");
@@ -1515,112 +1309,20 @@ sub action_update {
next;
}
my $mediarev = $mediatlp->revision;
- 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, "-", "-", "-");
+ 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++;
} else {
- info("remove $p (removed on server)\n");
+ tlwarn("$0: couldn't install new package $pkg\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;
@@ -1630,114 +1332,110 @@ sub action_update {
next;
}
my $mediarev = $mediatlp->revision;
- $nrupdated++;
- if ($opts{"list"}) {
- if ($::machinereadable) {
- machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg});
- } else {
+ if ($rev < $mediarev) {
+ $nrupdated++;
+ if ($opt_list) {
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/)) {
- 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(" ... ") unless $::machinereadable; # more to come
+ 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);
+ }
}
- 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
+ if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) {
+ add_w32_updater($mediatlp, $opt_dry);
+ } else {
+ info("update: $pkg ($rev -> $mediarev)");
+ if ($opt_dry) {
+ info("\n");
next;
+ } else {
+ info(" ... "); # more to come
}
- $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
+
+ 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 = $newname;
+ $unwind_package = "$fullname";
}
- 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");
+ # 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 {
- 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");
+ # 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;
}
- unlink($unwind_package) if $remove_unwind_container;
+ info("done\n");
}
- 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
- write_w32_updater();
- if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opts{"all"}) {
+ close_w32_updater();
+ if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opt_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");
@@ -1749,7 +1447,6 @@ sub action_update {
return(\%ret);
}
-
# INSTALL
#
# tlmgr install foo bar baz
@@ -1780,47 +1477,48 @@ sub action_update {
# anymore! That has all to be done by hand.
#
sub action_install {
- if ($opts{"gui"}) {
+ if ($opt_gui) {
action_gui("install");
}
init_local_db(1);
# initialize the TLMedia from $location
- $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
+ 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);
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 ($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";
- }
- }
+ if(check_for_critical_updates( $localtlpdb, $tlmediatlpdb, !$opt_force)) {
+ die "not continuing, please see warning above!";
}
- $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"};
- info("install: dry run, no changes will be made\n") if $opts{"dry-run"};
+ $opt_nodepends = 1 if $opt_reallynodepends;
+ info("install: dry run, no changes will be made\n") if $opt_dry;
my @packs = @ARGV;
- # 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"};
+ # 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;
} else {
- @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"};
+ @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opt_nodepends;
}
foreach my $pkg (sort @packs) {
my $re = "";
if (defined($localtlpdb->get_package($pkg))) {
- if ($opts{"reinstall"}) {
+ if ($opt_reinstall) {
$re = "re";
} else {
debug("already installed: $pkg\n");
@@ -1828,12 +1526,12 @@ sub action_install {
}
}
info("${re}install: $pkg\n");
- if (!$opts{"dry-run"}) {
+ if (!$opt_dry) {
merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb));
logpackage("${re}install: $pkg");
}
}
- if ($opts{"dry-run"}) {
+ if ($opt_dry) {
# stop here, don't do any postinstall actions
return(0);
}
@@ -1877,41 +1575,15 @@ sub action_list {
return;
}
-
-# OPTION
-#
+
sub action_option {
- if ($opts{"gui"}) {
+ if ($opt_gui) {
action_gui("config");
}
my $what = shift @ARGV;
$what = "show" unless defined($what);
init_local_db();
- 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) {
+ if ($what =~ m/^location$/i) {
# changes the default location
my $loc = shift @ARGV;
if ($loc) {
@@ -1930,92 +1602,70 @@ 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)) {
- info("tlmgr: defaulting to", ($loc ? "" : " not"),
- " installing documentation files.\n");
+ print "Defaulting to", ($loc ? "" : " not"),
+ " installing documentation files.\n";
$localtlpdb->option_install_docfiles($loc);
$localtlpdb->save;
} else {
- info("Install documentation files: ",
- $localtlpdb->option_install_docfiles, "\n");
+ print "Install documentation files: ",
+ $localtlpdb->option_install_docfiles, "\n";
}
} elsif ($what =~ m/^srcfiles$/i) {
# changes the default srcfiles
my $loc = shift @ARGV;
if (defined($loc)) {
- info("tlmgr: defaulting to", ($loc ? "" : " not"),
- " installing source files.\n");
+ print "Defaulting to", ($loc ? "" : " not"),
+ " installing source files.\n";
$localtlpdb->option_install_srcfiles($loc);
$localtlpdb->save;
} else {
- info("Install source files: ",
- $localtlpdb->option_install_srcfiles, "\n");
+ print "Install source files: ",
+ $localtlpdb->option_install_srcfiles, "\n";
}
} elsif ($what =~ m/^formats$/i) {
# changes the default formats
my $loc = shift @ARGV;
if (defined($loc)) {
- info("tlmgr: defaulting to", ($loc ? "" : " not"),
- " generating format files on installation.\n");
+ print "Defaulting to", ($loc ? "" : " not"),
+ " generating format files on installation.\n";
$localtlpdb->option_create_formats($loc);
$localtlpdb->save;
} else {
- info("Create formats on installation: ",
- $localtlpdb->option_create_formats, "\n");
- }
- } 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");
+ print "Create formats on installation: ",
+ $localtlpdb->option_create_formats, "\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.
+ } 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 {
my $val = shift @ARGV;
if (defined($val)) {
- info("tlmgr: setting option $what to $val.\n");
+ print "Setting option $what to $val.\n";
$localtlpdb->option($what,$val);
$localtlpdb->save;
} else {
- info("Option $what = ", $localtlpdb->option($what), "\n");
+ print "Option $what = ", $localtlpdb->option($what), "\n";;
}
- } else {
- tlwarn "Option $what is currently not supported.\n";
+ #warn "Setting other options currently not supported, please edit texlive.tlpdb!";
}
return;
}
@@ -2025,15 +1675,18 @@ sub action_option {
#
sub action_arch {
if ($^O=~/^MSWin(32|64)$/i) {
- warn("action `arch' not supported on Windows\n");
+ printf STDERR "action `arch' not supported on Windows\n";
}
- if ($opts{"gui"}) {
+ if ($opt_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 $opts{"dry-run"};
+ info("arch: dry run, no changes will be made\n") if $opt_dry;
$what || ($what = "list");
if ($what =~ m/^list$/i) {
# list the available architectures
@@ -2076,8 +1729,8 @@ sub action_arch {
if ($dep =~ m/^(.*)\.ARCH$/) {
# we have to install something
foreach my $a (@todoarchs) {
- if ($opts{"dry-run"}) {
- info("Installing $pkg.$a\n");
+ if ($opt_dry) {
+ print "Installing $pkg.$a\n";
} else {
info("install: $pkg.$a\n");
merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb));
@@ -2106,12 +1759,11 @@ sub action_arch {
return(\%ret);
}
-
-# GENERATE
-#
sub action_generate {
- my $dest = defined($opts{"dest"}) ? $opts{"dest"} : "";
- my $localconf = defined($opts{"localcfg"}) ? $opts{"localcfg"} : "";
+ my $localconf = "";
+ my $dest = "";
+ Getopt::Long::Configure(@getopt_configure_subopts);
+ GetOptions("localcfg=s" => \$localconf, "dest=s" => \$dest,) or pod2usage(2);
my $what = shift @ARGV;
init_local_db();
@@ -2161,79 +1813,105 @@ sub action_generate {
return;
}
-
-# GUI
+# set global $location variable.
+# if we cannot read tlpdb, die if arg SHOULD_I_DIE is true.
#
-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.
-
-";
- }
+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 {
- printf STDERR "Problem loading Tk: $@\n";
+ tlwarn("Continuing anyway ...\n");
}
- exit 1;
}
-
- # 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;
+ 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($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;
}
-
- # 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);
}
+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");
+}
-# 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 ($opts{"gui"}) {
+ if ($opt_gui) {
action_gui("uninstall");
}
- my $force = defined($opts{"force"}) ? $opts{"force"} : 0;
+ my $force = 0;
+ Getopt::Long::Configure(@getopt_configure_subopts);
+ GetOptions("force" => \$force) or pod2usage(2);
if (!$force) {
print("If you answer yes here the whole TeX Live installation will be removed!\n");
print "Remove TeX Live (y/N): ";
@@ -2244,35 +1922,120 @@ sub action_uninstall {
}
}
print ("Ok, removing the whole installation:\n");
- init_local_db();
- $localtlpdb->remove_symlinks;
+ 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";
+ }
+ }
+ #
# now do remove the rest
- 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");
+ 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");
# should we do that????
- system("rm", "-rf", "$Master/texmf-config");
- system("rmdir", "--ignore-fail-on-non-empty", "$Master");
+ system("rm", "-rf", "$texdir/texmf-config");
+ system("rmdir", "--ignore-fail-on-non-empty", "$texdir");
}
-# CHECK
-#
sub action_check {
- my $svn = defined($opts{"use-svn"}) ? $opts{"use-svn"} : 0;
+ my $svn = 0;
+ Getopt::Long::Configure(@getopt_configure_subopts);
+ GetOptions("use-svn" => \$svn) or pod2usage(2);
my $what = shift @ARGV;
$what || ($what = "all");
init_local_db();
@@ -2290,6 +2053,7 @@ sub action_check {
finish($ret);
}
+#
# check file coverage, roughly equivalent to tlpkg/bin/check-file-coverage
#
sub check_files {
@@ -2344,13 +2108,14 @@ 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/
@@ -2401,6 +2166,7 @@ sub check_files {
return($ret);
}
+#
# check collections
#
sub check_collections {
@@ -2420,90 +2186,34 @@ 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 (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");
+ 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);
+}
- # $tlmediasrc is a global variable
- $tlmediasrc = TeXLive::TLMedia->new($location);
- $tlmediatlpdb = $tlmediasrc->tlpdb;
- die($loadmediasrcerror . $location) unless defined($tlmediasrc);
+#
+# 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";
}
}
-# 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.
-#
+#
+# finish # evaluates only the -pause option, and then exits.
sub finish {
my ($ret) = @_;
@@ -2511,42 +2221,29 @@ sub finish {
print "tlmgr: exiting unsuccessfully (status $ret).\n";
}
- if ($opts{"pause"}) {
- print "Press Enter to exit the program.\n";
+ if ($opt_pause) {
+ print "Please press <ENTER> to exit the program.\n";
<STDIN>;
}
- if ($::gui_mode) {
- return($ret);
- } else {
- exit($ret);
- }
+ 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, $backupdir, $autobackup, $dry) = @_;
+ my ($pkg, $opt_backupdir, $autobackup, $opt_dry) = @_;
my $dryrun = 0;
- $dryrun = 1 if ($dry);
+ $dryrun = 1 if ($opt_dry);
# keep arbitrary many backups
return if ($autobackup == -1);
- opendir (DIR, $backupdir) || die "opendir($backupdir) failed: $!";
+ opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!";
my @dirents = readdir (DIR);
- closedir (DIR) || warn "closedir($backupdir) failed: $!";
+ closedir (DIR) || warn "closedir($opt_backupdir) failed: $!";
my @backups;
for my $dirent (@dirents) {
next if (-d $dirent);
@@ -2556,13 +2253,14 @@ sub clear_old_backups
my $i = 1;
for my $e (reverse sort {$a <=> $b} @backups) {
if ($i > $autobackup) {
- info ("Removing backup $backupdir/$pkg.r$e.tar.lzma\n");
- unlink("$backupdir/$pkg.r$e.tar.lzma") unless $dryrun;
+ info ("Removing backup $opt_backupdir/$pkg.r$e.tar.lzma\n");
+ unlink("$opt_backupdir/$pkg.r$e.tar.lzma") unless $dryrun;
}
$i++;
}
}
+#
# check for updates to tlcritical packages
#
sub check_for_critical_updates
@@ -2610,6 +2308,7 @@ sub check_for_critical_updates
}
+#
# return all the directories from which all content will be removed
#
# idea:
@@ -2733,12 +2432,6 @@ Windows via the registry, on Unix via C<LC_MESSAGES>). 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</"MACHINE-READABLE OUTPUT"> section below for details.
-
=item B<--package-logfile> I<file>
B<tlmgr> logs all package actions (install, remove, update, failed
@@ -2854,8 +2547,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 is given.
-(C<--list> is still performed regardless of this option.)
+present, tlmgr will not perform the update unless this option (or
+C<--list>) is given.
=item B<--no-remove>
@@ -3032,9 +2725,6 @@ Possible values for I<key> are:
C<srcfiles> (install source files),
C<backupdir> (default directory for backups),
C<autobackup> (number of backups to keep).
- C<sys_bin> (location where binaries are linked to by action symlinks)
- C<sys_man> (location where man pages are linked to by action symlinks)
- C<sys_info> (location where info pages are linked to by action symlinks)
Perhaps the most common use of C<option> is if you originally installed from
DVD, and want to permanently change the installation to get further
@@ -3059,45 +2749,24 @@ with 0 as the values.
In the C<--clean> mode of the C<backup> action this option also
specifies the number to be kept.
-=head2 symlinks [add|remove]
-
-Adds or removes symlinks for binaries, man pages, and info pages in the
-directories specified by the respective options (see above).
-
=head2 paper
=over 4
-=item B<paper [a4|letter]>
-
-=item B<S<xdvi|pdftex|dvips|dvipdfmx|dvipdfm|context paper [I<papersize>|--list]>>
+=item B<paper a4>
-=back
-
-With no arguments (C<tlmgr paper>), shows the default paper size setting
-for all known programs.
+=item B<paper letter>
-With one argument (e.g., C<tlmgr paper a4>), sets the default for all
-known programs to that paper size.
+=item B<[xdvi|dvips|pdftex|dvipdfm|dvipdfmx|context] paper [help|I<papersize>|--list]>
-With a program given as the first argument and no paper size specified
-(e.g., C<tlmgr dvips paper>), shows the default paper size for that
-program.
-
-With a program given as the first argument and a paper size as the last
-argument (e.g., C<tlmgr dvips paper a4>), set the default for that
-program to that paper size.
+=back
-With a program given as the first argument and C<--list> given as the
-last argument (e.g., C<tlmgr dvips paper --list>), shows all valid paper
-sizes for that program. The first size shown is the default.
+Configures the system wide paper settings, either for all programs at
+once (first two forms), or just for the specified program (third
+form). The third form with C<--list> outputs all known papersizes for the
+specified program.
-Incidentally, this syntax of having a specific program name before the
-C<paper> keyword may seem strange. It is inherited from the
-longstanding C<texconfig> script, which supports other configuration
-settings for some programs, notably C<dvips>. C<tlmgr> does not support
-those extra settings at present.
=head2 arch list|add I<arch>...
@@ -3199,7 +2868,7 @@ Do not ask for confirmation, remove immediately.
=back
-=head2 generate [I<option>]... I<what>
+=head2 generate
=over 4
@@ -3215,28 +2884,24 @@ Do not ask for confirmation, remove immediately.
=back
-The C<generate> action overwrites any manual changes made in the
+The I<generate> action overwrites any manual changes made in the
respective files: it recreates them from scratch.
-For C<fmtutil> and the language files, this is normal, and both the TeX
+For fmtutil and the language files, this is normal, and both the TeX
Live installer and C<tlmgr> routinely call I<generate> for them.
-For C<updmap>, however, neither the installer nor C<tlmgr> use
-C<generate>, because the result would be to disable all maps which have
-been manually installed via S<C<updmap-sys --enable>>, e.g., for
-proprietary or local fonts. Only the changes in the C<--localcfg> file
-mentioned below are incorporated by I<generate>. Furthermore, C<tlmgr>
-updates and maintains the final C<updmap.cfg> in C<TEXMFSYSCONFIG> (the
-others use C<TEXMFSYSVAR>) because that is the location that
-C<updmap-sys> (via C<tcfmgr>) uses.
-
-Notwithstanding the above, if you only use the fonts and font packages
-within TeX Live, and maintain your local fonts (if any) with the local
-config file, there is nothing wrong with using C<generate updmap>.
-Indeed, we use it ourselves to generate the C<updmap.cfg> file that is
-maintained in the live source repository.
-
-In more detail: C<generate> remakes any of the four config files
+For updmap, however, neither the installer nor C<tlmgr> use I<generate>,
+because the result would be to disable all maps which have been manually
+installed via C<updmap-sys --enable>, e.g., for proprietary or local
+fonts. Only the changes in the C<--localcfg> file mentioned below are
+incorporated by I<generate>.
+
+On the other hand, if you only use the fonts and font packages within
+TeX Live, there is nothing wrong with using I<generate updmap>. Indeed,
+we use it to generate the C<updmap.cfg> file that is maintained in the
+live source repository.
+
+In more detail: I<generate> remakes any of the four config files
C<language.dat>, C<language.def>, C<fmtutil.cnf>, and C<updmap.cfg> from
the information present in the local TLPDB. If the files
C<language-local.dat>, C<language-local.def>, C<fmtutil-local.cnf>, or
@@ -3255,8 +2920,7 @@ Options:
=item B<--dest> I<output file>
specifies the output file (defaults to the respective location in
-C<TEXMFSYSVAR> for C<language*> and C<fmtutil>, and C<TEXMFSYSCONFIG>
-for C<updmap>). If B<--dest> is given to C<generate language>, its
+C<TEXMFSYSVAR>). If B<--dest> is given to C<generate language>, its
value will be used for the C<language.dat> output, and C<.def> will be
appended to the value for the name of the C<language.def> output file.
(This is just to avoid overwriting; if you want a specific name for each
@@ -3265,116 +2929,15 @@ output file, we recommend invoking C<tlmgr> twice.)
=item B<--localcfg> I<local conf file>
specifies the (optional) local additions (defaults to the respective
-location in C<TEXMFLOCAL>).
+location in C<TEXMFSYSVAR>).
=back
The respective locations are as follows:
-
- tex/generic/config/language.dat (and language-local.dat);
- tex/generic/config/language.def (and language-local.def);
- web2c/fmtutil.cnf (and fmtutil-local.cnf);
- web2c/updmap.cfg (and updmap-local.cfg).
-
-
-=head1 MACHINE-READABLE OUTPUT
-
-Given the C<--machine-readable> option, C<tlmgr> writes to stdout in the
-fixed line-oriented format described here, and the usual informational
-messages for human consumption are written to stderr (normally they are
-written to stdout). The idea is that a program can get all the
-information it needs by reading stdout.
-
-Currently this option only applies to the L<update|/"update
-[I<option>]... [I<pkg>]..."> action. The output format is as follows:
-
- fieldname "\t" value
- ...
- "end-of-header"
- pkgname status localrev serverrev size
- ...
-
-Currently the header section contains two fields. The field name and
-value are separated by a tab. Line endings may be LF or CRLF depending
-on the current platform.
-
-=over 4
-
-=item C<location-url> I<location>
-
-The I<location> may be a url (including C<file:///foo/bar/...>), or a
-directory name (C</foo/bar>). It is the server repository from which
-the new package information was drawn.
-
-=item C<total-bytes> I<count>
-
-The I<count> is simply a decimal number, the sum of all the packages
-given subsequently that need updating or installing.
-
-=back
-
-Then comes a line with only the literal string C<end-of-header>.
-
-Each following line until EOF reports on one package. The fields on
-each line are separated by a tab. Here are the fields.
-
-=over 4
-
-=item I<pkgname>
-
-The TeX Live package identifier, with a possible architecture suffix for
-executables. For instance, C<pdftex> and C<pdftex.i386-linux> are
-given as two separate packages, one on each line.
-
-=item I<status>
-
-The status of the package update. One character, as follows:
-
-=over 8
-
-=item C<d>
-
-The package was removed on the server.
-
-=item C<f>
-
-The package was removed on the server even though a collection depended
-on it. (E.g., the user ran C<tlmgr remove --force>.)
-
-=item C<u>
-
-Normal update is needed.
-
-=item C<r>
-
-Reversed non-update: the locally-installed version is newer than the
-version on the server.
-
-=item C<a>
-
-Automatically-determined need for installation, the package is new on
-the server and is (most probably) part of an installed collection.
-
-=back
-
-=item I<localrev>
-
-The revision number of the installed package.
-
-=item I<serverrev>
-
-The revision number of the package on the server.
-
-=item I<size>
-
-The size in bytes of the package on the server.
-
-=back
-
-
-
-If you are developing a program that uses this output, and find that
-changes would be helpful, do not hesitate to write the mailing list.
+ C<tex/generic/config/language.dat> (and C<language-local.dat>)
+ C<tex/generic/config/language.def> (and C<language-local.def>)
+ C<web2c/fmtutil.cnf> (and C<fmtutil-local.cnf>)
+ C<web2c/updmap.cfg> (and C<updmap-local.cfg>)
=head1 AUTHORS AND COPYRIGHT
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
index 3189a9ff559..d475e31d62a 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
@@ -78,7 +78,7 @@ sub apply_changes {
push @todo, $a if $archs{$a};
}
if (@todo) {
- run_program_show_output("tlmgr", "--location", "$location", "arch", "add", @todo);
+ execute_action_gui ( "arch", "add", @todo );
reinit_local_tlpdb();
init_archs();
}
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch2.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch1.pl
index d475e31d62a..3189a9ff559 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch2.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch1.pl
@@ -78,7 +78,7 @@ sub apply_changes {
push @todo, $a if $archs{$a};
}
if (@todo) {
- execute_action_gui ( "arch", "add", @todo );
+ run_program_show_output("tlmgr", "--location", "$location", "arch", "add", @todo);
reinit_local_tlpdb();
init_archs();
}
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-config.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-config.pl
index e4b00cdc4ae..75e9e98f039 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/gui-config.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-config.pl
@@ -1,4 +1,4 @@
-# gui-config.pl
+# gui-config2.pl
# $Id$
#
# Copyright 2008 Tomasz Luczak, Norbert Preining
@@ -13,6 +13,8 @@ my $default_location = $localtlpdb->option_location;
my $default_formats = ($localtlpdb->option_create_formats ? ___"yes" : ___"no");
my $default_docfiles = ($localtlpdb->option_install_docfiles ? ___"yes" : ___"no");
my $default_srcfiles = ($localtlpdb->option_install_srcfiles ? ___"yes" : ___"no");
+my $default_backupdir = $localtlpdb->option("backupdir");
+my $default_autobackup = $localtlpdb->option("autobackup");
# this will be loaded only on unix systems!
#
@@ -40,31 +42,37 @@ my $back_config_set_m4 = $back_config_set->Label(-textvariable => \$default_srcf
my $back_config_set_r4 = $back_config_set->Button(-text => ___"toggle",
-command => sub { toggle_setting("srcfiles"); });
-
-$back_config_set_l1->grid(-row => 1, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_m1->grid(-row => 1, -column => 2,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_r1->grid(-row => 1, -column => 3,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l2->grid(-row => 2, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_m2->grid(-row => 2, -column => 2,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_r2->grid(-row => 2, -column => 3,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l3->grid(-row => 3, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_m3->grid(-row => 3, -column => 2,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_r3->grid(-row => 3, -column => 3,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l4->grid(-row => 4, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_m4->grid(-row => 4, -column => 2,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_r4->grid(-row => 4, -column => 3,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
+my $back_config_set_l5 = $back_config_set->Label(-text => ___"backupdir", -anchor => "w");
+my $back_config_set_m5 = $back_config_set->Label(-textvariable => \$default_backupdir);
+my $back_config_set_r5 = $back_config_set->Button(-text => ___"change",
+ -command => sub {
+ $mw->Dialog(-title => "not implemented",
+ -text => "changing backupdir setting not implemented",
+ -buttons => [ "ok" ])->Show;
+ info("Not implemented!\n"); return; change_backupdir(); });
+
+my $back_config_set_l6 = $back_config_set->Label(-text => ___"autobackup", -anchor => "w");
+my $back_config_set_m6 = $back_config_set->Label(-textvariable => \$default_autobackup);
+my $back_config_set_r6 = $back_config_set->Button(-text => ___"change",
+ -command => sub {
+ $mw->Dialog(-title => "not implemented",
+ -text => "changing autobackup setting not implemented",
+ -buttons => [ "ok" ])->Show;
+ info("Not implemented!\n"); return; change_autobackup(); });
+
+
+$back_config_set_l1->grid( $back_config_set_m1, $back_config_set_r1,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l2->grid( $back_config_set_m2, $back_config_set_r2,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l3->grid( $back_config_set_m3, $back_config_set_r3,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l4->grid( $back_config_set_m4, $back_config_set_r4,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l5->grid( $back_config_set_m5, $back_config_set_r5,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l6->grid( $back_config_set_m6, $back_config_set_r6,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
#############
@@ -80,51 +88,68 @@ my $back_config_pap_m1 = $back_config_pap->Button(-text => "A4",
my $back_config_pap_r1 = $back_config_pap->Button(-text => "letter",
-command => sub { change_paper("all", "letter"); });
-$back_config_pap_l1->grid(-row => 1, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nswe");
-$back_config_pap_m1->grid(-row => 1, -column => 2,
- -padx => "2m", -pady => "2m", -sticky => "nswe");
-$back_config_pap_r1->grid(-row => 1, -column => 3,
+$back_config_pap_l1->grid( $back_config_pap_m1, $back_config_pap_r1,
-padx => "2m", -pady => "2m", -sticky => "nswe");
my %papers;
-if (!win32()) {
- @{$papers{"xdvi"}} = `tlmgr xdvi paper --list`;
- chomp(@{$papers{"xdvi"}});
+my %defaultpaper;
+
+sub init_paper_xdvi {
+ if (!win32()) {
+ @{$papers{"xdvi"}} = TeXLive::TLPaper::get_paper_list("xdvi");
+ $defaultpaper{"xdvi"} = ${$papers{"xdvi"}}[0];
+ }
+}
+sub init_paper_pdftex {
+ @{$papers{"pdftex"}} = TeXLive::TLPaper::get_paper_list("pdftex");
+ $defaultpaper{"pdftex"} = ${$papers{"pdftex"}}[0];
}
-@{$papers{"pdftex"}} = `tlmgr pdftex paper --list`;
-chomp(@{$papers{"pdftex"}});
-@{$papers{"dvipdfm"}} = `tlmgr dvipdfm paper --list`;
-chomp(@{$papers{"dvipdfm"}});
-@{$papers{"dvipdfmx"}} = `tlmgr dvipdfmx paper --list`;
-chomp(@{$papers{"dvipdfmx"}});
-@{$papers{"dvips"}} = `tlmgr dvips paper --list`;
-chomp(@{$papers{"dvips"}});
-if (defined($localtlpdb->get_package("bin-context"))) {
- @{$papers{"context"}} = `tlmgr context paper --list`;
- chomp(@{$papers{"context"}});
+sub init_paper_dvips {
+ @{$papers{"dvips"}} = TeXLive::TLPaper::get_paper_list("dvips");
+ $defaultpaper{"dvips"} = ${$papers{"dvips"}}[0];
+}
+sub init_paper_dvipdfm {
+ @{$papers{"dvipdfm"}} = TeXLive::TLPaper::get_paper_list("dvipdfm");
+ $defaultpaper{"dvipdfm"} = ${$papers{"dvipdfm"}}[0];
+}
+sub init_paper_context {
+ if (defined($localtlpdb->get_package("bin-context"))) {
+ @{$papers{"context"}} = TeXLive::TLPaper::get_paper_list("context");
+ $defaultpaper{"context"} = ${$papers{"context"}}[0];
+ }
+}
+sub init_paper_dvipdfmx {
+ @{$papers{"dvipdfmx"}} = TeXLive::TLPaper::get_paper_list("dvipdfmx");
+ $defaultpaper{"dvipdfmx"} = ${$papers{"dvipdfmx"}}[0];
}
-my %defaultpaper;
-my $row = 2;
+my %init_paper_subs;
+$init_paper_subs{"xdvi"} = \&init_paper_xdvi;
+$init_paper_subs{"pdftex"} = \&init_paper_pdftex;
+$init_paper_subs{"dvips"} = \&init_paper_dvips;
+$init_paper_subs{"context"} = \&init_paper_context;
+$init_paper_subs{"dvipdfm"} = \&init_paper_dvipdfm;
+$init_paper_subs{"dvipdfmx"} = \&init_paper_dvipdfmx;
+
+sub init_all_papers {
+ for my $p (keys %init_paper_subs) {
+ &{$init_paper_subs{$p}}();
+ }
+}
+
+init_all_papers();
+
my (%l,%m,%r);
foreach my $p (sort keys %papers) {
if (($p eq "context") && !defined($localtlpdb->get_package("bin-context"))) {
next;
}
- my @pap = @{$papers{$p}};
- $defaultpaper{$p} = $pap[0];
$l{$p} = $back_config_pap->Label(-text => ___("defaultpaperfor") . " $p", -anchor => "w");
$m{$p} = $back_config_pap->Label(-textvariable => \$defaultpaper{$p}, -anchor => "w");
$r{$p} = $back_config_pap->Button(-text => ___"change",
-command => sub { select_paper($p); }, -anchor => "w");
- $l{$p}->grid(-row => $row, -column => 1,
- -padx => "2m", -pady => "2m", -sticky => "nsw");
- $m{$p}->grid(-row => $row, -column => 2,
+ $l{$p}->grid( $m{$p}, $r{$p},
-padx => "2m", -pady => "2m", -sticky => "nsw");
- $r{$p}->grid(-row => $row, -column => 3,
- -padx => "2m", -pady => "2m", -sticky => "nsw");
- $row++;
}
$back_config_pap->pack(-side => 'left', -fill => "both", -padx => "2m", -pady => "2m");
@@ -207,13 +232,11 @@ sub toggle_setting() {
sub change_paper {
my ($prog, $pap) = @_;
if ($prog eq "all") {
- run_program_show_output("tlmgr", "--location", "$location", "paper", $pap);
- foreach my $p (keys %papers) {
- $defaultpaper{$p} = $pap;
- }
+ execute_action_gui ("paper", "paper", $pap);
+ init_all_papers();
} else {
- run_program_show_output("tlmgr", "--location", "$location", $prog, "paper", $pap);
- $defaultpaper{$prog} = $pap;
+ execute_action_gui ( "paper", $prog, "paper", $pap);
+ &{$init_paper_subs{$prog}}();
}
}
@@ -237,27 +260,6 @@ sub select_paper {
}
-
-sub old_select_paper {
- my $prog = shift;
- my $foo = $back_config->Toplevel(-title => ___("paperfor") . " $prog");
- my $var = $defaultpaper{$prog};
- my @lop = @{$papers{$prog}};
- my $nrpercols = 15;
- my $row = 1;
- my $col = 1;
- foreach my $p (sort @{$papers{$prog}}) {
- $foo->Radiobutton(-variable => \$var, -value => $p, -text => $p, -anchor => "w")->grid(-row => $row, -column => $col, -padx => "2m", -pady => "2m", -sticky => "nsw");
- $row++;
- if ($row > $nrpercols) {
- $col++;
- $row = 1;
- }
- }
- $foo->Button(-text => ___"ok", -command => sub { change_paper($prog,$var); $foo->destroy; })->grid(-row => $nrpercols+1, -column => 1);
- $foo->Button(-text => ___"cancel", -command => sub { $foo->destroy; })->grid(-row => $nrpercols+1, -column => 2);
-}
-
1;
### Local Variables:
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-config2.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-config1.pl
index 75e9e98f039..e4b00cdc4ae 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/gui-config2.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-config1.pl
@@ -1,4 +1,4 @@
-# gui-config2.pl
+# gui-config.pl
# $Id$
#
# Copyright 2008 Tomasz Luczak, Norbert Preining
@@ -13,8 +13,6 @@ my $default_location = $localtlpdb->option_location;
my $default_formats = ($localtlpdb->option_create_formats ? ___"yes" : ___"no");
my $default_docfiles = ($localtlpdb->option_install_docfiles ? ___"yes" : ___"no");
my $default_srcfiles = ($localtlpdb->option_install_srcfiles ? ___"yes" : ___"no");
-my $default_backupdir = $localtlpdb->option("backupdir");
-my $default_autobackup = $localtlpdb->option("autobackup");
# this will be loaded only on unix systems!
#
@@ -42,37 +40,31 @@ my $back_config_set_m4 = $back_config_set->Label(-textvariable => \$default_srcf
my $back_config_set_r4 = $back_config_set->Button(-text => ___"toggle",
-command => sub { toggle_setting("srcfiles"); });
-my $back_config_set_l5 = $back_config_set->Label(-text => ___"backupdir", -anchor => "w");
-my $back_config_set_m5 = $back_config_set->Label(-textvariable => \$default_backupdir);
-my $back_config_set_r5 = $back_config_set->Button(-text => ___"change",
- -command => sub {
- $mw->Dialog(-title => "not implemented",
- -text => "changing backupdir setting not implemented",
- -buttons => [ "ok" ])->Show;
- info("Not implemented!\n"); return; change_backupdir(); });
-
-my $back_config_set_l6 = $back_config_set->Label(-text => ___"autobackup", -anchor => "w");
-my $back_config_set_m6 = $back_config_set->Label(-textvariable => \$default_autobackup);
-my $back_config_set_r6 = $back_config_set->Button(-text => ___"change",
- -command => sub {
- $mw->Dialog(-title => "not implemented",
- -text => "changing autobackup setting not implemented",
- -buttons => [ "ok" ])->Show;
- info("Not implemented!\n"); return; change_autobackup(); });
-
-
-$back_config_set_l1->grid( $back_config_set_m1, $back_config_set_r1,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l2->grid( $back_config_set_m2, $back_config_set_r2,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l3->grid( $back_config_set_m3, $back_config_set_r3,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l4->grid( $back_config_set_m4, $back_config_set_r4,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l5->grid( $back_config_set_m5, $back_config_set_r5,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
-$back_config_set_l6->grid( $back_config_set_m6, $back_config_set_r6,
- -padx => "2m", -pady => "2m", -sticky => "nwe");
+
+$back_config_set_l1->grid(-row => 1, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_m1->grid(-row => 1, -column => 2,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_r1->grid(-row => 1, -column => 3,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l2->grid(-row => 2, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_m2->grid(-row => 2, -column => 2,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_r2->grid(-row => 2, -column => 3,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l3->grid(-row => 3, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_m3->grid(-row => 3, -column => 2,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_r3->grid(-row => 3, -column => 3,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_l4->grid(-row => 4, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_m4->grid(-row => 4, -column => 2,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
+$back_config_set_r4->grid(-row => 4, -column => 3,
+ -padx => "2m", -pady => "2m", -sticky => "nwe");
#############
@@ -88,68 +80,51 @@ my $back_config_pap_m1 = $back_config_pap->Button(-text => "A4",
my $back_config_pap_r1 = $back_config_pap->Button(-text => "letter",
-command => sub { change_paper("all", "letter"); });
-$back_config_pap_l1->grid( $back_config_pap_m1, $back_config_pap_r1,
+$back_config_pap_l1->grid(-row => 1, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nswe");
+$back_config_pap_m1->grid(-row => 1, -column => 2,
+ -padx => "2m", -pady => "2m", -sticky => "nswe");
+$back_config_pap_r1->grid(-row => 1, -column => 3,
-padx => "2m", -pady => "2m", -sticky => "nswe");
my %papers;
-my %defaultpaper;
-
-sub init_paper_xdvi {
- if (!win32()) {
- @{$papers{"xdvi"}} = TeXLive::TLPaper::get_paper_list("xdvi");
- $defaultpaper{"xdvi"} = ${$papers{"xdvi"}}[0];
- }
-}
-sub init_paper_pdftex {
- @{$papers{"pdftex"}} = TeXLive::TLPaper::get_paper_list("pdftex");
- $defaultpaper{"pdftex"} = ${$papers{"pdftex"}}[0];
+if (!win32()) {
+ @{$papers{"xdvi"}} = `tlmgr xdvi paper --list`;
+ chomp(@{$papers{"xdvi"}});
}
-sub init_paper_dvips {
- @{$papers{"dvips"}} = TeXLive::TLPaper::get_paper_list("dvips");
- $defaultpaper{"dvips"} = ${$papers{"dvips"}}[0];
-}
-sub init_paper_dvipdfm {
- @{$papers{"dvipdfm"}} = TeXLive::TLPaper::get_paper_list("dvipdfm");
- $defaultpaper{"dvipdfm"} = ${$papers{"dvipdfm"}}[0];
-}
-sub init_paper_context {
- if (defined($localtlpdb->get_package("bin-context"))) {
- @{$papers{"context"}} = TeXLive::TLPaper::get_paper_list("context");
- $defaultpaper{"context"} = ${$papers{"context"}}[0];
- }
-}
-sub init_paper_dvipdfmx {
- @{$papers{"dvipdfmx"}} = TeXLive::TLPaper::get_paper_list("dvipdfmx");
- $defaultpaper{"dvipdfmx"} = ${$papers{"dvipdfmx"}}[0];
-}
-
-my %init_paper_subs;
-$init_paper_subs{"xdvi"} = \&init_paper_xdvi;
-$init_paper_subs{"pdftex"} = \&init_paper_pdftex;
-$init_paper_subs{"dvips"} = \&init_paper_dvips;
-$init_paper_subs{"context"} = \&init_paper_context;
-$init_paper_subs{"dvipdfm"} = \&init_paper_dvipdfm;
-$init_paper_subs{"dvipdfmx"} = \&init_paper_dvipdfmx;
-
-sub init_all_papers {
- for my $p (keys %init_paper_subs) {
- &{$init_paper_subs{$p}}();
- }
+@{$papers{"pdftex"}} = `tlmgr pdftex paper --list`;
+chomp(@{$papers{"pdftex"}});
+@{$papers{"dvipdfm"}} = `tlmgr dvipdfm paper --list`;
+chomp(@{$papers{"dvipdfm"}});
+@{$papers{"dvipdfmx"}} = `tlmgr dvipdfmx paper --list`;
+chomp(@{$papers{"dvipdfmx"}});
+@{$papers{"dvips"}} = `tlmgr dvips paper --list`;
+chomp(@{$papers{"dvips"}});
+if (defined($localtlpdb->get_package("bin-context"))) {
+ @{$papers{"context"}} = `tlmgr context paper --list`;
+ chomp(@{$papers{"context"}});
}
-init_all_papers();
-
+my %defaultpaper;
+my $row = 2;
my (%l,%m,%r);
foreach my $p (sort keys %papers) {
if (($p eq "context") && !defined($localtlpdb->get_package("bin-context"))) {
next;
}
+ my @pap = @{$papers{$p}};
+ $defaultpaper{$p} = $pap[0];
$l{$p} = $back_config_pap->Label(-text => ___("defaultpaperfor") . " $p", -anchor => "w");
$m{$p} = $back_config_pap->Label(-textvariable => \$defaultpaper{$p}, -anchor => "w");
$r{$p} = $back_config_pap->Button(-text => ___"change",
-command => sub { select_paper($p); }, -anchor => "w");
- $l{$p}->grid( $m{$p}, $r{$p},
+ $l{$p}->grid(-row => $row, -column => 1,
+ -padx => "2m", -pady => "2m", -sticky => "nsw");
+ $m{$p}->grid(-row => $row, -column => 2,
-padx => "2m", -pady => "2m", -sticky => "nsw");
+ $r{$p}->grid(-row => $row, -column => 3,
+ -padx => "2m", -pady => "2m", -sticky => "nsw");
+ $row++;
}
$back_config_pap->pack(-side => 'left', -fill => "both", -padx => "2m", -pady => "2m");
@@ -232,11 +207,13 @@ sub toggle_setting() {
sub change_paper {
my ($prog, $pap) = @_;
if ($prog eq "all") {
- execute_action_gui ("paper", "paper", $pap);
- init_all_papers();
+ run_program_show_output("tlmgr", "--location", "$location", "paper", $pap);
+ foreach my $p (keys %papers) {
+ $defaultpaper{$p} = $pap;
+ }
} else {
- execute_action_gui ( "paper", $prog, "paper", $pap);
- &{$init_paper_subs{$prog}}();
+ run_program_show_output("tlmgr", "--location", "$location", $prog, "paper", $pap);
+ $defaultpaper{$prog} = $pap;
}
}
@@ -260,6 +237,27 @@ sub select_paper {
}
+
+sub old_select_paper {
+ my $prog = shift;
+ my $foo = $back_config->Toplevel(-title => ___("paperfor") . " $prog");
+ my $var = $defaultpaper{$prog};
+ my @lop = @{$papers{$prog}};
+ my $nrpercols = 15;
+ my $row = 1;
+ my $col = 1;
+ foreach my $p (sort @{$papers{$prog}}) {
+ $foo->Radiobutton(-variable => \$var, -value => $p, -text => $p, -anchor => "w")->grid(-row => $row, -column => $col, -padx => "2m", -pady => "2m", -sticky => "nsw");
+ $row++;
+ if ($row > $nrpercols) {
+ $col++;
+ $row = 1;
+ }
+ }
+ $foo->Button(-text => ___"ok", -command => sub { change_paper($prog,$var); $foo->destroy; })->grid(-row => $nrpercols+1, -column => 1);
+ $foo->Button(-text => ___"cancel", -command => sub { $foo->destroy; })->grid(-row => $nrpercols+1, -column => 2);
+}
+
1;
### Local Variables:
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
index c75aa9203cf..bfe2df695f4 100755
--- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui.pl
@@ -1,78 +1,720 @@
#!/usr/bin/env perl
+#
+# $Id$
+#
# Copyright 2008 Tomasz Luczak, Norbert Preining
#
# GUI for tlmgr
#
-# This wrapper is a strange thing: If we do
-# require Tk;
-# we get errors when calling Tk::DoOneEvent(Tk::Event::DONT_WAIT):
-# Tk::Error: Usage [$object->]DoOneEvent([flags]) got 'Tk::Event::DONT_WAIT'
-# If I do
-# use Tk;
-# it goes away, but we cannot catch errors there.
-# Also, doing
-# BEGIN { require Tk; }
-# does work, but has the same problems.
+
+our $Master;
+
+use Tk;
+use Tk::Dialog;
+use Tk::NoteBook;
+use Tk::BrowseEntry;
+use Tk::ROText;
+use Tk::Balloon;
+use TeXLive::Splashscreen;
+
+use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug);
+
#
-# Now, the strange thing is that if I use a wrapper and require the real
-# script the error goes away. Dont ask me why ....
+# translation facility, not fully functional by now
#
-$^W = 1;
-use strict;
-
-BEGIN {
- $^W = 1;
- my $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
- chomp($Master);
- unshift (@INC, "$Master/tlpkg", "$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;
+our %TRANS;
+our $LANG;
+our %opts;
+
+$TRANS{'en'} = {
+ about => "About",
+ addpkg => "Adding packages",
+ archs => "Architectures",
+ cancel => "Cancel",
+ change => "Change",
+ changesrc => "Change Location",
+ changesrclong => "Change source from where packages are fetched at installation and update time.",
+ changedefaultsrc => "Change default installation source",
+ newdefaultsrc => "New default installation source",
+ choosedir => "Choose Directory",
+ config => "Configuration",
+ createformats => "Create formats on installation",
+ currentsource => "Current installation source: ",
+ debug => "Debug",
+ defaultsource => "Default installation source",
+ defaultnet => "Default net location",
+ defaultpaperfor => "Default paper for",
+ defaultpaperall => "Default paper for all",
+ defaultsettings => "Default settings",
+ force => "Force",
+ forceballoon => "Force the removal of a package even if it is referenced in a collection.",
+ nodepballoon => "For collections: install or remove will not install/remove the dependencies",
+ infoitem => "Information on the selected item",
+ install => "Installation",
+ installdoc => "Install macro/font docs",
+ installsrc => "Install macro/font sources",
+ installsel => "Install selected",
+ load => "Load",
+ warningtxt => "The database of the installation source has not been loaded.\n\nPlease use the \"Load\" (and possibly \"Change\") button to do so.",
+ newsource => "New location: ",
+ next => "Next",
+ ok => "Ok",
+ paperfor => "Select paper format for",
+ papersettings => "Paper settings",
+ pressbutton => "Press this button to load the database from the specified location.",
+ quit => "Quit",
+ reallyremove => "Really remove the complete TeX Live 2008 installation?\nYour last chance to change your mind!",
+ remove => "Remove",
+ removesel => "Remove selected",
+ removetl => "Remove TeX Live 2008",
+ rempkg => "Removing packages",
+ search => "Search",
+ remarchnotpos => "Select architectures to be added (removal not possible)",
+ selpkg => "Select packages",
+ toggle => "Toggle",
+ debugballoon => "Turn on debug mode when calling tlmgr.",
+ removaltab => "Uninstallation",
+ update => "Update",
+ updateall => "Update all",
+ updatesel => "Update selected",
+ updatepkg => "Updating packages",
+ ctrlshift => "Use Ctrl or Shift or drag to select more",
+ withoutdep => "without depends",
+ yes => "Yes",
+ no => "No",
+ starting => "Starting",
+ maytaketime => "This may take some time!\nPlease wait, the output will appear here when ready.\n",
+ completed => "Completed",
+ loaderrortxt => 'Could not load the TeX Live Database from $newroot\nIf you want to install or update packages, please try with a different installation source/location!\n\nFor configuration and removal you don\'t have to do anything.',
+ changeme => "...please change me...",
+ nodescription => "(no description available)",
+ applychanges => "Apply changes",
+ resetchanges => "Reset changes",
+ remarchinfo => "Removals of binary systems currently not supported!",
+ pleaseuse => "Please use the \"Add/Remove Programs\" from the Control Panel!",
+ completerem => "Complete removal completed",
+ loadtlpdbwait => "Loading local TeX Live Database\nThis may take some time, please wait!",
+ loadremotetlpdbwait => "Loading remote TeX Live Database\nThis may take some time, please wait!",
+ runupdater => "Some package will only be updated after you have terminated the GUI!\nPlease do so and after a short time restart the GUI.",
+ actions => "Actions",
+ reinitlsr => "Re-initialize file database",
+ recreateformats => "Re-create all formats",
+ updatemaps => "Update font map database",
+ warningnonetupdate => "No updates found.\n\nYour installation is set up to look on the disk for updates.\n\nIf you want to install from the Internet for this one time only, click on the \"Change\" button above and select \"Default Net Location\" (or any other network location you know to be working).\n\nIf you want to change it permanently, go to the \"Configuration\" Tab and change the default installation source.",
+ pleaseclick => "Please click on an item on the left for details",
+ alluptodate => "Everything up-to-date!",
+ # new ones
+ backupdir => "Default backup directory",
+ autobackup => "Auto backup setting",
+};
+
+
+sub update_status_window {
+ update_status(join(" ", @_));
+ $mw->update;
+ $::sww->update;
+}
+
+sub init_hooks {
+ push @::info_hook, \&update_status_window;
+ push @::warn_hook, \&update_status_window;
+ push @::debug_hook, \&update_status_window;
+ push @::ddebug_hook, \&update_status_window;
+ push @::dddebug_hook, \&update_status_window;
+}
+
+sub update_status {
+ my ($p) = @_;
+ $::progressw->insert("end", "$p\n");
+ $::progressw->see("end");
+}
+
+
+#
+# we keep the translations in different arrays since we MAY add the feature
+# to switch language on the fly
+sub ___ ($) {
+ my $s = shift;
+ # if no $LANG is set just return without anything
+ return $TRANS{"en"}->{$s} if !defined($LANG);
+ # if the translation is defined return it
+ return $TRANS{$LANG}->{"$s"} if defined($TRANS{$LANG}->{"$s"});
+ return $TRANS{"en"}->{$s} if defined($TRANS{"en"}->{$s});
+ return "$s";
+}
+
+my $opt_screen = $::guiscreen;
+
+if (defined($opts{"gui-lang"})) {
+ $LANG = $opts{"gui-lang"};
+} else {
+ if ($^O =~ /^MSWin(32|64)$/i) {
+ # trying to deduce automatically the country code
+ my $foo = TeXLive::TLWinGoo::reg_country();
+ if ($foo) {
+ $LANG = $foo;
+ } else {
+ warn "Didn't get any useful code from reg_country: $foo...\n";
+ }
+ } else {
+ # we load POSIX and locale stuff
+ require POSIX;
+ import POSIX qw/locale_h/;
+ # now we try to deduce $LANG
+ my $loc = setlocale(&POSIX::LC_MESSAGES);
+ my ($lang,$area,$codeset);
+ if ($loc =~ m/^([^_.]*)(_([^.]*))?(\.([^@]*))?(@.*)?$/) {
+ $lang = defined($1)?$1:"";
+ }
+ $LANG = $lang if ($lang);
+ }
+}
+
+
+#
+# try loading the lang file
+#
+if (defined($LANG) && (-r "$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG")) {
+ open(LANG,"<$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG");
+ while (<LANG>) {
+ chomp;
+ next if m/^\s*#/;
+ next if m/^\s*$/;
+ my ($a,$b) = split(/:/,$_,2);
+ $b =~ s/^\s*([^\s])/$1/;
+ $b =~ s/\s*$//;
+ next if ($b =~ m/^\s*$/);
+ if (!utf8::decode($b)) {
+ warn("decoding string to utf8 didn't work:$b\n");
+ }
+ $b =~ s/\\n/\n/g;
+ $TRANS{$LANG}{"$a"} = "$b";
}
- 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");
+}
+
+our @update_function_list;
+
+our $mw = MainWindow->new;
+$mw->title("TeX Live Manager 2008");
+$mw->withdraw;
+
+# create a progress bar window
+$::sww = $mw->Toplevel(-title => "log window",
+ -width => 400);
+$::sww->transient($mainwindow);
+#$::sww->grab();
+$::sww->Label(-text => "Log output")->pack;
+$::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 16);
+$::progressw->pack(-expand => 1, -fill => "both");
+
+
+init_hooks();
+
+info(___("loadtlpdbwait") . "\n");
+
+our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+die("cannot find tlpdb!") unless (defined($localtlpdb));
+
+our @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
+our @updatepackages;
+setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform);
+
+our $location;
+my $loc = $localtlpdb->option_location;
+if (defined($loc)) {
+ $location = $loc;
+}
+if (defined($opt_location)) {
+ $location = $opt_location;
+}
+
+our @allpackages;
+
+our $balloon = $mw->Balloon();
+
+
+push @update_function_list, \&check_location_on_ctan;
+push @update_function_list, \&init_install_media;
+push @update_function_list, \&create_update_list;
+
+
+
+# wm title . "tlmgr 2008"
+
+# frame .top
+our $top = $mw->Frame;
+
+our $quit = $top->Button(-text => ___"quit",
+ -command => sub { $mw->destroy; exit(0); });
+
+my $tlmgrrev = give_version();
+chomp($tlmgrrev);
+our $about = $top->Button(-text => ___"about",
+ -command => sub {
+ my $sw = $mw->DialogBox(-title => ___"about",
+ -buttons => [ ___"ok" ]);
+ $sw->add("Label", -text => "TeX Live Manager
+$tlmgrrev
+Copyright 2008 Tomasz Luczak, Norbert Preining
+License under the GNU General Public License version 2 or higher
+In case of problems, please contact: texlive\@tug.org"
+ )->pack(-padx => "3m", -pady => "3m");
+ $sw->Show;
+ });
+
+$about->pack(-side => 'right');
+$quit->pack(-side => 'right');
+
+$mw->bind('<Escape>', [ $quit, 'Invoke' ]);
+
+$top->Label(-text => ___("currentsource") . " ")->pack(-side => 'left');
+$top->Label(-textvariable => \$location, -relief => "sunken")->pack(-side => 'left');
+
+$balloon->attach(
+ $top->Button(-text => ___"load", -command => sub { run_update_functions(); })->pack(-side => 'left'),
+ -balloonmsg => ___"pressbutton");
+
+$balloon->attach(
+ $top->Button(-text => ___"change", -command => sub { menu_edit_location(); })->pack(-side => 'left'),
+ -balloonmsg => ___"changesrclong");
+
+# here we add a bit of trickery to make sure that the verbosity level
+# as set on the cmd line (-v or -v -v) is kept during pressing the
+# debug button on and off. If -v is *not* given activating it afterwards
+# defaults to one -v, while if -v -v is given on the cmd line, we keep
+# it that way
+$balloon->attach(
+ $top->Checkbutton(-text => ___"debug",
+ -onvalue => ($opt_verbosity == 0 ? 1 : $opt_verbosity),
+ -variable => \$::opt_verbosity)->pack(-side => 'left'),
+ -balloonmsg => ___"debugballoon");
+
+# frame .back -borderwidth 2
+our $back = $mw->NoteBook(-borderwidth => 2, -dynamicgeometry => 1);
+
+
+# pack .top .back -side top -fill both -expand 1
+$top->pack(-side => 'top', -fill => 'x', -expand => 0);
+$back->pack(-side => 'top', -fill => 'both', -expand => 1);
+
+require ("do_listframe.pl");
+# install screen
+our $back_f1 = $back->add("install",-label => ___"install");
+$screens{"install"} = $back_f1;
+my $install_win = do_listframe($back_f1,
+ ___"addpkg",
+ \@allpackages,
+ { install => { -text => ___"installsel",
+ -command => \&install_selected_packages}},
+ 1,1
+ );
+set_text_win($install_win, ___"warningtxt");
+# update screen
+our $back_up = $back->add("update", -label => ___"update");
+$screens{"update"} = $back_up;
+my $update_win = do_listframe($back_up,
+ ___"updatepkg",
+ \@updatepackages,
+ { updateall => { -text => ___"updateall",
+ -command => \&update_selected_packages,
+ -args => [ "--all" ]
+ },
+ updatesel => { -text => ___"updatesel",
+ -command => \&update_selected_packages
+ }},
+ 1,0
+ );
+set_text_win($update_win, ___"warningtxt");
+# remove screen
+our $back_f2 = $back->add("remove", -label => ___"remove");
+$screens{"remove"} = $back_f2;
+my $remove_win = do_listframe($back_f2,
+ ___"rempkg",
+ \@alllocalpackages,
+ { remove => { -text => ___"removesel",
+ -command => \&remove_selected_packages}},
+ 1,1
+ );
+set_text_win($remove_win, ___"pleaseclick");
+# uninstall screen
+require("gui-uninstall.pl");
+# arch support not be done via tlmgr on win32
+if (!win32()) {
+ require("gui-arch.pl");
+}
+# config screen
+require("gui-config.pl");
+
+if ($opt_load) {
+ run_update_functions();
+}
+
+
+if (defined($opt_screen)) {
+ $back->raise("$opt_screen");
+}
+
+info(___("completed") . "\n");
+$mw->deiconify;
+
+
+
+Tk::MainLoop();
+
+
+sub init_install_media {
+ my $newroot = $location;
+ if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) {
+ # nothing to be done
+ } else {
+ info(___("loadremotetlpdbwait") . "\n");
+ $tlmediasrc = TeXLive::TLMedia->new($newroot);
+ info(___("completed") . "\n");
+ if (!defined($tlmediasrc)) {
+ # something went badly wrong, maybe the newroot is wrong?
+ $mw->Dialog(-title => "warning",
+ -text => ___"loaderrortxt",
+ -buttons => [ ___"ok" ])->Show;
+ $location = ___"changeme";
+ @allpackages = ();
} 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.
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
+ set_text_win($install_win, ___"pleaseclick");
+ set_text_win($remove_win, ___"pleaseclick");
+ set_text_win($update_win, ___"pleaseclick");
+ }
+ }
+}
+
+sub set_text_win {
+ my ($w, $t) = @_;
+ $w->delete("0.0", "end");
+ $w->insert("0.0", "$t");
+ $w->see("0.0");
+}
+
+sub run_program_show_output {
+ my $td = $mw->Toplevel(-title => ___"tlmgr process");
+ $td->transient($mw);
+ $td->grab();
+ my $tf = $td->Scrolled("ROText", -width => 80,
+ -height => 10,
+ -wrap => "none",
+ -scrollbars => "ose"
+ )->pack(-expand => 1, -fill => "both");
+ my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m",
+ -command => sub { $td->destroy; });
+ # start the installation, read the output
+ $mw->update;
+ $::sww->update;
+ #
+ # ok, that stupid perl for windows does not have fork, why? no idea
+ # we have to deal with that
+ if ($^O=~/^MSWin(32|64)$/i) {
+ $tf->insert("end", ___("starting") . " @_\n\n" . ___"maytaketime");
+ $mw->update;
+ $::sww->update;
+ my $ret = `@_`;
+ $tf->insert("end", "$ret\n\n" . ___("completed") . "\n");
+ $tf->see("end");
+ $ok->pack;
+ $mw->update;
+ $::sww->update;
+ } else {
+ my $pid = open(KID_TO_READ, "-|");
+ if ($pid) { # parent
+ while (<KID_TO_READ>) {
+ $tf->insert("end",$_);
+ $tf->see("end");
+ $mw->update;
+ $::sww->update;
+ }
+ close(KID_TO_READ) || warn "kid exited $?";
+ $tf->insert("end","\n\nCOMPLETED\n");
+ $tf->see("end");
+ $ok->pack;
+ } else { #kid
+ # do not buffer lines ...
+ $| = 1;
+ open STDERR, '>&STDOUT';
+ print ___("starting") . " @_\n";
+ exec(@_)
+ || die "can't exec program: $!";
+ # NOTREACHED
+ }
+ }
+}
-";
+sub install_selected_packages {
+ if (@_) {
+ my @args = qw/install/;
+ push @args, "-force" if $opt_force;
+ push @args, @_;
+ execute_action_gui(@args);
+ reinit_local_tlpdb();
+ # now we check that the installation has succeeded by checking that
+ # all packages in @_ are installed. Otherwise we pop up a warning window
+ my $do_warn = 0;
+ for my $p (@_) {
+ if (!defined($localtlpdb->get_package($p))) {
+ $do_warn = 1;
+ last;
+ }
+ }
+ give_warning_window(___"install", @_) if $do_warn;
+ }
+}
+
+sub update_selected_packages {
+ if (@_) {
+ my $updater_needed = 0;
+ if (win32()) {
+ # we want to check for those packages which need special treatment
+ # and pop up a warning in case it is going to be updated
+ my @upgradepkgs;
+ if ($_[0] eq "--all") {
+ @upgradepkgs = @updatepackages;
+ } else {
+ @upgradepkgs = @_;
+ }
+ foreach my $p (@upgradepkgs) {
+ if ($p =~ m/$WinSpecialUpdatePackagesRegexp/) {
+ $updater_needed = 1;
+ last;
+ }
+ }
+ }
+ my @args = qw/update/;
+ push @args, "-force" if $opt_force;
+ push @args, @_;
+ execute_action_gui(@args);
+ if (win32() && $updater_needed) {
+ my $t = ___"runupdater";
+ $t =~ s/TEXROOT/$Master/;
+ # TODO TODO TODO TODO
+ # here we should terminate the tlmgr and tell the user he should
+ # restart afterwards, or create the updater such that the tlmgr
+ # is restarted automatically, because the tlmgr(2).bat file
+ # does the updates automatically.
+ my $sw = $mw->DialogBox(-title => "updater needed", -buttons => [ ___"ok" ]);
+ $sw->add("Label", -text => $t)->pack;
+ $sw->Show;
+ #$mw->Dialog(-title => "updater needed",
+ # -text => $t,
+ # -buttons => [ ___"ok" ])->Show;
+ }
+ reinit_local_tlpdb();
+ # TODO TODO TODO
+ # we should give a warning window when something didn't work out!!!
+ }
+}
+
+sub remove_selected_packages {
+ if (@_) {
+ my @args = qw/remove/;
+ push @args, "-force" if $opt_force;
+ push @args, @_;
+ execute_action_gui(@args);
+ reinit_local_tlpdb();
+ my $do_warn = 0;
+ for my $p (@_) {
+ if (defined($localtlpdb->get_package($p))) {
+ $do_warn = 1;
+ last;
+ }
+ }
+ give_warning_window(___"remove", @_) if $do_warn;
+ }
+}
+
+sub reinit_local_tlpdb {
+ $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+ die("cannot find tlpdb!") unless (defined($localtlpdb));
+ @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
+ if (defined($tlmediatlpdb)) {
+ @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
+ }
+ create_update_list();
+}
+
+sub create_update_list {
+ my @ret = ();
+ my @archret = ();
+ if (defined($tlmediatlpdb)) {
+ foreach my $lp ($localtlpdb->list_packages) {
+ next if ($lp =~ m/00texlive-installation.config/);
+ my $lrev = $localtlpdb->get_package($lp)->revision;
+ my $up = $tlmediatlpdb->get_package($lp);
+ my $urev;
+ if ($up) {
+ $urev = $up->revision;
+ } else {
+ $urev = 0;
+ }
+ if ($urev > $lrev) {
+ if ($lp =~ m/\./) {
+ push @archret, $lp;
+ } else {
+ push @ret, $lp;
+ }
+ }
+ }
+ foreach my $p (@archret) {
+ my $foundparent = 0;
+ foreach my $q (@ret) {
+ $foundparent = 1 if ($p =~ m/^$q\./);
+ }
+ push @ret, $p unless $foundparent;
+ }
+ # issue a warning if no updates are available, the tlmediatlpdb is loaded
+ # and is not from the net
+ if ($#ret < 0) {
+ if ($tlmediasrc->media ne "NET") {
+ set_text_win($update_win, ___"warningnonetupdate");
+ } else {
+ set_text_win($update_win, ___"alluptodate");
+ }
}
} else {
- printf STDERR "Problem loading Tk: $@\n";
+ @ret = ();
+ }
+ @updatepackages = @ret;
+ # check for presence of critical packages and if there are updates
+ # give a warning window
+ my @critical = $localtlpdb->expand_dependencies("-no-collections",
+ $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList);
+ my $criticalupdate = 0;
+ OUTER: for my $p (@updatepackages) {
+ for my $cp (@critical) {
+ if ($p =~ m/^$cp/) {
+ $criticalupdate = 1;
+ # terminate the whole checking here
+ last OUTER;
+ }
+ }
+ }
+ if ($criticalupdate) {
+ my $sw = $mw->DialogBox(-title => ___"warning", -buttons => [ ___"ok" ]);
+ $sw->add("Label", -text => "Updates for the tlmgr are present.
+Installation and upgrades won't work without being forced.
+Please select only (if listed) the bin-texlive and texlive.infra package
+and press \"update selected packages\". Then quit the program."
+ )->pack(-padx => "3m", -pady => "3m");
+ $sw->Show;
+ }
+}
+
+sub setup_list {
+ my $addi = shift;
+ my @ret;
+ my @other;
+ foreach my $p (@_) {
+ if ($p !~ m;\.;) {
+ my $pushstr = "";
+ if ($addi) {
+ if (defined($localtlpdb->get_package($p))) {
+ $pushstr = "(i) ";
+ } else {
+ $pushstr = " ";
+ }
+ }
+ $pushstr .= "$p";
+ if ($p =~ m;^collection-;) {
+ push @ret, $pushstr;
+ } else {
+ push @other, $pushstr;
+ }
+ }
}
- exit 1;
+ push @ret, @other;
+ return(@ret);
}
-# 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 menu_edit_location {
+ my $key = shift;
+ my $val;
+ my $sw = $mw->Toplevel(-title => ___"changesrc");
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => ___"newsource")->pack(-padx => "2m", -pady => "2m");
+ my $entry = $sw->Entry(-text => $location, -width => 30);
+ $entry->pack();
+ my $f1 = $sw->Frame;
+ $f1->Button(-text => ___"choosedir",
+ -command => sub {
+ my $var = $sw->chooseDirectory;
+ if (defined($var)) {
+ $entry->delete(0,"end");
+ $entry->insert(0,$var);
+ }
+ })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ $f1->Button(-text => ___"defaultnet",
+ -command => sub {
+ $entry->delete(0,"end");
+ $entry->insert(0,$TeXLiveURL);
+ })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ $f1->pack;
+ my $f = $sw->Frame;
+ my $okbutton = $f->Button(-text => ___"ok",
+ -command => sub { $location = $entry->get;
+ run_update_functions();
+ $sw->destroy;
+ })->pack(-side => 'left', -padx => "2m", -pady => "2m");
+ my $cancelbutton = $f->Button(-text => 'Cancel',
+ -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
+ $f->pack(-expand => 'x');
+ $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
}
+sub run_update_functions {
+ foreach my $f (@update_function_list) {
+ &{$f}();
+ }
+}
-require("tlmgrgui-real.pl");
+sub check_location_on_ctan {
+ # we want to check that if mirror.ctan.org
+ # is used that we select a mirror once
+ if ($location =~ m/$TeXLive::TLConfig::TeXLiveServerURL/) {
+ $location = TeXLive::TLUtils::give_ctan_mirror();
+ }
+}
+
+sub execute_action_gui {
+ # my $td = $mw->Toplevel(-title => ___"info window");
+ # $td->transient($mw);
+ # $td->grab();
+ # my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m",
+ # -command => sub { $td->destroy; });
+ # my $lab = $td->Label(-text => ___("starting") . " @_\n");
+ # $lab->pack;
+ execute_action(@_);
+ info(___("completed") . "\n");
+ # my $labb = $td->Label(-text => ___"finished");
+ # $labb->pack;
+ # $ok->pack;
+}
+
+sub give_warning_window {
+ my ($act, @args) = @_;
+ my $sw = $mw->DialogBox(-title => ___"info window", -buttons => [ ___"ok" ]);
+ $sw->add("Label", -text => "Executing action $act on @args failed.
+Please consult the log window for details."
+ )->pack(-padx => "3m", -pady => "3m");
+ $sw->Show;
+}
+
+1;
+
+__END__
-# should not be reached ...
-#
-exit 0;
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
# vim:set tabstop=2 expandtab: #
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl
new file mode 100755
index 00000000000..c75aa9203cf
--- /dev/null
+++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+# Copyright 2008 Tomasz Luczak, Norbert Preining
+#
+# GUI for tlmgr
+#
+# This wrapper is a strange thing: If we do
+# require Tk;
+# we get errors when calling Tk::DoOneEvent(Tk::Event::DONT_WAIT):
+# Tk::Error: Usage [$object->]DoOneEvent([flags]) got 'Tk::Event::DONT_WAIT'
+# If I do
+# use Tk;
+# it goes away, but we cannot catch errors there.
+# Also, doing
+# BEGIN { require Tk; }
+# does work, but has the same problems.
+#
+# Now, the strange thing is that if I use a wrapper and require the real
+# script the error goes away. Dont ask me why ....
+#
+$^W = 1;
+use strict;
+
+BEGIN {
+ $^W = 1;
+ my $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($Master);
+ unshift (@INC, "$Master/tlpkg", "$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 {
+ printf STDERR "Problem loading Tk: $@\n";
+ }
+ exit 1;
+}
+
+# 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;
+}
+
+
+require("tlmgrgui-real.pl");
+
+# should not be reached ...
+#
+exit 0;
+
+# vim:set tabstop=2 expandtab: #
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
deleted file mode 100755
index d4ea4d008da..00000000000
--- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
+++ /dev/null
@@ -1,713 +0,0 @@
-#!/usr/bin/env perl
-#
-# $Id$
-#
-# Copyright 2008 Tomasz Luczak, Norbert Preining
-#
-# GUI for tlmgr
-#
-
-our $Master;
-
-use Tk;
-use Tk::Dialog;
-use Tk::NoteBook;
-use Tk::BrowseEntry;
-use Tk::ROText;
-use Tk::Balloon;
-use TeXLive::Splashscreen;
-
-use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug);
-
-#
-# translation facility, not fully functional by now
-#
-our %TRANS;
-our $LANG;
-our %opts;
-
-$TRANS{'en'} = {
- about => "About",
- addpkg => "Adding packages",
- archs => "Architectures",
- cancel => "Cancel",
- change => "Change",
- changesrc => "Change Location",
- changesrclong => "Change source from where packages are fetched at installation and update time.",
- changedefaultsrc => "Change default installation source",
- newdefaultsrc => "New default installation source",
- choosedir => "Choose Directory",
- config => "Configuration",
- createformats => "Create formats on installation",
- currentsource => "Current installation source: ",
- debug => "Debug",
- defaultsource => "Default installation source",
- defaultnet => "Default net location",
- defaultpaperfor => "Default paper for",
- defaultpaperall => "Default paper for all",
- defaultsettings => "Default settings",
- force => "Force",
- forceballoon => "Force the removal of a package even if it is referenced in a collection.",
- nodepballoon => "For collections: install or remove will not install/remove the dependencies",
- infoitem => "Information on the selected item",
- install => "Installation",
- installdoc => "Install macro/font docs",
- installsrc => "Install macro/font sources",
- installsel => "Install selected",
- load => "Load",
- warningtxt => "The database of the installation source has not been loaded.\n\nPlease use the \"Load\" (and possibly \"Change\") button to do so.",
- newsource => "New location: ",
- next => "Next",
- ok => "Ok",
- paperfor => "Select paper format for",
- papersettings => "Paper settings",
- pressbutton => "Press this button to load the database from the specified location.",
- quit => "Quit",
- reallyremove => "Really remove the complete TeX Live 2008 installation?\nYour last chance to change your mind!",
- remove => "Remove",
- removesel => "Remove selected",
- removetl => "Remove TeX Live 2008",
- rempkg => "Removing packages",
- search => "Search",
- remarchnotpos => "Select architectures to be added (removal not possible)",
- selpkg => "Select packages",
- toggle => "Toggle",
- debugballoon => "Turn on debug mode when calling tlmgr.",
- removaltab => "Uninstallation",
- update => "Update",
- updateall => "Update all",
- updatesel => "Update selected",
- updatepkg => "Updating packages",
- ctrlshift => "Use Ctrl or Shift or drag to select more",
- withoutdep => "without depends",
- yes => "Yes",
- no => "No",
- starting => "Starting",
- maytaketime => "This may take some time!\nPlease wait, the output will appear here when ready.\n",
- completed => "Completed",
- loaderrortxt => 'Could not load the TeX Live Database from $newroot\nIf you want to install or update packages, please try with a different installation source/location!\n\nFor configuration and removal you don\'t have to do anything.',
- changeme => "...please change me...",
- nodescription => "(no description available)",
- applychanges => "Apply changes",
- resetchanges => "Reset changes",
- remarchinfo => "Removals of binary systems currently not supported!",
- pleaseuse => "Please use the \"Add/Remove Programs\" from the Control Panel!",
- completerem => "Complete removal completed",
- loadtlpdbwait => "Loading local TeX Live Database\nThis may take some time, please wait!",
- loadremotetlpdbwait => "Loading remote TeX Live Database\nThis may take some time, please wait!",
- runupdater => "Some package cannot be updated using the GUI!\nPlease run TEXROOT/tlpkg/installer/updater.bat once,\notherwise the updates will not be complete!\nNOTE: You have to QUIT this program first!",
- actions => "Actions",
- reinitlsr => "Re-initialize file database",
- recreateformats => "Re-create all formats",
- updatemaps => "Update font map database",
- warningnonetupdate => "No updates found.\n\nYour installation is set up to look on the disk for updates.\n\nIf you want to install from the Internet for this one time only, click on the \"Change\" button above and select \"Default Net Location\" (or any other network location you know to be working).\n\nIf you want to change it permanently, go to the \"Configuration\" Tab and change the default installation source.",
- pleaseclick => "Please click on an item on the left for details",
- alluptodate => "Everything up-to-date!",
- # new ones
- backupdir => "Default backup directory",
- autobackup => "Auto backup setting",
-};
-
-
-sub update_status_window {
- update_status(join(" ", @_));
- $mw->update;
- $::sww->update;
-}
-
-sub init_hooks {
- push @::info_hook, \&update_status_window;
- push @::warn_hook, \&update_status_window;
- push @::debug_hook, \&update_status_window;
- push @::ddebug_hook, \&update_status_window;
- push @::dddebug_hook, \&update_status_window;
-}
-
-sub update_status {
- my ($p) = @_;
- $::progressw->insert("end", "$p\n");
- $::progressw->see("end");
-}
-
-
-#
-# we keep the translations in different arrays since we MAY add the feature
-# to switch language on the fly
-sub ___ ($) {
- my $s = shift;
- # if no $LANG is set just return without anything
- return $TRANS{"en"}->{$s} if !defined($LANG);
- # if the translation is defined return it
- return $TRANS{$LANG}->{"$s"} if defined($TRANS{$LANG}->{"$s"});
- return $TRANS{"en"}->{$s} if defined($TRANS{"en"}->{$s});
- return "$s";
-}
-
-my $opt_screen = $::guiscreen;
-
-if (defined($opts{"gui-lang"})) {
- $LANG = $opts{"gui-lang"};
-} else {
- if ($^O =~ /^MSWin(32|64)$/i) {
- # trying to deduce automatically the country code
- my $foo = TeXLive::TLWinGoo::reg_country();
- if ($foo) {
- $LANG = $foo;
- } else {
- warn "Didn't get any useful code from reg_country: $foo...\n";
- }
- } else {
- # we load POSIX and locale stuff
- require POSIX;
- import POSIX qw/locale_h/;
- # now we try to deduce $LANG
- my $loc = setlocale(&POSIX::LC_MESSAGES);
- my ($lang,$area,$codeset);
- if ($loc =~ m/^([^_.]*)(_([^.]*))?(\.([^@]*))?(@.*)?$/) {
- $lang = defined($1)?$1:"";
- }
- $LANG = $lang if ($lang);
- }
-}
-
-
-#
-# try loading the lang file
-#
-if (defined($LANG) && (-r "$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG")) {
- open(LANG,"<$Master/texmf/scripts/texlive/tlmgrgui/lang/$LANG");
- while (<LANG>) {
- chomp;
- next if m/^\s*#/;
- next if m/^\s*$/;
- my ($a,$b) = split(/:/,$_,2);
- $b =~ s/^\s*([^\s])/$1/;
- $b =~ s/\s*$//;
- next if ($b =~ m/^\s*$/);
- if (!utf8::decode($b)) {
- warn("decoding string to utf8 didn't work:$b\n");
- }
- $b =~ s/\\n/\n/g;
- $TRANS{$LANG}{"$a"} = "$b";
- }
-}
-
-our @update_function_list;
-
-our $mw = MainWindow->new;
-$mw->title("TeX Live Manager 2008");
-$mw->withdraw;
-
-# create a progress bar window
-$::sww = $mw->Toplevel(-title => "log window",
- -width => 400);
-$::sww->transient($mainwindow);
-#$::sww->grab();
-$::sww->Label(-text => "Log output")->pack;
-$::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 16);
-$::progressw->pack(-expand => 1, -fill => "both");
-
-
-init_hooks();
-
-info(___("loadtlpdbwait") . "\n");
-
-our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
-die("cannot find tlpdb!") unless (defined($localtlpdb));
-
-our @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
-our @updatepackages;
-setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform);
-
-our $location;
-my $loc = $localtlpdb->option_location;
-if (defined($loc)) {
- $location = $loc;
-}
-if (defined($opt_location)) {
- $location = $opt_location;
-}
-
-our @allpackages;
-
-our $balloon = $mw->Balloon();
-
-
-push @update_function_list, \&check_location_on_ctan;
-push @update_function_list, \&init_install_media;
-push @update_function_list, \&create_update_list;
-
-
-
-# wm title . "tlmgr 2008"
-
-# frame .top
-our $top = $mw->Frame;
-
-our $quit = $top->Button(-text => ___"quit",
- -command => sub { $mw->destroy; exit(0); });
-
-my $tlmgrrev = give_version();
-chomp($tlmgrrev);
-our $about = $top->Button(-text => ___"about",
- -command => sub {
- my $sw = $mw->DialogBox(-title => ___"about",
- -buttons => [ ___"ok" ]);
- $sw->add("Label", -text => "TeX Live Manager
-$tlmgrrev
-Copyright 2008 Tomasz Luczak, Norbert Preining
-License under the GNU General Public License version 2 or higher
-In case of problems, please contact: texlive\@tug.org"
- )->pack(-padx => "3m", -pady => "3m");
- $sw->Show;
- });
-
-$about->pack(-side => 'right');
-$quit->pack(-side => 'right');
-
-$mw->bind('<Escape>', [ $quit, 'Invoke' ]);
-
-$top->Label(-text => ___("currentsource") . " ")->pack(-side => 'left');
-$top->Label(-textvariable => \$location, -relief => "sunken")->pack(-side => 'left');
-
-$balloon->attach(
- $top->Button(-text => ___"load", -command => sub { run_update_functions(); })->pack(-side => 'left'),
- -balloonmsg => ___"pressbutton");
-
-$balloon->attach(
- $top->Button(-text => ___"change", -command => sub { menu_edit_location(); })->pack(-side => 'left'),
- -balloonmsg => ___"changesrclong");
-
-# here we add a bit of trickery to make sure that the verbosity level
-# as set on the cmd line (-v or -v -v) is kept during pressing the
-# debug button on and off. If -v is *not* given activating it afterwards
-# defaults to one -v, while if -v -v is given on the cmd line, we keep
-# it that way
-$balloon->attach(
- $top->Checkbutton(-text => ___"debug",
- -onvalue => ($opt_verbosity == 0 ? 1 : $opt_verbosity),
- -variable => \$::opt_verbosity)->pack(-side => 'left'),
- -balloonmsg => ___"debugballoon");
-
-# frame .back -borderwidth 2
-our $back = $mw->NoteBook(-borderwidth => 2, -dynamicgeometry => 1);
-
-
-# pack .top .back -side top -fill both -expand 1
-$top->pack(-side => 'top', -fill => 'x', -expand => 0);
-$back->pack(-side => 'top', -fill => 'both', -expand => 1);
-
-require ("do_listframe.pl");
-# install screen
-our $back_f1 = $back->add("install",-label => ___"install");
-$screens{"install"} = $back_f1;
-my $install_win = do_listframe($back_f1,
- ___"addpkg",
- \@allpackages,
- { install => { -text => ___"installsel",
- -command => \&install_selected_packages}},
- 1,1
- );
-set_text_win($install_win, ___"warningtxt");
-# update screen
-our $back_up = $back->add("update", -label => ___"update");
-$screens{"update"} = $back_up;
-my $update_win = do_listframe($back_up,
- ___"updatepkg",
- \@updatepackages,
- { updateall => { -text => ___"updateall",
- -command => \&update_selected_packages,
- -args => [ "--all" ]
- },
- updatesel => { -text => ___"updatesel",
- -command => \&update_selected_packages
- }},
- 1,0
- );
-set_text_win($update_win, ___"warningtxt");
-# remove screen
-our $back_f2 = $back->add("remove", -label => ___"remove");
-$screens{"remove"} = $back_f2;
-my $remove_win = do_listframe($back_f2,
- ___"rempkg",
- \@alllocalpackages,
- { remove => { -text => ___"removesel",
- -command => \&remove_selected_packages}},
- 1,1
- );
-set_text_win($remove_win, ___"pleaseclick");
-# uninstall screen
-require("gui-uninstall.pl");
-# arch support not be done via tlmgr on win32
-if (!win32()) {
- require("gui-arch2.pl");
-}
-# config screen
-require("gui-config2.pl");
-
-if ($opt_load) {
- run_update_functions();
-}
-
-
-if (defined($opt_screen)) {
- $back->raise("$opt_screen");
-}
-
-info(___("completed") . "\n");
-$mw->deiconify;
-
-
-
-Tk::MainLoop();
-
-
-sub init_install_media {
- my $newroot = $location;
- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) {
- # nothing to be done
- } else {
- info(___("loadremotetlpdbwait") . "\n");
- $tlmediasrc = TeXLive::TLMedia->new($newroot);
- info(___("completed") . "\n");
- if (!defined($tlmediasrc)) {
- # something went badly wrong, maybe the newroot is wrong?
- $mw->Dialog(-title => "warning",
- -text => ___"loaderrortxt",
- -buttons => [ ___"ok" ])->Show;
- $location = ___"changeme";
- @allpackages = ();
- } else {
- $tlmediatlpdb = $tlmediasrc->tlpdb;
- @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
- set_text_win($install_win, ___"pleaseclick");
- set_text_win($remove_win, ___"pleaseclick");
- set_text_win($update_win, ___"pleaseclick");
- }
- }
-}
-
-sub set_text_win {
- my ($w, $t) = @_;
- $w->delete("0.0", "end");
- $w->insert("0.0", "$t");
- $w->see("0.0");
-}
-
-sub run_program_show_output {
- my $td = $mw->Toplevel(-title => ___"tlmgr process");
- $td->transient($mw);
- $td->grab();
- my $tf = $td->Scrolled("ROText", -width => 80,
- -height => 10,
- -wrap => "none",
- -scrollbars => "ose"
- )->pack(-expand => 1, -fill => "both");
- my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m",
- -command => sub { $td->destroy; });
- # start the installation, read the output
- $mw->update;
- $::sww->update;
- #
- # ok, that stupid perl for windows does not have fork, why? no idea
- # we have to deal with that
- if ($^O=~/^MSWin(32|64)$/i) {
- $tf->insert("end", ___("starting") . " @_\n\n" . ___"maytaketime");
- $mw->update;
- $::sww->update;
- my $ret = `@_`;
- $tf->insert("end", "$ret\n\n" . ___("completed") . "\n");
- $tf->see("end");
- $ok->pack;
- $mw->update;
- $::sww->update;
- } else {
- my $pid = open(KID_TO_READ, "-|");
- if ($pid) { # parent
- while (<KID_TO_READ>) {
- $tf->insert("end",$_);
- $tf->see("end");
- $mw->update;
- $::sww->update;
- }
- close(KID_TO_READ) || warn "kid exited $?";
- $tf->insert("end","\n\nCOMPLETED\n");
- $tf->see("end");
- $ok->pack;
- } else { #kid
- # do not buffer lines ...
- $| = 1;
- open STDERR, '>&STDOUT';
- print ___("starting") . " @_\n";
- exec(@_)
- || die "can't exec program: $!";
- # NOTREACHED
- }
- }
-}
-
-sub install_selected_packages {
- if (@_) {
- my @args = qw/install/;
- push @args, "-force" if $opt_force;
- push @args, @_;
- execute_action_gui(@args);
- reinit_local_tlpdb();
- # now we check that the installation has succeeded by checking that
- # all packages in @_ are installed. Otherwise we pop up a warning window
- my $do_warn = 0;
- for my $p (@_) {
- if (!defined($localtlpdb->get_package($p))) {
- $do_warn = 1;
- last;
- }
- }
- give_warning_window(___"install", @_) if $do_warn;
- }
-}
-
-sub update_selected_packages {
- if (@_) {
- my $updater_needed = 0;
- if (win32()) {
- # we want to check for those packages which need special treatment
- # and pop up a warning in case it is going to be updated
- my @upgradepkgs;
- if ($_[0] eq "--all") {
- @upgradepkgs = @updatepackages;
- } else {
- @upgradepkgs = @_;
- }
- foreach my $p (@upgradepkgs) {
- if ($p =~ m/$WinSpecialUpdatePackagesRegexp/) {
- $updater_needed = 1;
- last;
- }
- }
- }
- my @args = qw/update/;
- push @args, "-force" if $opt_force;
- push @args, @_;
- execute_action_gui(@args);
- if (win32() && $updater_needed) {
- my $t = ___"runupdater";
- $t =~ s/TEXROOT/$Master/;
- my $sw = $mw->DialogBox(-title => "updater needed", -buttons => [ ___"ok" ]);
- $sw->add("Label", -text => $t)->pack;
- $sw->Show;
- #$mw->Dialog(-title => "updater needed",
- # -text => $t,
- # -buttons => [ ___"ok" ])->Show;
- }
- reinit_local_tlpdb();
- # TODO TODO TODO
- # we should give a warning window when something didn't work out!!!
- }
-}
-
-sub remove_selected_packages {
- if (@_) {
- my @args = qw/remove/;
- push @args, "-force" if $opt_force;
- push @args, @_;
- execute_action_gui(@args);
- reinit_local_tlpdb();
- my $do_warn = 0;
- for my $p (@_) {
- if (defined($localtlpdb->get_package($p))) {
- $do_warn = 1;
- last;
- }
- }
- give_warning_window(___"remove", @_) if $do_warn;
- }
-}
-
-sub reinit_local_tlpdb {
- $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
- die("cannot find tlpdb!") unless (defined($localtlpdb));
- @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
- if (defined($tlmediatlpdb)) {
- @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
- }
- create_update_list();
-}
-
-sub create_update_list {
- my @ret = ();
- my @archret = ();
- if (defined($tlmediatlpdb)) {
- foreach my $lp ($localtlpdb->list_packages) {
- next if ($lp =~ m/00texlive-installation.config/);
- my $lrev = $localtlpdb->get_package($lp)->revision;
- my $up = $tlmediatlpdb->get_package($lp);
- my $urev;
- if ($up) {
- $urev = $up->revision;
- } else {
- $urev = 0;
- }
- if ($urev > $lrev) {
- if ($lp =~ m/\./) {
- push @archret, $lp;
- } else {
- push @ret, $lp;
- }
- }
- }
- foreach my $p (@archret) {
- my $foundparent = 0;
- foreach my $q (@ret) {
- $foundparent = 1 if ($p =~ m/^$q\./);
- }
- push @ret, $p unless $foundparent;
- }
- # issue a warning if no updates are available, the tlmediatlpdb is loaded
- # and is not from the net
- if ($#ret < 0) {
- if ($tlmediasrc->media ne "NET") {
- set_text_win($update_win, ___"warningnonetupdate");
- } else {
- set_text_win($update_win, ___"alluptodate");
- }
- }
- } else {
- @ret = ();
- }
- @updatepackages = @ret;
- # check for presence of critical packages and if there are updates
- # give a warning window
- my @critical = $localtlpdb->expand_dependencies("-no-collections",
- $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList);
- my $criticalupdate = 0;
- OUTER: for my $p (@updatepackages) {
- for my $cp (@critical) {
- if ($p =~ m/^$cp/) {
- $criticalupdate = 1;
- # terminate the whole checking here
- last OUTER;
- }
- }
- }
- if ($criticalupdate) {
- my $sw = $mw->DialogBox(-title => ___"warning", -buttons => [ ___"ok" ]);
- $sw->add("Label", -text => "Updates for the tlmgr are present.
-Installation and upgrades won't work without being forced."
- )->pack(-padx => "3m", -pady => "3m");
- $sw->Show;
- }
-}
-
-sub setup_list {
- my $addi = shift;
- my @ret;
- my @other;
- foreach my $p (@_) {
- if ($p !~ m;\.;) {
- my $pushstr = "";
- if ($addi) {
- if (defined($localtlpdb->get_package($p))) {
- $pushstr = "(i) ";
- } else {
- $pushstr = " ";
- }
- }
- $pushstr .= "$p";
- if ($p =~ m;^collection-;) {
- push @ret, $pushstr;
- } else {
- push @other, $pushstr;
- }
- }
- }
- push @ret, @other;
- return(@ret);
-}
-
-
-sub menu_edit_location {
- my $key = shift;
- my $val;
- my $sw = $mw->Toplevel(-title => ___"changesrc");
- $sw->transient($mw);
- $sw->grab();
- $sw->Label(-text => ___"newsource")->pack(-padx => "2m", -pady => "2m");
- my $entry = $sw->Entry(-text => $location, -width => 30);
- $entry->pack();
- my $f1 = $sw->Frame;
- $f1->Button(-text => ___"choosedir",
- -command => sub {
- my $var = $sw->chooseDirectory;
- if (defined($var)) {
- $entry->delete(0,"end");
- $entry->insert(0,$var);
- }
- })->pack(-side => "left", -padx => "2m", -pady => "2m");
- $f1->Button(-text => ___"defaultnet",
- -command => sub {
- $entry->delete(0,"end");
- $entry->insert(0,$TeXLiveURL);
- })->pack(-side => "left", -padx => "2m", -pady => "2m");
- $f1->pack;
- my $f = $sw->Frame;
- my $okbutton = $f->Button(-text => ___"ok",
- -command => sub { $location = $entry->get;
- run_update_functions();
- $sw->destroy;
- })->pack(-side => 'left', -padx => "2m", -pady => "2m");
- my $cancelbutton = $f->Button(-text => 'Cancel',
- -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
- $f->pack(-expand => 'x');
- $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
- $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
-}
-
-sub run_update_functions {
- foreach my $f (@update_function_list) {
- &{$f}();
- }
-}
-
-sub check_location_on_ctan {
- # we want to check that if mirror.ctan.org
- # is used that we select a mirror once
- if ($location =~ m/$TeXLive::TLConfig::TeXLiveServerURL/) {
- $location = TeXLive::TLUtils::give_ctan_mirror();
- }
-}
-
-sub execute_action_gui {
- # my $td = $mw->Toplevel(-title => ___"info window");
- # $td->transient($mw);
- # $td->grab();
- # my $ok = $td->Button(-text => ___"ok", -padx => "3m", -pady => "3m",
- # -command => sub { $td->destroy; });
- # my $lab = $td->Label(-text => ___("starting") . " @_\n");
- # $lab->pack;
- execute_action(@_);
- info(___("completed") . "\n");
- # my $labb = $td->Label(-text => ___"finished");
- # $labb->pack;
- # $ok->pack;
-}
-
-sub give_warning_window {
- my ($act, @args) = @_;
- my $sw = $mw->DialogBox(-title => ___"info window", -buttons => [ ___"ok" ]);
- $sw->add("Label", -text => "Executing action $act on @args failed.
-Please consult the log window for details."
- )->pack(-padx => "3m", -pady => "3m");
- $sw->Show;
-}
-
-1;
-
-__END__
-
-
-### Local Variables:
-### perl-indent-level: 2
-### tab-width: 2
-### indent-tabs-mode: nil
-### End:
-# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/tlpsrc/00texlive.core.tlpsrc b/Master/tlpkg/tlpsrc/00texlive.core.tlpsrc
index 3f6d2bd090f..b263a4047c4 100644
--- a/Master/tlpkg/tlpsrc/00texlive.core.tlpsrc
+++ b/Master/tlpkg/tlpsrc/00texlive.core.tlpsrc
@@ -16,9 +16,9 @@ runpattern f texmf/README
runpattern f texmf/doc/man/Makefile
runpattern f texmf/doc/man/man1/Makefile
runpattern f texmf/doc/man/man5/Makefile
-runpattern f texmf/scripts/texlive/tlmgr2.pl
-runpattern f texmf/scripts/texlive/tlmgrgui/gui-arch2.pl
-runpattern f texmf/scripts/texlive/tlmgrgui/gui-config2.pl
-runpattern f texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
-runpattern f bin/win32/tlmgr2.bat
+runpattern f texmf/scripts/texlive/tlmgr1.pl
+runpattern f texmf/scripts/texlive/tlmgrgui/gui-arch1.pl
+runpattern f texmf/scripts/texlive/tlmgrgui/gui-config1.pl
+runpattern f texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl
+runpattern f bin/win32/tlmgr1.bat
runpattern f tl-portable*
diff --git a/Master/tlpkg/tlpsrc/bin-texlive.tlpsrc b/Master/tlpkg/tlpsrc/bin-texlive.tlpsrc
index c3a76214311..64911324467 100644
--- a/Master/tlpkg/tlpsrc/bin-texlive.tlpsrc
+++ b/Master/tlpkg/tlpsrc/bin-texlive.tlpsrc
@@ -8,14 +8,14 @@ depend texlive.infra
runpattern f texmf/fmtutil/fmtutil-hdr.cnf
runpattern d texmf/scripts/texlive/lua
runpattern d texmf/scripts/texlive/tlmgrgui
-runpattern !f texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
-runpattern !f texmf/scripts/texlive/tlmgrgui/gui-config2.pl
-runpattern !f texmf/scripts/texlive/tlmgrgui/gui-arch2.pl
+runpattern !f texmf/scripts/texlive/tlmgrgui/tlmgrgui1.pl
+runpattern !f texmf/scripts/texlive/tlmgrgui/gui-config1.pl
+runpattern !f texmf/scripts/texlive/tlmgrgui/gui-arch1.pl
runpattern f texmf/scripts/texlive/rungs.tlu
runpattern f texmf/scripts/texlive/test-tlpdb.tlu
runpattern f texmf/scripts/texlive/texconf.tlu
runpattern f texmf/scripts/texlive/tlmgr.pl
-runpattern !f texmf/scripts/texlive/tlmgr2.pl
+runpattern !f texmf/scripts/texlive/tlmgr1.pl
runpattern f texmf/scripts/texlive/uninstall-win32.pl
runpattern f texmf/web2c/updmap-hdr.cfg
docpattern f texmf/doc/man/man1/tlmgr.*
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 06:18:06 +0000