summaryrefslogtreecommitdiff
path: root/Master/tlpkg/archive
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2011-05-09 22:56:11 +0000
committerNorbert Preining <preining@logic.at>2011-05-09 22:56:11 +0000
commit18af170a779e1ab19ed1ee433007cebb22ef6349 (patch)
tree475efa993981459a7d016e8615f6a15454c814f6 /Master/tlpkg/archive
parent6e1df2e361a83766f6360f4dfd8325ce3efa6426 (diff)
move some things to archive from dev
git-svn-id: svn://tug.org/texlive/trunk@22393 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/archive')
-rw-r--r--Master/tlpkg/archive/tlmgr1.pl-with-recreate-tlpdb3038
-rw-r--r--Master/tlpkg/archive/tlmgrgui2-withtabs.pl1532
2 files changed, 4570 insertions, 0 deletions
diff --git a/Master/tlpkg/archive/tlmgr1.pl-with-recreate-tlpdb b/Master/tlpkg/archive/tlmgr1.pl-with-recreate-tlpdb
new file mode 100644
index 00000000000..261de5a4e71
--- /dev/null
+++ b/Master/tlpkg/archive/tlmgr1.pl-with-recreate-tlpdb
@@ -0,0 +1,3038 @@
+#!/usr/bin/env perl
+# $Id: tlmgr.pl 11715 2008-12-25 09:27:37Z preining $
+#
+# Copyright 2008 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+
+my $svnrev = '$Revision: 11715 $';
+my $datrev = '$Date: 2008-12-25 10:27:37 +0100 (Thu, 25 Dec 2008) $';
+my $tlmgrrevision;
+if ($svnrev =~ m/: ([0-9]+) /) {
+ $tlmgrrevision = $1;
+} else {
+ $tlmgrrevision = "unknown";
+}
+$datrev =~ s/^.*Date: //;
+$datrev =~ s/ \(.*$//;
+$tlmgrrevision .= " ($datrev)";
+
+
+my $Master;
+
+BEGIN {
+ $^W = 1;
+ $Master = `kpsewhich -var-value=SELFAUTOPARENT`;
+ chomp($Master);
+ unshift (@INC, "$Master/tlpkg");
+}
+
+use TeXLive::TLPOBJ;
+use TeXLive::TLPDB;
+use TeXLive::TLConfig;
+use TeXLive::TLMedia;
+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;
+
+# 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
+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;
+
+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) && $opt_gui) {
+ $action = "gui";
+}
+
+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)) {
+ $opt_help = 1;
+}
+
+if (!defined($action) && !$opt_help) {
+ die "$0: missing action; try --help if you need it.\n";
+}
+
+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.
+ my @noperldoc = ();
+ if (win32() || ! TeXLive::TLUtils::which("perldoc")) {
+ @noperldoc = ("-noperldoc", "1");
+ }
+ pod2usage("-exitstatus" => 0, "-verbose" => 2, @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";
+#
+# Try to open the packagelog file, but do NOT die when that does not work
+if (!open(PACKAGELOG, ">>$packagelogfile")) {
+ debug("Cannot open package log file $packagelogfile for appending\n");
+ debug("Will not log package installation/removal/update for that run\n");
+ $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);
+ } else {
+ # must be "doc"
+ $mothertlp->docfiles($tlpobj->docfiles);
+ $mothertlp->docsize($tlpobj->docsize);
+ }
+ # that make sure that the original entry is overwritten
+ $localtlpdb->add_tlpobj($mothertlp);
+ }
+ } else {
+ # completely normal package, just add it
+ $localtlpdb->add_tlpobj($tlpobj);
+ }
+ $localtlpdb->save;
+ }
+ 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);
+} elsif ($action =~ m/^recreate-tlpdb$/i) {
+ merge_into(\%ret, action_recreate_tlpdb());
+ finish(0);
+} else {
+ die "$0: unknown action: $action\n";
+}
+
+# main action is done, now clean up.
+
+# 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);
+
+# 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
+{
+ my (%ret) = @_;
+ my $errors = 0;
+
+ if (defined($ret{'mktexlsr'})) {
+ print "running mktexlsr\n";
+ $errors += system("mktexlsr");
+ }
+
+ if (defined($ret{'map'})) {
+ foreach my $m (@{$ret{'map'}}) {
+ print "$m\n";
+ $errors += system("updmap-sys --nomkmap --nohash --$m");
+ }
+ $errors += system("mktexlsr");
+ $errors += system("updmap-sys");
+ }
+
+ chomp (my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`);
+ chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
+
+ if (defined($ret{'format'})) {
+ print "regenerating fmtutil.cnf\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";
+ $errors += system("fmtutil-sys", "--missing");
+ }
+ }
+
+ if (defined($ret{'language'})) {
+ for my $ext ("dat", "def") {
+ my $lang = "language.$ext";
+ print "regenerating $lang\n";
+
+ my $arg1 = "$TEXMFSYSVAR/tex/generic/config/language.$ext";
+ my $arg2 = "$TEXMFLOCAL/tex/generic/config/language-local.dat";
+ if ($ext eq "dat") {
+ TeXLive::TLUtils::create_language_dat($localtlpdb, $arg1, $arg2);
+ } else {
+ TeXLive::TLUtils::create_language_def($localtlpdb, $arg1, $arg2);
+ }
+
+ if (! TeXLive::TLUtils::win32()) {
+ # 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";
+ $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.
+#
+sub remove_package {
+ my ($pkg, $localtlpdb) = @_;
+ my $tlp = $localtlpdb->get_package($pkg);
+ my %ret;
+ if (!defined($tlp)) {
+ tlwarn ("$pkg: package not present, cannot remove\n");
+ } else {
+ if ($pkg =~ m/^texlive\.infra/) {
+ log ("Not removing $pkg, it is essential!\n");
+ return;
+ }
+ # we have to chdir to $localtlpdb->root
+ my $Master = $localtlpdb->root;
+ chdir ($Master) || die "chdir($Master) failed: $!";
+ my @files = $tlp->all_files;
+ # also remove the .tlpobj file
+ push @files, "tlpkg/tlpobj/$pkg.tlpobj";
+ # and the ones from src/doc splitting
+ if (-r "tlpkg/tlpobj/$pkg.src.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.src.tlpobj";
+ }
+ if (-r "tlpkg/tlpobj/$pkg.doc.tlpobj") {
+ push @files, "tlpkg/tlpobj/$pkg.doc.tlpobj";
+ }
+ #
+ # we want to check that a file is only listed in one package, so
+ # in case that a file to be removed is listed in another package
+ # we will warn and *not* remove it
+ my %allfiles;
+ for my $p ($localtlpdb->list_packages) {
+ next if ($p eq $pkg); # we have to skip the to be removed package
+ for my $f ($localtlpdb->get_package($p)->all_files) {
+ $allfiles{$f} = $p;
+ }
+ }
+ my @goodfiles = ();
+ my @badfiles = ();
+ for my $f (@files) {
+ if (defined($allfiles{$f})) {
+ # this file should be removed but is mentioned somewhere, too
+ push @badfiles, $f;
+ } else {
+ push @goodfiles, $f;
+ }
+ }
+ if ($#badfiles >= 0) {
+ # warn the user
+ tlwarn("The following files should be removed due to the removal of $pkg,\n");
+ tlwarn("but are part of another package, too.\n");
+ for my $f (@badfiles) {
+ tlwarn(" $f - $allfiles{$f}\n");
+ }
+ }
+ my @removals = &removed_dirs (@goodfiles);
+ foreach my $entry (@goodfiles) {
+ unlink $entry;
+ }
+ foreach my $entry (@removals) {
+ rmdir $entry;
+ }
+ $localtlpdb->remove_package($pkg);
+ merge_into(\%ret, $tlp->make_return_hash_from_executes("disable"));
+ $ret{'mktexlsr'} = 1;
+ # should we save at each removal???
+ # advantage: the tlpdb actually reflects what is installed
+ # disadvantage: removing a collection calls the save routine several times
+ # still I consider it better that the tlpdb is in a consistent state
+ $localtlpdb->save;
+ # do the post removal actions
+ if (defined($PostRemove{$pkg})) {
+ info("running post remove action for $pkg\n");
+ &{$PostRemove{$pkg}}($localtlpdb->root);
+ }
+ }
+ return \%ret;
+}
+
+# REMOVE
+#
+# tlmgr remove foo bar baz
+# will remove the packages foo bar baz itself
+# and will remove all .ARCH dependencies, too
+# and if some of them are collections it will also remove the
+# depending packages which are NOT Collections|Schemes.
+# if some of them are referenced somewhere they will not be removed
+# unless --force given
+#
+# tlmgr remove --no-depends foo bar baz
+# will remove the packages foo bar baz itself without any dependencies
+# but it will still remove all .ARCH dependency
+# if some of them are referenced somewhere they will not be removed
+# unless --force given
+#
+# tlmgr remove --no-depends-at-all foo bar baz
+# willabsolutely only install foo bar baz not even taking .ARCH into
+# account
+#
+sub action_remove {
+ if ($opt_gui) {
+ action_gui("remove");
+ }
+ # we do the following:
+ # - (not implemented) order collections such that those depending on
+ # other collections are first removed, and then those which only
+ # depend on packages. Otherwise
+ # remove collection-latex collection-latexrecommended
+ # will not succeed
+ # - first loop over all cmd line args and consider only the collections
+ # - for each to be removed collection:
+ # . check that no other collections/scheme asks for that collection
+ # . remove the collection
+ # . remove all dependencies
+ # - for each normal package not already removed (via the above)
+ # . check that no collection/scheme still depends on this package
+ # . 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;
+ my %already_removed;
+ my @more_removal;
+ init_local_db();
+ 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
+ # as follows:
+ # - let A be the set of all packages to be removed from the cmd line
+ # - let A* be the set of A with all dependencies expanded
+ # - let B be the set of all packages
+ # - let C = B \ A*, ie the set of all packages without those packages
+ # in the set of A*
+ # - let C* be the set of C with all dependencies expanded
+ # - let D = A* \ C*, ie the set of all packages to be removed (A*)
+ # without all the package that are still needed (C*)
+ # - remove all package in D
+ # - for any package in A (not in A*, in A, ie on the cmd line) that is
+ # also in C* (so a package that was asked for to be removed on the
+ # 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;
+ 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;
+ 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) {
+ info("tlmgr: $p is needed by " . join(" ", @needed) . "\n");
+ info("tlmgr: still removing it due to --force\n");
+ } else {
+ delete($packs{$p});
+ tlwarn("tlmgr: not removing $p, needed by " .
+ join(" ", @needed) . "\n");
+ }
+ } else {
+ delete($packs{$p});
+ }
+ }
+ @packs = keys %packs;
+ foreach my $pkg (sort @packs) {
+ my $tlp = $localtlpdb->get_package($pkg);
+ next if defined($already_removed{$pkg});
+ if (!defined($tlp)) {
+ 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
+ # save the information of which packages have already been removed
+ # into %already_removed.
+ if ($tlp->category eq "Collection") {
+ my %foo;
+ info ("remove $pkg\n");
+ 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;
+ } else {
+ merge_into(\%foo, &remove_package($pkg, $localtlpdb));
+ logpackage("remove: $pkg");
+ }
+ if (keys %foo) {
+ # removal was successful, so the return is at least 0x0001 mktexlsr
+ # remove dependencies, too
+ merge_into(\%ret, \%foo);
+ $already_removed{$pkg} = 1;
+ }
+ } else {
+ # save all the other packages into the @more_removal list to
+ # be removed at the second state. Note that if a package has
+ # already been removed due to a removal of a collection
+ # it will be marked as such in %already_removed and not tried again
+ push @more_removal, $pkg;
+ }
+ }
+ }
+ foreach my $pkg (sort @more_removal) {
+ if (!defined($already_removed{$pkg})) {
+ info ("remove $pkg\n");
+ if (!$opt_dry) {
+ my %foo;
+ merge_into(\%foo, &remove_package($pkg, $localtlpdb));
+ if (keys %foo) {
+ # removal was successful
+ logpackage("remove: $pkg");
+ merge_into(\%ret, \%foo);
+ $already_removed{$pkg} = 1;
+ }
+ }
+ }
+ }
+ if ($opt_dry) {
+ # 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";
+ } else {
+ print "tlmgr: no packages removed.\n";
+ }
+ return(\%ret);
+ }
+}
+
+sub action_show {
+ 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) {
+ my $tlpdb = $localtlpdb;
+ my $tlp = $localtlpdb->get_package($pkg);
+ my $installed = 0;
+ if (!$tlp) {
+ if (!$tlmediatlpdb) {
+ init_tlmedia();
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ }
+ $tlp = $tlmediatlpdb->get_package($pkg);
+ $tlpdb = $tlmediatlpdb;
+ } else {
+ $installed = 1;
+ }
+ if ($tlp) {
+ my @colls;
+ if ($tlp->category ne "Collection" && $tlp->category ne "Scheme") {
+ @colls = $localtlpdb->needed_by($pkg);
+ if (!@colls) {
+ # not referenced in the local tlpdb, so try the remote here, too
+ if (!$tlmediatlpdb) {
+ init_tlmedia();
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ }
+ @colls = $tlmediatlpdb->needed_by($pkg);
+ }
+ }
+ print "Package: ", $tlp->name, "\n";
+ print "Category: ", $tlp->category, "\n";
+ print "ShortDesc: ", $tlp->shortdesc, "\n" if ($tlp->shortdesc);
+ print "LongDesc: ", $tlp->longdesc, "\n" if ($tlp->longdesc);
+ print "Installed: ", ($installed ? "Yes" : "No"), "\n";
+ print "Revision: ", $tlp->revision, "\n" if ($installed);
+ print "Collection: ", @colls, "\n" if (@colls);
+ if ($opt_list) {
+ print "Included files, by type:\n";
+ # if the package has a .ARCH dependency we also list the files for
+ # those packages
+ my @todo = $tlpdb->expand_dependencies("-only-arch", $tlpdb, ($pkg));
+ for my $d (sort @todo) {
+ my $foo = $tlpdb->get_package($d);
+ if (!$foo) {
+ warn "That should not happen, no such package here!";
+ next;
+ }
+ if ($d ne $pkg) {
+ print "depending package $d:\n";
+ }
+ if ($foo->runfiles) {
+ print "run files:\n";
+ for my $f (sort $foo->runfiles) { print " $f\n"; }
+ }
+ if ($foo->srcfiles) {
+ print "source files:\n";
+ for my $f (sort $foo->srcfiles) { print " $f\n"; }
+ }
+ if ($foo->docfiles) {
+ print "doc files:\n";
+ for my $f (sort $foo->docfiles) { print " $f\n"; }
+ }
+ # in case we have them
+ if ($foo->allbinfiles) {
+ print "bin files (all architectures):\n";
+ for my $f (sort $foo->allbinfiles) { print " $f\n"; }
+ }
+ }
+ }
+ print "\n";
+ } else {
+ printf STDERR "tlmgr: cannot find $pkg\n";
+ }
+ }
+ return;
+}
+
+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 $r = shift @ARGV;
+ my $ret = "";
+ my $tlpdb;
+ init_local_db();
+ if ($opt_global) {
+ init_tlmedia();
+ $tlpdb = $tlmediasrc->tlpdb;
+ } else {
+ $tlpdb = $localtlpdb;
+ }
+ foreach my $pkg ($tlpdb->list_packages) {
+ if ($opt_file) {
+ my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files);
+ if (@ret) {
+ print "$pkg:\n";
+ foreach (@ret) {
+ print "\t$_\n";
+ }
+ }
+ } else {
+ next if ($pkg =~ m/\./);
+ my $t = $tlpdb->get_package($pkg)->shortdesc;
+ $t |= "";
+ my $lt = $tlpdb->get_package($pkg)->longdesc;
+ $lt |= "";
+ if (($pkg =~ m/$r/) || ($t =~ m/$r/) || ($lt =~ m/$r/)) {
+ $ret .= " $pkg - $t\n";
+ }
+ }
+ }
+ print "$ret";
+ return;
+}
+
+# RESTORE
+#
+sub action_restore {
+ # tlmgr restore --backupdir dir
+ # lists all packages with all revisions
+ # tlmgr restore --backupdir dir pkg
+ # 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);
+ # 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");
+ 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) {
+ 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");
+ 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;
+
+ # initialize the hash(packages) of hash(revisions)
+ my %backups;
+ opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!";
+ my @dirents = readdir (DIR);
+ 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) {
+ print "Available backups:\n";
+ foreach my $p (sort keys %backups) {
+ print "$p: ";
+ my @rs = sort (keys %{$backups{$p}});
+ print "@rs\n";
+ }
+ } else {
+ print "No backups available in $opt_backupdir\n";
+ }
+ finish(0);
+ }
+ if (!defined($rev)) {
+ print "Available backups for $pkg: ";
+ my @rs = sort (keys %{$backups{$pkg}});
+ print "@rs\n";
+ finish(0);
+ }
+ # we did arrive here, so we try to restore ...
+ if (defined($backups{$pkg}->{$rev})) {
+ 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) {
+ print "Ok, cancelling the restore!\n";
+ finish(0);
+ }
+ }
+ 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
+ $opt_backupdir = abs_path($opt_backupdir);
+ merge_into(\%ret, &remove_package($pkg, $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);
+ $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";
+ }
+ 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
+ # N ... keep only N backups
+ # 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
+ #
+ 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);
+ if ($clean_mode) {
+ if ($opt_clean eq "") {
+ # we need to check the tlpdb
+ $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 $opt_clean is something, but maybe not a number, check for
+ # validity
+ if ($opt_clean =~ m/^(-1|[0-9]+)$/) {
+ # get rid of leading zeros etc etc
+ $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");
+ exit 1;
+ }
+ }
+ # 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 ($clean_mode) {
+ tlwarn ("Cannot clean a non existing directory, terminating.\n");
+ } else {
+ tlwarn ("Don't know where to save backups, terminating.\n");
+ }
+ exit 1;
+ }
+ } else {
+ # no argument, check for presence in TLPDB
+ $opt_backupdir = $localtlpdb->option("backupdir");
+ if (!$opt_backupdir) {
+ if ($clean_mode) {
+ tlwarn ("Cannot clean an unknown directory, terminating.\n");
+ } else {
+ tlwarn ("Don't know where to save 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");
+ if ($clean_mode) {
+ tlwarn ("Cannot clean a non existing directory, terminating.\n");
+ } else {
+ tlwarn ("Don't know where to save backups, terminating.\n");
+ }
+ exit 1;
+ }
+ }
+
+ my %ret;
+ my @todo;
+ if ($opt_all) {
+ @todo = $localtlpdb->list_packages;
+ } else {
+ @todo = @ARGV;
+ @todo = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo);
+ }
+ if (!@todo) {
+ printf "tlmgr backup takes either a list of packages or --all\n";
+ }
+ foreach my $pkg (@todo) {
+ if ($clean_mode) {
+ clear_old_backups ($pkg, $opt_backupdir, $opt_clean, $opt_dry);
+ } else {
+ my $tlp = $localtlpdb->get_package($pkg);
+ info("saving current status of $pkg to $opt_backupdir${pkg}.r" .
+ $tlp->revision . ".\n");
+ if (!$opt_dry) {
+ $tlp->make_container("lzma", $localtlpdb->root,
+ $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 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 $opt_dry output
+ my $root = $localtlpdb->root;
+ my $temp = "$root/temp";
+ return if $opt_dry;
+ if (!$::updater_started) {
+ open_w32_updater($root);
+ $::updater_started = 1;
+ }
+ # these packages cannot be upgrade on w32
+ # so we have to create a update program
+ my $media = $tlmediasrc->media;
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my $remoteroot = $mediatlpdb->root;
+ #
+ # we have to download/copy also the src/doc files if necessary!
+ my $container_src_split = $mediatlpdb->config_src_container;
+ my $container_doc_split = $mediatlpdb->config_doc_container;
+ # get options about src/doc splitting from $totlpdb
+ my $opt_src = $localtlpdb->option_install_srcfiles;
+ my $opt_doc = $localtlpdb->option_install_docfiles;
+ my $real_opt_doc = $opt_doc;
+ if ($tlp->category =~ m/documentation/i) {
+ # we do install documenation files for category Documentation
+ # even if opt_doc is false
+ $real_opt_doc = 1;
+ }
+ my $do_src = 0;
+ my $do_doc = 0;
+ $do_src = 1 if ($container_src_split && $opt_src && $tlp->srcfiles);
+ $do_doc = 1 if ($container_doc_split && $real_opt_doc && $tlp->docfiles);
+ TeXLive::TLUtils::mkdirhier($temp);
+ if ($media eq 'DVD') {
+ tlwarn ("Creating updater from DVD currently not implemented!\n");
+ tlwarn ("But it should not be necessary!\n");
+ } else {
+ if ($media eq 'CD') {
+ copy("$remoteroot/$Archive/$pkg.tar.lzma", "$temp");
+ copy("$remoteroot/$Archive/$pkg.doc.tar.lzma", "$temp") if $do_doc;
+ copy("$remoteroot/$Archive/$pkg.src.tar.lzma", "$temp") if $do_src;
+ } else { # net
+ TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.tar.lzma", "$temp/$pkg.tar.lzma");
+ TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.doc.tar.lzma", "$temp/$pkg.doc.tar.lzma") if $do_doc;
+ TeXLive::TLUtils::download_file("$remoteroot/$Archive/$pkg.src.tar.lzma", "$temp/$pkg.src.tar.lzma") if $do_src;
+ }
+ # now we should have the file present
+ if (! -r "$temp/$pkg.tar.lzma") {
+ tlwarn ("Couldn't get $pkg.tar.lzma, that is bad\n");
+ } else {
+ # add lines to the un-archiver
+ 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");
+ }
+ }
+ if ($do_doc) {
+ if (! -r "$temp/$pkg.doc.tar.lzma") {
+ tlwarn ("Couldn't get $pkg.doc.tar.lzma, that is bad\n");
+ } else {
+ # add lines to the un-archiver
+ do_one ("$pkg.doc");
+ }
+ }
+ }
+}
+
+sub close_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");
+ tlwarn(" " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n");
+ }
+}
+
+
+# UPDATE
+#
+# tlmgr update foo
+# if foo is of type Package|Documentation it will update only foo
+# and the respective .ARCH dependencies
+# if foo is of type Collection|Scheme it will update itself AND
+# will check all depending packs of type NOT(COllection|Scheme)
+# for necessary updates
+#
+# tlmgr update --no-depends foo
+# as above, but will not check for depends of Collections/Schemes
+# but it will still update .ARCH deps
+#
+# 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
+# anymore. That has all to be done by hand.
+#
+sub action_update {
+ if ($opt_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;
+ my %ret;
+
+ init_tlmedia();
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ 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 ($opt_all) {
+ $other_updates_asked_for = 1;
+ } else {
+ for my $p (@ARGV) {
+ my $matched = 0;
+ for my $cp (@CriticalPackagesList) {
+ # we match for initial package name, that shold be fine
+ if ($p =~ m/^$cp/) {
+ $matched = 1;
+ last;
+ }
+ }
+ if (!$matched) {
+ $other_updates_asked_for = 1;
+ last;
+ }
+ }
+ }
+ if ($other_updates_asked_for) {
+ if (check_for_critical_updates($localtlpdb, $mediatlpdb)) {
+ if ($opt_force) {
+ tlwarn("$0: Continuing due to --force.\n");
+ } elsif ($opt_list) {
+ # do not warn here
+ } 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) {
+ tlwarn("Argument for --backupdir must be an existing directory. Terminating.\n");
+ exit 1;
+ }
+ }
+
+ my $autobackup = 0;
+ # check for the tlpdb option autobackup, and if present and true (!= 0)
+ # assume we are doing backups
+ 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");
+ $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");
+ $opt_backup = 1;
+ } else {
+ tlwarn ("Option autobackup can only be an integer >= -1.\n");
+ tlwarn ("Disabling auto backups.\n");
+ $localtlpdb->option("autobackup", 0);
+ $autobackup = 0;
+ }
+ }
+ }
+
+ # 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) {
+ my $diebackupdir = 0;
+ if (!$opt_backupdir) {
+ $opt_backupdir = $localtlpdb->option("backupdir");
+ if ($opt_backupdir) {
+ # check again:
+ $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
+ $diebackupdir = 1;
+ }
+ }
+ # no else branch necessary, we already checked that --backupdir if
+ # given is ok, see above
+ if ($diebackupdir) {
+ tlwarn("You have asked for backups, but the backup directory as specified\n");
+ tlwarn("in the local TLPDB or the cmd line does not exists, exiting.\n");
+ exit 1;
+ }
+ }
+
+ # finally, if we have --backupdir, but no --backup, just enable it
+ $opt_backup = 1 if $opt_backupdir;
+
+ debug("Doing backups to $opt_backupdir\n") if $opt_backup;
+
+ # these two variables are used throughout this function
+ my $root = $localtlpdb->root;
+ my $temp = "$root/temp";
+
+ # 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;
+ }
+
+ my @todo;
+ my %removals;
+ my %forcermpkgs;
+ my %newpkgs;
+ # check for new/removed/forcibly removed packages.
+ # we start from the list of installed collections in the local tlpdb
+ # which are also present in the remote database
+ # and expand this list once with expand_dependencies in the local tlpdb
+ # and once in the tlmedia tlpdb. Then we compare the lists
+ # let A = set of local expansions
+ # B = set of remote expansions
+ # then we should(?) have
+ # B \ A set of new packages
+ # A \ B set of packages removed on the server
+ # A \cup B set of packages which should be checked for forcible removal
+ #
+ my @colls = ();
+ for my $p ($localtlpdb->collections) {
+ push @colls, $p
+ if defined($mediatlpdb->get_package($p));
+ }
+ my @localexpansion =
+ $localtlpdb->expand_dependencies($localtlpdb, @colls);
+ my @remoteexpansion =
+ $mediatlpdb->expand_dependencies($localtlpdb, @colls);
+ for my $p (@remoteexpansion) {
+ $newpkgs{$p} = 1;
+ }
+ for my $p (@localexpansion) {
+ delete($newpkgs{$p});
+ $removals{$p} = 1;
+ }
+ for my $p (@remoteexpansion) {
+ delete($removals{$p});
+ }
+ for my $p (@localexpansion) {
+ # intersection, don't check A\B and B\A
+ next if $newpkgs{$p};
+ next if $removals{$p};
+ my $tlp = $localtlpdb->get_package($p);
+ if (!defined($tlp)) {
+ $forcermpkgs{$p} = 1;
+ }
+ }
+ debug ("tlmgr: new pkgs: " . join("\n\t",keys %newpkgs) . "\n");
+ debug ("tlmgr: deleted : " . join("\n\t",keys %removals) . "\n");
+ debug ("tlmgr: forced : " . join("\n\t",keys %forcermpkgs) . "\n");
+
+ if ($opt_all || $opt_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");
+ }
+ }
+
+ if (!@todo) {
+ tlwarn("tlmgr update: please specify a list of packages or --all.\n");
+ }
+
+ # update all .ARCH dependencies, too, unless $opt_reallynodepends:
+ @todo = $mediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo)
+ unless $opt_reallynodepends;
+ #
+ # update general deps unless $opt_nodepends:
+ @todo = $mediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo)
+ unless $opt_nodepends;
+
+ foreach my $pkg (sort @todo) {
+ next if ($pkg =~ m/^00texlive/);
+ my $tlp = $localtlpdb->get_package($pkg);
+ if (!defined($tlp)) {
+ # if the user has forcibly removed (say) bin-makeindex, then the
+ # loop above has no way to add bin-makeindex.ARCH into the
+ # %forcermpkgs hash, but the .ARCH will still be in the dependency
+ # expansion. So try both with and without the .ARCH extension.
+ (my $pkg_noarch = $pkg) =~ s/\.[^.]*$//;
+ my $forcerm_coll = $forcermpkgs{$pkg} || $forcermpkgs{$pkg_noarch};
+
+ # similarly for new packages. If latexmk is new, latexmk.ARCH
+ # 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");
+ 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
+ next;
+ } else {
+ tlwarn("\ntlmgr: $pkg mentioned, neither new nor forcibly removed\n");
+ next;
+ }
+ # 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;
+ 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 {
+ tlwarn("$0: couldn't install new package $pkg\n");
+ }
+ next;
+ }
+
+ my $unwind_package;
+ my $remove_unwind_container = 0;
+ 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) {
+ $nrupdated++;
+ if ($opt_list) {
+ info("$pkg: local: $rev, source: $mediarev\n");
+ } 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);
+ }
+ }
+
+ 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
+ }
+
+ 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 = $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;
+ }
+ info("done\n");
+ }
+ }
+ } 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) {
+ # 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");
+ tlwarn("To install from the Internet for this one time only, run\n");
+ tlwarn(" tlmgr -location $TeXLiveURL\n");
+ tlwarn("\nTo change the default for all future updates, run\n");
+ tlwarn(" tlmgr option location $TeXLiveURL\n\n");
+ }
+ return(\%ret);
+}
+
+# INSTALL
+#
+# tlmgr install foo bar baz
+# will create the closure under dependencies of {foo,bar,baz}, i.e. all
+# dependencies recursively down to the last package, and install all
+# the packages that are necessary
+#
+# tlmgr install --no-depends foo bar baz
+# will *only* install these three packages (if they are not already installed
+# but it will STILL INSTALL foo.ARCH if they are necessary.
+#
+# tlmgr install --no-depends-at-all foo bar baz
+# will absolutely only install these three packages, and will not even
+# take .ARCH deps into account
+#
+# tlmgr install --reinstall ...
+# behaves exactely like without --reinstall BUT the following two
+# differences:
+# . dependencies are not expanded from collection to collection, so
+# if you reinstall a collection then all its dependencies of type
+# Package will be reinstalled, too, but not the dependencies on
+# other collection, because that would force the full reinstallation
+# of the whole installation
+# . it does not care for whether a package seems to be installed or
+# not (that is the --reinstall)
+#
+# TLMedia->install_package does ONLY INSTALL ONE PACKAGE, no deps whatsoever
+# anymore! That has all to be done by hand.
+#
+sub action_install {
+ if ($opt_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);
+ 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!";
+ }
+
+ $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 $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 $opt_nodepends;
+ }
+ foreach my $pkg (sort @packs) {
+ my $re = "";
+ if (defined($localtlpdb->get_package($pkg))) {
+ if ($opt_reinstall) {
+ $re = "re";
+ } else {
+ debug("already installed: $pkg\n");
+ next;
+ }
+ }
+ info("${re}install: $pkg\n");
+ if (!$opt_dry) {
+ merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb));
+ logpackage("${re}install: $pkg");
+ }
+ }
+ if ($opt_dry) {
+ # stop here, don't do any postinstall actions
+ return(0);
+ }
+ return(\%ret);
+}
+
+sub action_list {
+ init_local_db();
+ # make sure that the @ARGV hash is not changed in case we switch to
+ # show mode
+ my ($what) = @ARGV;
+ if ($what) {
+ # if the argument to list is either 'collection' or 'scheme'
+ # we list them, otherwise we go direct into tlmgr show $pkg mode
+ if ($what !~ m/^(collection|scheme)/i) {
+ tlwarn("(switching to show mode)\n");
+ action_show();
+ return;
+ }
+ } else {
+ $what = "";
+ }
+ init_tlmedia();
+ my @whattolist;
+ if ($what =~ m/^collection/i) {
+ @whattolist = $tlmediasrc->tlpdb->collections;
+ } elsif ($what =~ m/^scheme/i) {
+ @whattolist = $tlmediasrc->tlpdb->schemes;
+ } else {
+ @whattolist = $tlmediasrc->tlpdb->list_packages;
+ }
+ foreach (@whattolist) {
+ if (defined($localtlpdb->get_package($_))) {
+ print "i ";
+ } else {
+ print " ";
+ }
+ my $foo = $tlmediasrc->tlpdb->get_package($_)->shortdesc;
+ print "$_: ", defined($foo) ? $foo : "(shortdesc missing)" , "\n";
+ }
+ return;
+}
+
+
+sub action_option {
+ if ($opt_gui) {
+ action_gui("config");
+ }
+ my $what = shift @ARGV;
+ $what = "show" unless defined($what);
+ init_local_db();
+ if ($what =~ m/^location$/i) {
+ # changes the default location
+ my $loc = shift @ARGV;
+ if ($loc) {
+ # support "ctan" on the cmd line, and don't abs_path it!
+ if ($loc =~ m/^ctan$/i) {
+ $loc = "$TeXLive::TLConfig::TeXLiveURL";
+ }
+ if ($loc !~ m!^(http|ftp)://!i) {
+ # seems to be a local path, try to normalize it
+ my $testloc = abs_path($loc);
+ # 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.
+ $loc = $testloc if $testloc;
+ }
+ info("tlmgr: setting default installation location to $loc\n");
+ $localtlpdb->option_location($loc);
+ $localtlpdb->save;
+ } else {
+ 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";
+ $localtlpdb->option_install_docfiles($loc);
+ $localtlpdb->save;
+ } else {
+ 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)) {
+ print "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";
+ }
+ } 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";
+ $localtlpdb->option_create_formats($loc);
+ $localtlpdb->save;
+ } else {
+ print "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 {
+ my $val = shift @ARGV;
+ if (defined($val)) {
+ print "Setting option $what to $val.\n";
+ $localtlpdb->option($what,$val);
+ $localtlpdb->save;
+ } else {
+ print "Option $what = ", $localtlpdb->option($what), "\n";;
+ }
+ #warn "Setting other options currently not supported, please edit texlive.tlpdb!";
+ }
+ return;
+}
+
+
+# ARCH
+#
+sub action_arch {
+ if ($^O=~/^MSWin(32|64)$/i) {
+ printf STDERR "action `arch' not supported on Windows\n";
+ }
+ 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 $opt_dry;
+ $what || ($what = "list");
+ if ($what =~ m/^list$/i) {
+ # list the available architectures
+ # initialize the TLMedia from $location
+ init_tlmedia();
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my @already_installed_arch = $localtlpdb->available_architectures;
+ print "Available architectures:\n";
+ foreach my $a ($mediatlpdb->available_architectures) {
+ if (member($a,@already_installed_arch)) {
+ print "(i) $a\n";
+ } else {
+ print " $a\n";
+ }
+ }
+ print "Already installed architectures are marked with (i)\n";
+ print "You can add new architectures with tlmgr arch add arch1 arch2\n";
+ finish(0);
+ } elsif ($what =~ m/^add$/i) {
+ init_tlmedia();
+ my $mediatlpdb = $tlmediasrc->tlpdb;
+ my @already_installed_arch = $localtlpdb->available_architectures;
+ my @available_arch = $mediatlpdb->available_architectures;
+ my @todoarchs;
+ foreach my $a (@ARGV) {
+ if (TeXLive::TLUtils::member($a, @already_installed_arch)) {
+ print "Arch $a is already installed\n";
+ next;
+ }
+ if (!TeXLive::TLUtils::member($a, @available_arch)) {
+ print "Arch $a not available, use 'tlmgr available_archs'!\n";
+ next;
+ }
+ push @todoarchs, $a;
+ }
+ foreach my $pkg ($localtlpdb->list_packages) {
+ next if ($pkg =~ m/^00texlive/);
+ my $tlp = $localtlpdb->get_package($pkg);
+ foreach my $dep ($tlp->depends) {
+ if ($dep =~ m/^(.*)\.ARCH$/) {
+ # we have to install something
+ foreach my $a (@todoarchs) {
+ if ($opt_dry) {
+ print "Installing $pkg.$a\n";
+ } else {
+ info("install: $pkg.$a\n");
+ merge_into(\%ret, $tlmediasrc->install_package("$pkg.$a", $localtlpdb));
+ }
+ }
+ }
+ }
+ }
+ if (TeXLive::TLUtils::member('win32', @todoarchs)) {
+ # install the necessary w32 stuff
+ info("install: bin-tlperl.win32\n");
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlperl.win32", $localtlpdb));
+ info("install: bin-tlgs.win32\n");
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlgs.win32", $localtlpdb));
+ info("install: bin-tlpsv.win32\n");
+ merge_into (\%ret, $tlmediasrc->install_package("bin-tlpsv.win32", $localtlpdb));
+ }
+ # update the option_archs list of installed archs
+ my @larchs = $localtlpdb->option_available_architectures;
+ push @larchs, @todoarchs;
+ $localtlpdb->option_available_architectures(@larchs);
+ $localtlpdb->save;
+ } else {
+ die "Unknown option for arch: $what";
+ }
+ return(\%ret);
+}
+
+sub action_generate {
+ 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();
+
+ chomp (my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`);
+ chomp (my $TEXMFLOCAL = `kpsewhich -var-value=TEXMFLOCAL`);
+
+ if ($what =~ m/^language(\.dat|\.def)?$/i) {
+ if ($what =~ m/^language(\.dat)?$/i) {
+ $dest ||= "$TEXMFSYSVAR/tex/generic/config/language.dat";
+ $localconf ||= "$TEXMFLOCAL/tex/generic/config/language-local.dat";
+ debug ("$0: writing language.dat data to $dest\n");
+ TeXLive::TLUtils::create_language_dat($localtlpdb, $dest, $localconf);
+ $dest .= ".def";
+ }
+ if ($what =~ m/^language(\.def)?$/i) {
+ $dest ||= "$TEXMFSYSVAR/tex/generic/config/language.def";
+ $localconf ||= "$TEXMFLOCAL/tex/generic/config/language-local.def";
+ debug("$0: writing language.def data to $dest\n");
+ TeXLive::TLUtils::create_language_def($localtlpdb, $dest, $localconf);
+ }
+
+ } elsif ($what =~ m/^fmtutil$/i) {
+ $dest ||= "$TEXMFSYSVAR/web2c/fmtutil.cnf";
+ $localconf ||= "$TEXMFLOCAL/web2c/fmtutil-local.cnf";
+ debug("$0: writing new fmtutil.cnf to $dest\n");
+ TeXLive::TLUtils::create_fmtutil($localtlpdb, $dest, $localconf);
+
+ } elsif ($what =~ m/^updmap$/i) {
+ $dest ||= "$TEXMFSYSVAR/web2c/updmap.cfg";
+ $localconf ||= "$TEXMFLOCAL/web2c/updmap-local.cfg";
+ debug("$0: writing new updmap.cfg to $dest\n");
+ TeXLive::TLUtils::create_updmap($localtlpdb, $dest, $localconf);
+
+ } else {
+ die "$0: Unknown option for generate: $what; try --help if you need it.\n";
+ }
+
+ return;
+}
+
+# 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($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;
+ }
+}
+
+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");
+}
+
+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) {
+ action_gui("uninstall");
+ }
+ 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): ";
+ my $yesno = <STDIN>;
+ if ($yesno !~ m/^y(es)?$/i) {
+ print "Ok, cancelling the removal!\n";
+ finish(0);
+ }
+ }
+ 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";
+ }
+ }
+ #
+ # 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");
+ # should we do that????
+ system("rm", "-rf", "$texdir/texmf-config");
+ system("rmdir", "--ignore-fail-on-non-empty", "$texdir");
+}
+
+
+sub action_check {
+ 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();
+ my $ret = 0;
+ if ($what =~ m/^all/i) {
+ $ret ||= check_files($svn);
+ $ret ||= check_collections($svn);
+ } elsif ($what =~ m/^files/i) {
+ $ret ||= check_files($svn);
+ } elsif ($what =~ m/^collections/i) {
+ $ret ||= check_collections($svn);
+ } else {
+ print "No idea how to check that: $what\n";
+ }
+ finish($ret);
+}
+
+#
+# check file coverage, roughly equivalent to tlpkg/bin/check-file-coverage
+#
+sub check_files {
+ my $svn = shift;
+ my $ret = 0;
+ my %filetopacks;
+ my $Master = $localtlpdb->root;
+ debug("Collecting all files of all packages\n");
+ for my $p ($localtlpdb->list_packages()) {
+ # ignore files in the installer
+ next if ($p eq "00texlive.installer");
+ my $tlp = $localtlpdb->get_package($p);
+ for my $f ($tlp->all_files) {
+ push @{$filetopacks{$f}}, $p;
+ }
+ }
+ my @multiple = ();
+ my @missing = ();
+ debug("Checking for occurrences and existence of all files\n");
+ for (keys %filetopacks) {
+ push @missing, $_ if (! -r "$Master/$_");
+ my @foo = @{$filetopacks{$_}};
+ if ($#foo < 0) {
+ warn "that shouldn't happen: $_\n";
+ } elsif ($#foo > 0) {
+ push @multiple, $_;
+ }
+ }
+ if ($#multiple >= 0) {
+ $ret = 1;
+ print "Multiple included files (relative to $Master):\n";
+ for (sort @multiple) {
+ my @foo = @{$filetopacks{$_}};
+ print " $_ (@foo)\n";
+ }
+ print "\n";
+ }
+ if ($#missing >= 0) {
+ $ret = 1;
+ print "Files mentioned in tlpdb but missing (relative to $Master):\n";
+ for my $m (@missing) {
+ print "\t$m\n";
+ }
+ print "\n";
+ }
+
+ # if we are on Win32 or MacOS we return, they currently do not allow
+ # find -wholename (missing find on w32, or bsd find on darwin).
+ # we need the -use-svn version only for the check-file-coverage
+ # replacement anyway, so it will be used on tug, which is neither w32 nor
+ # darwin.
+ 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/tests/ tlpkg/etc/
+ tlpkg/texlive.tlpdb
+ tlpkg/tlpobj
+ texmf-var/
+ texmf-config/
+ texmf.cnf
+ install-tl.log
+ tlpkg/texlive.profile
+ tlpkg/installer
+ install-tl$
+ install-tl.bat$
+ install-tl.bat.manifest$
+ !;
+ my $tltree = TeXLive::TLTREE->new ("svnroot" => $Master);
+ if ($svn) {
+ debug("Initializine TLTREE from svn\n");
+ $tltree->init_from_svn;
+ } else {
+ debug("Initializine TLTREE from find\n");
+ $tltree->init_from_files;
+ }
+ my %tltreefiles = %{$tltree->{'_allfiles'}};
+ my @tlpdbfiles = keys %filetopacks;
+ my @nohit;
+ for my $f (keys %tltreefiles) {
+ # if it is mentioned in the tlpdb or is ignored it is considered
+ # as covered, thus, otherwise we push it onto the nothit list
+ if (!defined($filetopacks{$f})) {
+ my $ignored = 0;
+ for my $p (@IgnorePatterns) {
+ if ($f =~ m/^$p/) {
+ $ignored = 1;
+ last;
+ }
+ }
+ if (!$ignored) {
+ push @nohit, $f;
+ }
+ }
+ }
+ if (@nohit) {
+ $ret = 1;
+ print "Files present but not covered (relative to $Master):\n";
+ for my $f (sort @nohit) {
+ print " $f\n";
+ }
+ print "\n";
+ }
+ return($ret);
+}
+
+#
+# check collections
+#
+sub check_collections {
+ my @missing = ();
+ for my $p ($localtlpdb->collections()) {
+ my $col = $localtlpdb->get_package($p);
+ for my $d ($col->depends) {
+ push @missing, "$d ($p)" if (!defined($localtlpdb->get_package($d)));
+ }
+ }
+ return(0) if (!@missing);
+ print "Packages listed in collections but not present:\n";
+ for my $m (@missing) {
+ print "\t$m\n";
+ }
+ print "\n";
+}
+
+
+#
+# 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);
+}
+
+#
+# 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 # evaluates only the -pause option, and then exits.
+sub finish {
+ my ($ret) = @_;
+
+ if ($ret > 0) {
+ print "tlmgr: exiting unsuccessfully (status $ret).\n";
+ }
+
+ if ($opt_pause) {
+ print "Please press <ENTER> to exit the program.\n";
+ <STDIN>;
+ }
+
+ exit($ret);
+}
+
+# RECREATE TLPDB
+#
+sub action_recreate_tlpdb {
+ my $opt_arch;
+ Getopt::Long::Configure(@getopt_configure_subopts);
+ GetOptions("arch=s" => \$opt_arch) or pod2usage(2);
+ my $tlpdb = TeXLive::TLPDB->new;
+ $tlpdb->root($Master);
+ my $inst = TeXLive::TLPOBJ->new;
+ $inst->name("00texlive-installation.config");
+ $inst->category("TLCore");
+ my @deps;
+ push @deps, "location:$TeXLive::TLConfig::TeXLiveURL";
+ push @deps, "opt_create_formats:0";
+ push @deps, "opt_create_symlinks:0";
+ push @deps, "opt_sys_bin:/usr/local/bin";
+ push @deps, "opt_sys_info:/usr/local/info";
+ push @deps, "opt_sys_man:/usr/local/man";
+ push @deps, "opt_install_docfiles:0";
+ push @deps, "opt_install_srcfiles:0";
+ # find list of available archs
+ my @archs;
+ opendir (DIR, "$Master/bin") || die "opendir($Master/bin) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($Master/bin) failed: $!";
+ for my $dirent (@dirents) {
+ next if $dirent eq ".";
+ next if $dirent eq "..";
+ next unless -d "$Master/bin/$dirent";
+ if (-r "$Master/bin/$dirent/kpsewhich" || -r "$Master/bin/$dirent/kpsewhich.exe") {
+ push @archs, $dirent;
+ debug("Skipping directory $Master/bin/$dirent, no kpsewhich there\n");
+ }
+ }
+ push @deps, "available_architectures:" . join(" ",@archs);
+ # we have to find out the default arch
+ # if there is only one dir in $Master/bin then we are settled,
+ # otherwise we expect the user to pass a correct arch string
+ if ($^O =~ /^MSWin(32|64)$/i) {
+ push @deps, "platform:win32";
+ } else {
+ if ($#archs == 0) {
+ # only one arch available, fine, use it as default
+ push @deps, "platform:$archs[0]";
+ } else {
+ if (defined($opt_arch)) {
+ if (member($opt_arch, @archs)) {
+ push @deps, "platform:" . $opt_arch;
+ } else {
+ tlwarn("The architecture you passed in with --arch is not present in $Master/bin\n");
+ tlwarn("Please specify one from the available ones: @archs\n");
+ exit(1);
+ }
+ } else {
+ tlwarn("More than one architecture available: @archs\n");
+ tlwarn("Please pass one as the default you are running on with --arch=...\n");
+ exit(1);
+ }
+ }
+ }
+ $inst->depends(@deps);
+ # now we have all the stuff for 00texlive-installation.config done
+ $tlpdb->add_tlpobj($inst);
+ # add the other stuff in $Master/tlpkg/tlpobj/*.tlpobj
+ # we can ignore *.{source,doc}.tlpobj because they are already
+ # included in the *.tlpobj parent one at install time
+ # (TODO: we should actually REMOVE the *.{source,doc}.tlpobj files
+ # at package install time)
+ opendir (DIR, "$Master/tlpkg/tlpobj") or die "opendir($Master/tlpkg/tlpobj) failed: $!";
+ my @tlps = readdir(DIR);
+ closedir (DIR) || warn "closedir($Master/tlpkg/tlpobj) failed: $!";
+ for my $t (@tlps) {
+ next if -d $t; # also does . and ..
+ next if ($t !~ m/\.tlpobj$/i);
+ # ignore .source and .doc tlpobjs
+ next if ($t =~ m/\.(source|doc)\.tlpobj$/i);
+ my $tlp = TeXLive::TLPOBJ->new;
+ $tlp->from_file("$Master/tlpkg/tlpobj/$t");
+ $tlpdb->add_tlpobj($tlp);
+ }
+ # writeout the re-created tlpdb to stdout
+ $tlpdb->writeout;
+ return;
+}
+
+# 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 $dryrun = 0;
+ $dryrun = 1 if ($opt_dry);
+ # keep arbitrary many backups
+ return if ($autobackup == -1);
+
+ opendir (DIR, $opt_backupdir) || die "opendir($opt_backupdir) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($opt_backupdir) failed: $!";
+ my @backups;
+ for my $dirent (@dirents) {
+ next if (-d $dirent);
+ next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.lzma$/);
+ push @backups, $1;
+ }
+ 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;
+ }
+ $i++;
+ }
+}
+
+#
+# check for updates to tlcritical packages
+#
+sub check_for_critical_updates
+{
+ my ($localtlpdb, $mediatlpdb) = @_;
+
+ my $criticalupdate = 0;
+ my @critical = $localtlpdb->expand_dependencies("-no-collections",
+ $localtlpdb, @CriticalPackagesList);
+ for my $pkg (sort @critical) {
+ my $tlp = $localtlpdb->get_package($pkg);
+ if (!defined($tlp)) {
+ # that should not happen, we expanded in the localtlpdb so why
+ # should it not be present, any anyway, those are so fundamental
+ # so they have to be there
+ tlwarn("Fundamental package $pkg not present, that is sooo bad.\n");
+ die "Serious error, $pkg not found";
+ }
+ my $localrev = $tlp->revision;
+ my $mtlp = $mediatlpdb->get_package($pkg);
+ if (!defined($mtlp)) {
+ tlwarn("Very suprising, $pkg is not present in the remote tlpdb.\n");
+ next;
+ }
+ my $remoterev = $mtlp->revision;
+ if ($remoterev > $localrev) {
+ $criticalupdate = 1;
+ last;
+ }
+ }
+ if ($criticalupdate) {
+ tlwarn("Updates for tlmgr itself are present.\n");
+ tlwarn("==========================================================\n");
+ tlwarn("Please update the package bin-texlive and texlive.infra first,");
+ tlwarn("e.g., by calling\n");
+ tlwarn(" tlmgr update bin-texlive texlive.infra\n");
+ tlwarn("Or get the latest updater from\nfor Unix-ish systems:\n");
+ tlwarn(" $TeXLiveURL/update-tlmgr-latest.sh\n");
+ tlwarn("for Windows systems:\n");
+ tlwarn(" $TeXLiveURL/update-tlmgr-latest.exe\n");
+ tlwarn("Then continue with other updates.\n");
+ tlwarn("==========================================================\n");
+ }
+ return($criticalupdate);
+}
+
+
+#
+# return all the directories from which all content will be removed
+#
+# idea:
+# - create a hashes by_dir listing all files that should be removed
+# by directory, i.e., key = dir, value is list of files
+# - for each of the dirs (keys of by_dir and ordered deepest first)
+# check that all actually contained files are removed
+# and all the contained dirs are in the removal list. If this is the
+# case put that directory into the removal list
+# - return this removal list
+#
+sub removed_dirs
+{
+ my (@files) = @_;
+ my %removed_dirs;
+ my %by_dir;
+
+ # construct hash of all directories mentioned, values are lists of the
+ # files/dirs in that directory.
+ for my $f (@files) {
+ # what should we do with not existing entries????
+ next if (! -r "$f");
+ my $abs_f = abs_path ($f);
+ if (!$abs_f) {
+ warn ("oops, no abs_path($f) from " . `pwd`);
+ next;
+ }
+ (my $d = $abs_f) =~ s,/[^/]*$,,;
+ my @a = exists $by_dir{$d} ? @{$by_dir{$d}} : ();
+ push (@a, $abs_f);
+ $by_dir{$d} = \@a;
+ }
+
+ # for each of our directories, see if we are removing everything in
+ # the directory. if so, return the directory; else return the
+ # individual files.
+ for my $d (reverse sort keys %by_dir) {
+ opendir (DIR, $d) || die "opendir($d) failed: $!";
+ my @dirents = readdir (DIR);
+ closedir (DIR) || warn "closedir($d) failed: $!";
+
+ # initialize test hash with all the files we saw in this dir.
+ # (These idioms are due to "Finding Elements in One Array and Not
+ # Another" in the Perl Cookbook.)
+ my %seen;
+ my @rmfiles = @{$by_dir{$d}};
+ @seen{@rmfiles} = ();
+
+ # see if everything is the same.
+ my $cleandir = 1;
+ for my $dirent (@dirents) {
+ next if $dirent =~ /^\.(\.|svn)?$/; # ignore . .. .svn
+ my $item = "$d/$dirent"; # prepend directory for comparison
+ if (
+ ((-d $item) && (defined($removed_dirs{$item})))
+ ||
+ (exists $seen{$item})
+ ) {
+ # do nothing
+ } else {
+ $cleandir = 0;
+ last;
+ }
+ }
+ if ($cleandir) {
+ $removed_dirs{$d} = 1;
+ }
+ }
+ return keys %removed_dirs;
+}
+
+__END__
+
+=head1 NAME
+
+tlmgr - the TeX Live Manager
+
+=head1 SYNOPSIS
+
+tlmgr [I<option>]... I<action> [I<option>]... [I<operand>]...
+
+=head1 DESCRIPTION
+
+B<tlmgr> manages an existing TeX Live installation, both packages and
+configuration options. It performs many of the same actions as
+B<texconfig>(1), and more besides. (C<texconfig> continues to be
+included and supported, but C<tlmgr> is now preferred.)
+
+The most up-to-date version of this documentation is available at
+L<http://tug.org/texlive/tlmgr.html>, along with procedures for updating
+tlmgr itself, disaster recovery when it's broken, and test versions.
+
+=head1 OPTIONS
+
+The following options to C<tlmgr> have to be given I<before> you specify
+the main action to perform. In all cases, C<-->I<option> and
+C<->I<option> are equivalent, and an C<=> is optional between an option
+name and its value.
+
+=over 4
+
+=item B<--location> I<location>
+
+Specifies the location from which packages should be installed or
+updated, overriding the location found in the installation's TeX Live
+Package Database (TLPDB).
+
+=item B<--gui> [I<action>]
+
+You can give this option together with an action to be brought directly
+into the respective screen of the GUI. For example, running
+
+ tlmgr --gui update
+
+starts you directly at the update screen.
+
+=item B<--gui-lang> I<llcode>
+
+Normally the GUI tries to deduce your language from the environment (on
+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<--package-logfile> I<file>
+
+B<tlmgr> logs all package actions (install, remove, update, failed
+updates, failed restores) to a separate log file, by default
+C<TEXMFSYSVAR/web2c/tlmgr.log>. This option allows you to select a
+different file for that. This is separate from normal logging; for
+that, see the option C<-v> below, and TeXLive::TLUtils.
+
+=item B<--pause>
+
+This option make B<tlmgr> wait for user input before exiting. Useful on
+Windows to avoid command windows disappearing.
+
+=back
+
+The standard options for TeX Live programs are also accepted:
+C<--help/-h/-?>, C<--version>, C<-q> (no informational messages), C<-v>
+(debugging messages, can be repeated). For the details about these, see
+the TeXLive::TLUtils documentation.
+
+The C<--version> option shows version information about the TeX Live
+release as well as the C<tlmgr> script itself.
+
+=head1 ACTIONS
+
+=head2 help
+
+Gives this help information (same as C<--help>).
+
+=head2 version
+
+Gives version information (same as C<--version>).
+
+=head2 gui
+
+Start the graphical user interface.
+
+
+=head2 install [I<option>]... I<pkg>...
+
+Install each I<pkg> given on the command line. By default this installs
+all packages on which the given I<pkg>s are dependent, also. Options:
+
+=over 4
+
+=item B<--reinstall>
+
+Reinstall a package (including dependencies for collections) even if it
+seems to be already installed (i.e, is present in the TLPDB). This is
+useful to recover from accidental removal of files in the hierarchy.
+
+When re-installing, only dependencies on normal packages are followed
+(not those of category Scheme or Collection).
+
+=item B<--no-depends>
+
+Do not install dependencies. (By default, installing a package ensures
+that all dependencies of this package are fulfilled.)
+
+=item B<--no-depends-at-all>
+
+When you install a package which ships binary files the respective binary
+package will also be installed. (So for package bin-foobar also the package
+bin-foobar.i386-linux will be installed on an i386-linux system.)
+This switch supresses this behaviour, and also implies C<--no-depends>.
+Don't use it unless you are sure of what you are doing.
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=item B<--force>
+
+If updates to the tlmgr itself (and the underlying infrastructure) are
+present tlmgr will bail out and not perform the installation unless this option
+is given.
+
+=back
+
+
+=head2 update [I<option>]... [I<pkg>]...
+
+Updates the packages given as arguments to the latest version available
+at the installation source. Either C<--all> or at least one I<pkg> name
+must be specified. Options:
+
+=over 4
+
+=item B<--all>
+
+Update all installed packages. For packages contained in an installed
+collection, also install new packages and remove deleted packages in
+those collections. Packages not contained in an installed collection
+are not considered for addition or removal.
+
+More precisely, if both the server and the local installation have a
+collection C, and C on the server contains a package A that is not
+present locally, A will be added. Conversely, if the local collection C
+contains a package B, but B is no longer in the server's C, then B will
+be deleted.
+
+=item B<--list>
+
+Concisely list the packages which would be updated, newly installed, or
+removed, without actually changing anything.
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+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.
+
+=item B<--no-remove>
+
+Under normal circumstances tlmgr tries to remove packages which have
+disappeared on the server when called with C<--all>, as described
+above. This prevents any such removals.
+
+=item B<--backup> and B<--backupdir> I<directory>
+
+These two options control the creation of backups of packages before an
+update is started; that is, the backup is of the package as it's
+installed. If neither of the two are given, no backup package will be
+saved. If B<--backupdir> is given and specifies a writable directory
+then a backup will be made in that location. If only B<--backup> is
+given, then a backup will be made to the directory previously set via
+the C<option> action (see below). If both are given then a backup will
+be made to the specified I<directory>.
+
+You can set options via the C<option> action to automatically create
+backups for all packages, and/or keep only a certain number of
+backups. Please see the C<option> action for details.
+
+C<tlmgr> always makes a temporary backup when updating packages, in case
+of download or other failure during an update. The purpose of this
+B<--backup> option is to allow you to save a persistent backup in case
+the actual I<content> of the update causes problems, e.g., introduces an
+incompatibility.
+
+The C<restore> action explains how to restore from a backup.
+
+=item B<--no-depends>
+
+If you call for updating a package normally all depending packages
+will also be checked for updates and updated if necessary. This switch
+supresses this behaviour.
+
+=item B<--no-depends-at-all>
+
+By default, when you update a package which ships binary files the
+respective binary package will also be updated. That is, for an update
+of a package C<foo>, the package C<foobar.i386-linux> will also be
+updated if the i386-linux platform is installed. This option suppresses
+this behaviour, and implies C<--no-depends>. Don't use it unless you
+are sure of what you are doing.
+
+=back
+
+If the package on the server is older than the package already installed
+(e.g., if the selected mirror is out of date), C<tlmgr> does not
+downgrade. Also, packages for uninstalled platforms are not installed.
+
+
+=head2 backup [--clean[=I<N>]] [--backupdir I<dir>] [--all] [I<pkg>]...
+
+If the B<--clean> option is not specified, this action makes a backup of
+the given packages, or all packages given C<--all>. These backups are
+saved to the value of B<--backupdir> option if that is an existing and
+writable directory; if B<--backupdir> is not given, the C<backupdir>
+option setting in the TLPDB is used, if present. If both are missing,
+no backups are made.
+
+If the B<--clean> option is specified, backups are cleaned (pruned)
+instead of made. If the value for the B<--clean> switch is not given,
+the value of the C<autobackup> option is used. If both are missing,
+an error is issued. For the details of backup cleaning, see the
+C<option> action below.
+
+Options:
+
+=over 4
+
+=item B<--backupdir> I<directory>
+
+The I<directory> argument is required and must specify an existing
+directory where backups are to be placed.
+
+=item B<--all>
+
+Make a backup of all packages in the TeX Live installation. This will
+take quite a lot of space and time.
+
+=item B<--clean>[=I<N>]
+
+Instead of making backups, prune the backup directory of old backups.
+
+=item B<--dry-run>
+
+Nothing is actually backed up or removed; instead, the actions to be
+performed are written to the terminal.
+
+=back
+
+
+=head2 restore --backupdir I<dir> [I<pkg> [I<rev>]
+
+Restore a package from a previously-made backup.
+
+If neither I<pkg> nor I<rev> are given, list the available backup
+revisions for all packages.
+
+With I<pkg> given but no I<rev>, list all available backup revisions of
+I<pkg>.
+
+With both I<pkg> and I<rev>, tries to restore the package from the
+specified backup.
+
+Options:
+
+=over 4
+
+=item B<--dry-run>
+
+Nothing is actually restored; instead, the actions to be performed are
+written to the terminal.
+
+=item B<--backupdir> I<directory>
+
+Specify the directory where the backups are to be found.
+
+=back
+
+
+=head2 remove [I<option>]... I<pkg>...
+
+Remove each I<pkg> specified. Removing a collection removes all package
+dependencies, but not collection dependencies, in that collection
+(unless C<--no-depends> is specified). However, when removing a
+package, dependencies are never removed. Options:
+
+=over 4
+
+=item B<--no-depends>
+
+Do not remove dependent packages.
+
+=item B<--no-depends-at-all>
+
+See above under B<action> (and beware).
+
+=item B<--force>
+
+By default, removal of a package or collection that is a dependency of
+another collection or scheme is not allowed. With this option, the
+package will be removed unconditionally. Use with care.
+
+=item B<--dry-run>
+
+Nothing is actually removed; instead, the actions to be performed are
+written to the terminal.
+
+=back
+
+
+=head2 option
+
+=over 4
+
+=item B<option [show]>
+
+=item B<option I<key> [I<value>]>
+
+=back
+
+The first form shows the global TeX Live settings currently saved in the
+TLPDB.
+
+In the second form, if I<value> is not given, the setting for I<key> is
+displayed. If I<value> is present, I<key> is set to I<value>.
+
+Possible values for I<key> are:
+ C<location> (default installation location),
+ C<formats> (create formats at installation time),
+ C<docfiles> (install documentation files),
+ C<srcfiles> (install source files),
+ C<backupdir> (default directory for backups),
+ C<autobackup> (number of backups to keep).
+
+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
+updates from the Internet. To do this, you can run
+
+ tlmgr option location http://mirror.ctan.org/systems/texlive/tlnet/YYYY
+
+where YYYY is the TeX Live release year.
+
+The two options C<autobackup> and C<backupdir> determine defaults for
+the C<update>, C<backup> and C<restore> actions. These three actions
+need a directory to write to or read from the backups. If
+C<--backupdir> is not specified on the command line, the C<backupdir>
+option value is used (if set).
+
+The C<autobackup> option (de)activates the automatic generation of
+backups. Its value is an integer. If C<autobackup> is C<-1>, backups
+will not be removed by default. If C<autobackup> is 0 or positive, it
+specifies the number of backups to be kept. Thus, backups are disabled
+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 paper
+
+=over 4
+
+=item B<paper a4>
+
+=item B<paper letter>
+
+=item B<[xdvi|dvips|pdftex|dvipdfm|dvipdfmx|context] paper [help|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.
+
+
+=head2 arch list|add I<arch>...
+
+C<arch list> lists the TeX Live names of all the architectures
+(C<i386-linux>, ...) available at the default install location.
+
+C<arch add> I<arch> adds the executables for each given architecture
+I<arch> to the installation. Options:
+
+=over 4
+
+=item B<--dry-run>
+
+Nothing is actually installed; instead, the actions to be performed are
+written to the terminal.
+
+=back
+
+
+=head2 search [I<option>]... I<what>
+
+By default searches the names, short and long descriptions of all
+locally installed packages for the given argument (interpreted as
+regexp). Options:
+
+=over 4
+
+=item B<--file>
+
+List all filenames containing I<what>.
+
+=item B<--global>
+
+Search the TeX Live Database of the installation medium, instead of the
+local installation.
+
+=back
+
+
+=head2 show [--list] I<pkg>...
+
+Shows information about I<pkg>: the name, category, installation status,
+short and long description. Searches in the remote installation source
+for the package if it is not locally installed.
+
+If the option B<--list> is given the list of contained files is also
+shown, including those for architecture specific dependencies.
+
+
+=head2 list [collections|schemes|I<pkg>...]
+
+With no argument, lists all packages available at the default install
+location, prefixing those already installed with C<i>.
+
+With the single word C<collections> or C<schemes> as the argument, lists
+the request type.
+
+With anything else as arguments, operates as the C<show> action.
+
+
+=head2 check [I<option>]... [files|collections|all]
+
+Executes one (or all) check(s) on the consistency of the installation.
+
+=over 4
+
+=item B<files>
+
+Checks that all files listed in the TeX Live Database (C<texlive.tlpdb>)
+are actually present, and lists those missing.
+
+=item B<collections>
+
+Lists those packages which occur as dependencies in an installed collections,
+but are themselves not installed. Options:
+
+=back
+
+=over 4
+
+=item B<--use-svn>
+
+Use svn status instead of listing the files, for checking the
+development repository.
+
+=back
+
+
+=head2 uninstall
+
+Uninstalls the entire TeX Live installation. Options:
+
+=over 4
+
+=item B<--force>
+
+Do not ask for confirmation, remove immediately.
+
+=back
+
+
+=head2 generate
+
+=over 4
+
+=item B<generate language>
+
+=item B<generate language.dat>
+
+=item B<generate language.def>
+
+=item B<generate fmtutil>
+
+=item B<generate updmap>
+
+=back
+
+The I<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
+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
+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
+C<updmap-local.cfg> are present under C<TEXMFLOCAL> in the respective
+directories, their contents will be simply merged into the final files,
+with no error checking of any kind.
+
+The form C<generate language> recreates both the C<language.dat> and the
+C<language.def> files, while the forms with extension only recreates
+the given file.
+
+Options:
+
+=over 4
+
+=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
+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
+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>).
+
+=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>)
+
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+# to remake HTML version: pod2html --cachedir=/tmp tlmgr.pl >/foo/tlmgr.html.
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #
diff --git a/Master/tlpkg/archive/tlmgrgui2-withtabs.pl b/Master/tlpkg/archive/tlmgrgui2-withtabs.pl
new file mode 100644
index 00000000000..1e683d8f255
--- /dev/null
+++ b/Master/tlpkg/archive/tlmgrgui2-withtabs.pl
@@ -0,0 +1,1532 @@
+#!/usr/bin/env perl
+# $Id: tlmgrgui2.pl 15823 2009-10-18 01:41:28Z preining $
+#
+# Copyright 2009 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# GUI for tlmgr
+# version 2, completely rewritten GUI
+#
+# TODO: move the check for critical updates from old create_update_list
+# to here!!
+# TODO: center checkbuttons vertically
+# TODO: double click on one line should pop up a window with tlmgr show info
+
+$^W = 1;
+use strict;
+
+use Tk;
+use Tk::Dialog;
+use Tk::BrowseEntry;
+use Tk::ROText;
+use Tk::TixGrid;
+use TeXLive::Splashscreen;
+
+use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug);
+use TeXLive::TLConfig;
+
+our $Master;
+our $tlmediatlpdb;
+our $tlmediasrc;
+our $localtlpdb;
+
+# defined in tlmgr.pl
+our $location;
+
+my $tlpdb_location;
+my $cmdline_location;
+#
+our %opts;
+#
+# the list of packages as shown by TixGrid
+#
+my %Packages;
+our $mw;
+
+sub update_status_box {
+ update_status(join(" ", @_));
+ $mw->update;
+}
+
+sub init_hooks {
+ push @::info_hook, \&update_status_box;
+ push @::warn_hook, \&update_status_box;
+ push @::debug_hook, \&update_status_box;
+ push @::ddebug_hook, \&update_status_box;
+ push @::dddebug_hook, \&update_status_box;
+}
+
+sub update_status {
+ my ($p) = @_;
+ $::progressw->insert("end", "$p");
+ $::progressw->see("end");
+}
+
+
+# prepare for loading of lang.pl which expects $::lang and $::opt_lang
+$::opt_lang = $opts{"gui-lang"} if (defined($opts{"gui-lang"}));
+
+require("TeXLive/trans.pl");
+
+our @update_function_list;
+
+$mw = MainWindow->new;
+$mw->title("TeX Live Manager $TeXLive::TLConfig::ReleaseYear");
+$mw->withdraw;
+
+#
+# default layout definitions
+#
+# priority 20 = widgetDefault
+# see Mastering Perl/Tk, 16.2. Using the Option Database
+$mw->optionAdd("*Button.Relief", "ridge", 20);
+#
+# does not work, makes all buttons exactely 10, which is not a good idea
+# I would like to have something like MinWidth 10...
+#$mw->optionAdd("*Button.Width", "10", 20);
+#
+# shortcuts for padding, expand/fill, and pack sides, anchors
+my @p_ii = qw/-padx 2m -pady 2m/;
+my @p_iii= qw/-padx 3m -pady 3m/;
+my @x_x = qw/-expand 1 -fill x/;
+my @x_y = qw/-expand 1 -fill y/;
+my @x_xy= qw/-expand 1 -fill both/;
+my @left = qw/-side left/;
+my @right= qw/-side right/;
+my @bot = qw/-side bottom/;
+my @a_w = qw/-anchor w/;
+my @a_c = qw/-anchor c/;
+
+
+# create a progress bar window
+$::progressw = $mw->Scrolled("ROText", -scrollbars => "e", -height => 4);
+$::progressw->pack(-fill => "x", @bot);
+
+
+my $critical_updates_present = 0;
+
+
+init_hooks();
+
+info(__("Loading local TeX Live Database\nThis may take some time, please wait!") . "\n");
+
+our $localtlmedia = TeXLive::TLMedia->new ( $Master );
+die("cannot setup TLMedia in $Master") unless (defined($localtlmedia));
+$localtlpdb = $localtlmedia->tlpdb;
+die("cannot find tlpdb!") unless (defined($localtlpdb));
+
+our @main_list;
+
+$tlpdb_location = $localtlpdb->option("location");
+if (defined($opts{"location"})) {
+ $cmdline_location = $opts{"location"};
+}
+
+
+push @update_function_list, \&check_location_on_ctan;
+push @update_function_list, \&init_install_media;
+
+#
+# check that we can actually save the database
+#
+if (check_on_writable()) {
+ $::we_can_save = 1;
+} else {
+ $::we_can_save = 0;
+ # here we should pop up a warning window!!!
+}
+$::action_button_state = ($::we_can_save ? "normal" : "disabled");
+
+my $tlmgrrev = give_version();
+chomp($tlmgrrev);
+
+our $top = $mw->Frame;
+
+my $menu = $mw->Menu();
+my $menu_file = $menu->Menu();
+my $menu_options = $menu->Menu();
+my $menu_actions = $menu->Menu();
+my $menu_help = $menu->Menu();
+$menu->add('cascade', -label => "File", -menu => $menu_file);
+$menu->add('cascade', -label => "Options", -menu => $menu_options);
+$menu->add('cascade', -label => "Actions", -menu => $menu_actions);
+$menu->add('cascade', -label => "Help", -menu => $menu_help);
+$menu->add('separator');
+$menu->add('command', -label => "Loaded repository: none",
+ -command => sub { $location = $tlpdb_location;
+ update_loaded_location_string();
+ run_update_functions();
+ });
+# -activebackground => $menu->cget(-background));
+
+#
+# FILE MENU
+#
+$menu_file->add('command', -label => "Load default repository: $tlpdb_location",
+ -command => sub {
+ $location = $tlpdb_location;
+ update_loaded_location_string();
+ run_update_functions();
+ });
+if (defined($cmdline_location)) {
+ $menu_file->add('command', -label => "Load cmd line repository: $cmdline_location",
+ -command => sub {
+ $location = $cmdline_location;
+ update_loaded_location_string();
+ run_update_functions();
+ });
+}
+$menu_file->add('command', -label => "Load default net repository: $TeXLiveURL",
+ -command => sub {
+ $location = $TeXLiveURL;
+ update_loaded_location_string();
+ run_update_functions();
+ });
+$menu_file->add('command', -label => "Load other repository",
+ -command => sub { menu_edit_location(); });
+$menu_file->add('separator');
+$menu_file->add('command', -label => __("Quit"),
+ -command => sub { $mw->destroy; exit(0); });
+
+#
+# OPTIONS MENU
+#
+$menu_options->add('command', -label => __("General settings"),
+ -command => sub { do_general_settings(); });
+$menu_options->add('command', -label => __("Paper settings"),
+ -command => sub { do_paper_settings(); });
+$menu_options->add('command', -label => __("Arch settings"),
+ -command => sub { do_arch_settings(); });
+$menu_options->add('separator');
+$menu_options->add('checkbutton', -label => __("Debug"),
+ -onvalue => ($::opt_verbosity == 0 ? 1 : $::opt_verbosity),
+ -variable => \$::opt_verbosity);
+
+#
+# Actions menu
+#
+$menu_actions->add('command', -label => __("Re-initialize file database"),
+ -state => $::action_button_state,
+ -command => sub {
+ $mw->Busy(-recurse => 1);
+ info("Running mktexlsr, this may take some time ...\n");
+ info(`mktexlsr 2>&1`);
+ $mw->Unbusy;
+ });
+$menu_actions->add('command', -label => __("Re-create all formats"),
+ -state => $::action_button_state,
+ -command => sub {
+ $mw->Busy(-recurse => 1);
+ info("Running fmtutil-sys --all, this may take some time ...\n");
+ info(`fmtutil-sys --all 2>&1`);
+ $mw->Unbusy;
+ });
+$menu_actions->add('command', -label => __("Update font map database"),
+ -state => $::action_button_state,
+ -command => sub {
+ $mw->Busy(-recurse => 1);
+ info("Running updmap-sys, this may take some time ...\n");
+ info(`updmap-sys 2>&1`);
+ $mw->Unbusy;
+ });
+
+if (!win32()) {
+ $menu_actions->add('command', -label => __("Update symbolic links"),
+ -state => $::action_button_state,
+ -command => sub {
+ $mw->Busy(-recurse => 1);
+ info("Updating symlinks ...\n");
+ execute_action_gui("path", "add");
+ $mw->Unbusy;
+ });
+ $menu_actions->add('command', -label => __("Remove symbolic links"),
+ -state => $::action_button_state,
+ -command => sub {
+ $mw->Busy(-recurse => 1);
+ info("Removing symlinks ...\n");
+ execute_action_gui("path", "remove");
+ $mw->Unbusy;
+ });
+}
+if (!win32()) {
+ $menu_actions->add('separator');
+ $menu_actions->add('command', -label => __("Remove TeX Live %s", $TeXLive::TLConfig::ReleaseYear),
+ -state => $::action_button_state,
+ -command => sub {
+ my $sw = $mw->DialogBox(-title => __("Remove TeX Live %s", $TeXLive::TLConfig::ReleaseYear),
+ -buttons => [ __("Ok"), __("Cancel") ],
+ -cancel_button => __("Cancel"),
+ -command => sub {
+ my $b = shift;
+ if ($b eq __("Ok")) {
+ system("tlmgr", "uninstall", "--force");
+ $mw->Dialog(-text => __("Complete removal completed"), -buttons => [ __("Ok") ])->Show;
+ $mw->destroy;
+ exit(0);
+ }
+ });
+ $sw->add("Label", -text => __("Really remove the complete TeX Live %s installation?\nYour last chance to change your mind!", $TeXLive::TLConfig::ReleaseYear))->pack(@p_iii);
+ $sw->Show;
+ });
+}
+
+
+
+#
+# HELP MENU
+$menu_help->add('command', -label => __("About"),
+ -command => sub {
+ my $sw = $mw->DialogBox(-title => __("About"),
+ -buttons => [ __("Ok") ]);
+ $sw->add("Label", -text => "TeX Live Manager (GUIv2)
+$tlmgrrev
+Copyright 2009 Norbert Preining
+
+Licensed under the GNU General Public License version 2 or higher
+In case of problems, please contact: texlive\@tug.org"
+ )->pack(@p_iii);
+ $sw->Show;
+ });
+
+
+$mw->configure(-menu => $menu);
+
+our $back_f1 = $mw->Frame();
+
+# pack .top .back -side top -fill both -expand 1
+$top->pack(-fill => 'x', @p_ii);
+$back_f1->pack(@x_xy);
+
+#require ("do_listframe.pl");
+
+######### SHOULD GO INTO A SEPARTE FILE ########################
+# install screen
+my $top_frame = $back_f1->Labelframe(-text => "Display configuration");
+$top_frame->pack(@x_x, @p_ii);
+
+my $filter_frame = $top_frame->Frame();
+$filter_frame->pack;
+
+my $filter_status = $filter_frame->Labelframe(-text => "Status");
+$filter_status->pack(@left, @p_ii);
+
+my $status_all = 0;
+my $status_only_installed = 1;
+my $status_only_not_installed = 2;
+my $status_only_updated = 3;
+my $status_value = 0;
+$filter_status->Radiobutton(-text => "all",
+ -variable => \$status_value, -value => $status_all)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only installed",
+ -variable => \$status_value, -value => $status_only_installed)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only uninstalled",
+ -variable => \$status_value, -value => $status_only_not_installed)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only updated",
+ -variable => \$status_value, -value => $status_only_updated)->pack(@a_w);
+
+my $filter_category = $filter_frame->Labelframe(-text => "Category");
+$filter_category->pack(@left, @x_y, @p_ii);
+my $show_packages = 1;
+my $show_collections = 1;
+my $show_schemes = 1;
+$filter_category->Checkbutton(-text => "packages",
+ -variable => \$show_packages)->pack(@a_w);
+$filter_category->Checkbutton(-text => "collections",
+ -variable => \$show_collections)->pack(@a_w);
+$filter_category->Checkbutton(-text => "schemes",
+ -variable => \$show_schemes)->pack(@a_w);
+
+my $filter_match = $filter_frame->Labelframe(-text => "Match");
+$filter_match->pack(@left, @x_y, @p_ii);
+my $match_all = 1;
+$filter_match->Radiobutton(-text => "all",
+ -variable => \$match_all, -value => 1)->pack(@a_w);
+$filter_match->Radiobutton(-text => "matching:",
+ -variable => \$match_all, -value => 0)->pack(@a_w);
+my $match_entry =
+ $filter_match->Entry(-width => 15)->pack(@a_w, -padx => '2m', @x_x);
+
+my $filter_selection = $filter_frame->Labelframe(-text => "Selection");
+$filter_selection->pack(@left, @x_y, @p_ii);
+my $selection_value = 0;
+$filter_selection->Radiobutton(-text => "all",
+ -variable => \$selection_value, -value => 0)->pack(@a_w);
+$filter_selection->Radiobutton(-text => "only selected",
+ -variable => \$selection_value, -value => 1)->pack(@a_w);
+$filter_selection->Radiobutton(-text => "only not selected",
+ -variable => \$selection_value, -value => 2)->pack(@a_w);
+
+
+my $filter_button = $filter_frame->Labelframe(-text => "Action");
+$filter_button->pack(@left, @x_y, @p_ii);
+$filter_button->Button(-text => "Apply filters",
+ -command => sub { update_grid(); })->pack(@a_c, @p_ii);
+$filter_button->Button(-text => "Reset filters",
+ -command => sub { $status_value = $status_all;
+ $show_packages = 1; $show_collections = 1;
+ $show_schemes = 1;
+ $selection_value = 0;
+ $match_all = 1;
+ update_grid();
+ })->pack(@a_c, @p_ii);
+
+########## Packages #######################
+my $list_frame = $back_f1->Labelframe(-text => "Packages");
+$list_frame->pack(@x_xy, @p_ii);
+my $g = $list_frame->Scrolled('TixGrid', -scrollbars => "se", -bd => 0,
+ -floatingrows => 0, -floatingcols => 0,
+ -leftmargin => 2, # selection and label
+ -topmargin => 1, # top labels
+ -command => \&show_extended_info, # does not work, double click!
+ -selectmode => "none",
+ -selectunit => "row");
+
+# that does not work, I have no idea what has to be done
+#$g->ItemStyle('window', -anchor => "c");
+
+$g->pack(qw/-expand 1 -fill both -padx 3 -pady 3/);
+$g->configure(-formatcmd=>[\&AlternatingLineColoring, $g]);
+$g->size(qw/col 4 -size 10char/);
+$g->size(qw/col 5 -size 10char/);
+$g->size(qw/col default -size auto/);
+$g->size(qw/row default -size 1.1char -pad0 3/);
+
+setup_list();
+update_grid();
+
+sub show_extended_info {
+ my ($x, $y) = @_;
+ print "double click on $x - $y\n";
+}
+
+sub update_grid {
+ # fill the header
+ #$g->set(0,0, -itemtype => 'window', -widget => $g->Checkbutton());
+ $g->set(1,0, -itemtype => 'text', -text => "Package");
+ $g->set(2,0, -itemtype => 'text', -text => "Local Rev");
+ $g->set(3,0, -itemtype => 'text', -text => "Remote Rev");
+ $g->set(4,0, -itemtype => 'text', -text => "Local Ver");
+ $g->set(5,0, -itemtype => 'text', -text => "Remote Ver");
+ $g->set(6,0, -itemtype => 'text', -text => "Short Desc");
+
+ my @schemes;
+ my @colls;
+ my @packs;
+ for my $p (sort keys %Packages) {
+ if ($Packages{$p}{'category'} eq "Scheme") {
+ push @schemes, $p;
+ } elsif ($Packages{$p}{'category'} eq "Collection") {
+ push @colls, $p;
+ } else {
+ push @packs, $p;
+ }
+ }
+ my $i = 1;
+ # the number of current lines:
+ my (undef, $curlines) = $g->index(0, 'max');
+ for my $p (@schemes, @colls, @packs) {
+ if (MatchesFilters($p)) {
+ # unset first so that the checkbutton is unmapped, otherwise crashes
+ $g->unset(0,$i) if $g->infoExists(0,$i);
+ $g->set(0,$i, -itemtype => 'window',
+ -widget => $Packages{$p}{'cb'});
+ #
+ $g->set(1,$i, -itemtype => 'text', -text => $Packages{$p}{'displayname'});
+ if (defined($Packages{$p}{'localrevision'})) {
+ $g->set(2,$i, -itemtype => 'text', -text => $Packages{$p}{'localrevision'});
+ } else {
+ $g->unset(2,$i);
+ }
+ if (defined($Packages{$p}{'remoterevision'})) {
+ $g->set(3,$i, -itemtype => 'text', -text => $Packages{$p}{'remoterevision'})
+ } else {
+ $g->unset(3,$i);
+ }
+ if (defined($Packages{$p}{'localcatalogueversion'})) {
+ $g->set(4,$i, -itemtype => 'text', -text => $Packages{$p}{'localcatalogueversion'})
+ } else {
+ $g->unset(4,$i);
+ }
+ if (defined($Packages{$p}{'remotecatalogueversion'})) {
+ $g->set(5,$i, -itemtype => 'text', -text => $Packages{$p}{'remotecatalogueversion'})
+ } else {
+ $g->unset(5,$i);
+ }
+ $g->set(6,$i, -itemtype => 'text', -text => $Packages{$p}{'shortdesc'});
+ $i++;
+ }
+ }
+ if ($i <= $curlines) {
+ # remove the rest of the lines
+ $g->deleteRow($i, $curlines);
+ }
+}
+
+sub MatchesFilters {
+ my $p = shift;
+ # status
+ if (( ($status_value == $status_all) ) ||
+ ( ($status_value == $status_only_installed) &&
+ (defined($Packages{$p}{'installed'})) &&
+ ($Packages{$p}{'installed'} == 1) ) ||
+ ( ($status_value == $status_only_not_installed) &&
+ ( !defined($Packages{$p}{'installed'}) ||
+ ($Packages{$p}{'installed'} == 0)) ) ||
+ ( ($status_value == $status_only_updated) &&
+ (defined($Packages{$p}{'localrevision'})) &&
+ (defined($Packages{$p}{'remoterevision'})) &&
+ ($Packages{$p}{'localrevision'} < $Packages{$p}{'remoterevision'}))) {
+ # do nothing, more checks have to be done
+ } else {
+ return 0;
+ }
+ # category
+ if (($show_packages && ($Packages{$p}{'category'} eq 'Other')) ||
+ ($show_collections && ($Packages{$p}{'category'} eq 'Collection')) ||
+ ($show_schemes && ($Packages{$p}{'category'} eq 'Scheme')) ) {
+ # do nothing, more checks have to be done
+ } else {
+ return 0;
+ }
+ # match
+ if (!$match_all) {
+ my $r = $match_entry->get;
+ # check for match on string
+ my $t = $Packages{$p}{'shortdesc'};
+ $t |= "";
+ my $lt = $Packages{$p}{'longdesc'};
+ $lt |= "";
+ if (($p =~ m/$r/) || ($t =~ m/$r/) || ($lt =~ m/$r/)) {
+ # do nothing, more checks have to be done
+ } else {
+ return 0;
+ }
+ }
+ # selection
+ if ($selection_value == 0) {
+ # all -> maybe more checks
+ } elsif ($selection_value == 1) {
+ # only selected
+ if ($Packages{$p}{'selected'}) {
+ # do nothing, maybe more checks
+ } else {
+ # not selected package and only selected packages shown
+ return 0;
+ }
+ } else {
+ # only not selected
+ if ($Packages{$p}{'selected'}) {
+ # selected, but only not selected should be shown
+ return 0;
+ } # else do nothing
+ }
+ #
+ # if we come down to here the package matches
+ return 1;
+}
+
+
+sub AlternatingLineColoring {
+ my ($w, $area, @entbox) = @_;
+ if ($area eq 'main') {
+ # first format all cells
+ # no select background -selectbackground => 'lightblue',
+ $w->formatGrid( @entbox, -selectbackground => 'gray70',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 0,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70');
+ # format odd lines 1,3,5,7, ... (counting starts at 0!!!)
+ $w->formatGrid( @entbox, -selectbackground => 'gray90',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 1,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90');
+ }
+ if ($area eq 'y_margin') {
+ my ($ulx, $uly, $lrx, $lry) = @entbox;
+ # format the checkbuttons backgrounds
+ for my $i ($uly..$lry) {
+ if ($w->infoExists(0,$i)) {
+ my $cb = $w->entrycget(0, $i, "-window");
+ $cb->configure(-background => (($i-$uly)%2 ? 'gray70' : 'gray90'));
+ }
+ }
+ # first format all cells
+ # no select background -selectbackground => 'lightblue',
+ $w->formatBorder( @entbox, -selectbackground => 'gray70',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 0,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70');
+ # format odd lines 1,3,5,7, ... (counting starts at 0!!!)
+ $w->formatBorder( @entbox, -selectbackground => 'gray90',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 1,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90');
+ }
+}
+
+####### actions frame
+
+my $bot_frame = $back_f1->Labelframe(-text => "Actions");
+$bot_frame->pack(@x_x, @p_ii);
+
+my $actions_frame = $bot_frame->Frame;
+$actions_frame->pack();
+
+my $with_sel_frame = $actions_frame->Labelframe(-text => "with selected");
+$with_sel_frame->pack(@left, @p_ii);
+my $action_apply_filter = 1;
+$with_sel_frame->Label(-text => "with filters")->pack(@left, @p_ii);
+
+$with_sel_frame->Radiobutton(-text => "applied",
+ -variable => \$action_apply_filter, -value => 1)->pack(@left, @p_ii);
+$with_sel_frame->Radiobutton(-text => "not applied",
+ -variable => \$action_apply_filter, -value => 0)->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Install',
+ -state => $::action_button_state,
+ -command => sub { install_selected_packages(); }
+ )->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Upgrade',
+ -state => $::action_button_state,
+ -command => sub { update_selected_packages(); }
+ )->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Remove',
+ -state => $::action_button_state,
+ -command => sub { remove_selected_packages(); }
+ )->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Backup',
+ -state => $::action_button_state,
+ -command => sub { backup_selected_packages(); }
+ )->pack(@left, @p_ii);
+
+my $with_all_frame = $actions_frame->Labelframe(-text => "with all");
+$with_all_frame->pack(@left, @p_ii);
+$with_all_frame->Button(-text => 'Update all',
+ -state => $::action_button_state,
+ -command => sub { update_all_packages(); }
+ )->pack(@a_c,@left,@p_ii);
+
+######################## ARCH ###########################
+
+my @archsavail;
+my @archsinstalled;
+my %archs;
+my $currentarch;
+
+sub init_archs {
+ if (!defined($tlmediatlpdb)) {
+ @archsavail = $localtlpdb->available_architectures;
+ } else {
+ @archsavail = $tlmediatlpdb->available_architectures;
+ }
+ $currentarch = $localtlmedia->platform();
+ @archsinstalled = $localtlpdb->available_architectures;
+ foreach my $a (@archsavail) {
+ $archs{$a} = 0;
+ if (grep(/^$a$/,@archsinstalled)) {
+ $archs{$a} = 1;
+ }
+ }
+}
+
+
+sub do_arch_settings {
+ my $sw = $mw->Toplevel(-title => __("Select architectures to support"));
+ my %archsbuttons;
+ init_archs();
+ $sw->transient($mw);
+ $sw->grab();
+ my $subframe = $sw->Labelframe(-text => __("Select architectures to support"));
+ $subframe->pack(-fill => "both", -padx => "2m", -pady => "2m");
+ foreach my $a (@archsavail) {
+ $archsbuttons{$a} =
+ $subframe->Checkbutton(-command => sub { check_on_removal($sw, $a); },
+ -variable => \$archs{$a},
+ -text => platform_desc($a)
+ )->pack(-anchor => 'w');
+ }
+ my $arch_frame = $sw->Frame;
+ $arch_frame->pack(-padx => "10m", -pady => "5m");
+ $arch_frame->Button(-text => __("Apply changes"),
+ -state => $::action_button_state,
+ -command => sub { apply_arch_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+ $arch_frame->Button(-text => __("Cancel"),
+ -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+}
+
+sub check_on_removal {
+ my $arch_frame = shift;
+ my $a = shift;
+ if (!$archs{$a} && $a eq $currentarch) {
+ # removal not supported
+ $archs{$a} = 1;
+ $arch_frame->Dialog(-title => "info",
+ -text => __("Removals of the main architecture not possible!"),
+ -buttons => [ __("Ok") ])->Show;
+ }
+}
+
+sub apply_arch_changes {
+ my @todo_add;
+ my @todo_remove;
+ foreach my $a (@archsavail) {
+ if (!$archs{$a} && grep(/^$a$/,@archsinstalled)) {
+ push @todo_remove, $a;
+ next;
+ }
+ if ($archs{$a} && !grep(/^$a$/,@archsinstalled)) {
+ push @todo_add, $a;
+ next;
+ }
+ }
+ if (@todo_add) {
+ execute_action_gui ( "arch", "add", @todo_add );
+ }
+ if (@todo_remove) {
+ execute_action_gui ( "arch", "remove", @todo_remove );
+ }
+ if (@todo_add || @todo_remove) {
+ reinit_local_tlpdb();
+ init_archs();
+ }
+}
+
+########## CONFIG ###################
+#
+my @fileassocdesc;
+$fileassocdesc[0] = __("None");
+$fileassocdesc[1] = __("Only new");
+$fileassocdesc[2] = __("All");
+my %defaults;
+my %changeddefaults;
+
+sub init_defaults_setting {
+ for my $key (keys %TeXLive::TLConfig::TLPDBOptions) {
+ if ($TeXLive::TLConfig::TLPDBOptions{$key}->[0] eq "b") {
+ $defaults{$key} = ($localtlpdb->option($key) ? 1 : 0);
+ } else {
+ $defaults{$key} = $localtlpdb->option($key);
+ }
+ }
+}
+
+sub do_general_settings {
+ my $sw = $mw->Toplevel(-title => __("Default settings"));
+ $sw->transient($mw);
+ $sw->grab();
+ init_defaults_setting();
+ %changeddefaults = ();
+ for my $k (keys %defaults) {
+ $changeddefaults{$k}{'value'} = $defaults{$k};
+ if ($TeXLive::TLConfig::TLPDBOptions{$k}->[0] eq "b") {
+ $changeddefaults{$k}{'display'} = ($defaults{$k} ? __("Yes") : __("No"));
+ } else {
+ if ($k eq "file_assocs") {
+ $changeddefaults{$k}{'display'} = $fileassocdesc[$defaults{$k}];
+ } else {
+ $changeddefaults{$k}{'display'} = $defaults{$k};
+ }
+ }
+ }
+
+ my @config_set_l;
+ my @config_set_m;
+ my @config_set_r;
+
+ my $back_config_set = $sw->Labelframe(-text => __("Default settings"));
+ my $back_config_buttons = $sw->Frame();
+ $back_config_set->pack(-fill => "both", -padx => "2m", -pady => "2m");
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Default package repository"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"location"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { menu_default_location($sw); });
+
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Create formats on installation"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"create_formats"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Toggle"),
+ -command => sub { toggle_setting("create_formats"); });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Install macro/font sources"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"install_srcfiles"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Toggle"),
+ -command => sub { toggle_setting("install_srcfiles"); });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Install macro/font docs"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"install_docfiles"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Toggle"),
+ -command => sub { toggle_setting("install_docfiles"); });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Default backup directory"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"backupdir"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub {
+ my $dir = $sw->chooseDirectory();
+ if (defined($dir) && ($defaults{"backupdir"} ne $dir)) {
+ # see warning concerning UTF8 or other encoded dir names!!
+ $changeddefaults{"backupdir"}{'value'} = $dir;
+ $changeddefaults{"backupdir"}{'display'} = $dir;
+ }
+ });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Auto backup setting"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"autobackup"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { select_autobackup($sw); }, -anchor => "w");
+
+ if (!win32()) {
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Link destination for programs"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"sys_bin"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub {
+ my $dir = $sw->chooseDirectory();
+ if (defined($dir) && ($defaults{"sys_bin"} ne $dir)) {
+ # see warning concerning UTF8 or other encoded dir names!!
+ $changeddefaults{"sys_bin"}{'value'} = $dir;
+ $changeddefaults{"sys_bin"}{'display'} = $dir;
+ }
+ });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Link destination for info docs"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"sys_info"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub {
+ my $dir = $sw->chooseDirectory();
+ if (defined($dir) && ($defaults{"sys_info"} ne $dir)) {
+ # see warning concerning UTF8 or other encoded dir names!!
+ $changeddefaults{"sys_info"}{'value'} = $dir;
+ $changeddefaults{"sys_info"}{'display'} = $dir;
+ }
+ });
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Link destination for man pages"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"sys_man"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub {
+ my $dir = $sw->chooseDirectory();
+ if (defined($dir) && ($defaults{"sys_man"} ne $dir)) {
+ # see warning concerning UTF8 or other encoded dir names!!
+ $changeddefaults{"sys_man"}{'value'} = $dir;
+ $changeddefaults{"sys_man"}{'display'} = $dir;
+ }
+ });
+ }
+
+ if (win32()) {
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Create shortcuts in menu and on desktop"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"desktop_integration"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Toggle"),
+ -command => sub { toggle_setting("desktop_integration"); });
+
+ if (admin()) {
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Install for all users"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{"w32_multi_user"}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Toggle"),
+ -command => sub { toggle_setting("w32_multi_user"); });
+ }
+
+ push @config_set_l,
+ $back_config_set->Label(-text => __("Change file associations"), -anchor => "w");
+ push @config_set_m,
+ $back_config_set->Label(-textvariable => \$changeddefaults{'file_assocs'}{'display'});
+ push @config_set_r,
+ $back_config_set->Button(-text => __("Change"),
+ -command => sub { select_file_assocs($sw); }, -anchor => "w");
+
+ }
+
+ for my $i (0..$#config_set_l) {
+ $config_set_l[$i]->grid( $config_set_m[$i], $config_set_r[$i],
+ -padx => "1m", -pady => "1m", -sticky => "nwe");
+ }
+
+ $back_config_buttons->pack(-padx => "10m", -pady => "5m");
+ $back_config_buttons->Button(-text => __("Apply changes"),
+ -state => $::action_button_state,
+ -command => sub { apply_settings_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+ $back_config_buttons->Button(-text => __("Cancel"),
+ -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+}
+
+sub apply_settings_changes {
+ for my $k (keys %defaults) {
+ if ($defaults{$k} ne $changeddefaults{$k}{'value'}) {
+ $localtlpdb->option($k, $changeddefaults{$k}{'value'});
+ }
+ }
+ $localtlpdb->save;
+}
+
+######## PAPER #########
+my %papers;
+my %currentpaper;
+my %changedpaper;
+
+sub init_paper_xdvi {
+ if (!win32()) {
+ @{$papers{"xdvi"}} = TeXLive::TLPaper::get_paper_list("xdvi");
+ $currentpaper{"xdvi"} = ${$papers{"xdvi"}}[0];
+ }
+}
+sub init_paper_pdftex {
+ @{$papers{"pdftex"}} = TeXLive::TLPaper::get_paper_list("pdftex");
+ $currentpaper{"pdftex"} = ${$papers{"pdftex"}}[0];
+}
+sub init_paper_dvips {
+ @{$papers{"dvips"}} = TeXLive::TLPaper::get_paper_list("dvips");
+ $currentpaper{"dvips"} = ${$papers{"dvips"}}[0];
+}
+sub init_paper_dvipdfm {
+ @{$papers{"dvipdfm"}} = TeXLive::TLPaper::get_paper_list("dvipdfm");
+ $currentpaper{"dvipdfm"} = ${$papers{"dvipdfm"}}[0];
+}
+sub init_paper_context {
+ if (defined($localtlpdb->get_package("bin-context"))) {
+ @{$papers{"context"}} = TeXLive::TLPaper::get_paper_list("context");
+ $currentpaper{"context"} = ${$papers{"context"}}[0];
+ }
+}
+sub init_paper_dvipdfmx {
+ @{$papers{"dvipdfmx"}} = TeXLive::TLPaper::get_paper_list("dvipdfmx");
+ $currentpaper{"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}}();
+ }
+}
+
+
+sub do_paper_settings {
+ init_all_papers();
+ my $sw = $mw->Toplevel(-title => __("Paper settings"));
+ $sw->transient($mw);
+ $sw->grab();
+
+ %changedpaper = %currentpaper;
+
+ my $lower = $sw->Frame;
+ $lower->pack(-fill => "both");
+
+ my $back_config_pap = $lower->Labelframe(-text => __("Paper settings"));
+ my $back_config_buttons = $sw->Frame();
+
+
+ my $back_config_pap_l1 = $back_config_pap->Label(-text => __("Default paper for all"), -anchor => "w");
+ my $back_config_pap_m1 = $back_config_pap->Button(-text => "A4",
+ -command => sub { change_paper("all", "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,
+ -padx => "2m", -pady => "2m", -sticky => "nswe");
+
+ my (%l,%m,%r);
+ foreach my $p (sort keys %papers) {
+ if (($p eq "context") && !defined($localtlpdb->get_package("bin-context"))) {
+ next;
+ }
+ $l{$p} = $back_config_pap->Label(-text => __("Default paper for") . " $p", -anchor => "w");
+ $m{$p} = $back_config_pap->Label(-textvariable => \$changedpaper{$p}, -anchor => "w");
+ $r{$p} = $back_config_pap->Button(-text => __("Change"),
+ -command => sub { select_paper($sw,$p); }, -anchor => "w");
+ $l{$p}->grid( $m{$p}, $r{$p},
+ -padx => "2m", -pady => "2m", -sticky => "nsw");
+}
+
+ $back_config_pap->pack(-side => 'left', -fill => "both", -padx => "2m", -pady => "2m");
+
+ $back_config_buttons->pack(-padx => "10m", -pady => "5m");
+ $back_config_buttons->Button(-text => __("Apply changes"),
+ -state => $::action_button_state,
+ -command => sub { apply_paper_changes(); $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+ $back_config_buttons->Button(-text => __("Cancel"),
+ -command => sub { $sw->destroy; })->pack(-side => 'left', -padx => "3m");
+}
+
+
+sub menu_default_location {
+ my $mw = shift;
+ my $val;
+ my $sw = $mw->Toplevel(-title => __("Change default package repository"));
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => __("New default package repository"))->pack(-padx => "2m", -pady => "2m");
+
+ my $f1 = $sw->Frame;
+ my $entry = $f1->Entry(-text => $val, -width => 50);
+ $entry->pack(-side => "left",-padx => "2m", -pady => "2m");
+
+ my $f2 = $sw->Frame;
+ $f2->Button(-text => __("Choose Directory"),
+ -command => sub {
+ my $var = $sw->chooseDirectory;
+ if (defined($var)) {
+ $entry->delete(0,"end");
+ $entry->insert(0,$var);
+ }
+ })->pack(-side => "left",-padx => "2m", -pady => "2m");
+ $f2->Button(-text => __("Default net package repository"),
+ -command => sub {
+ $entry->delete(0,"end");
+ $entry->insert(0,$TeXLiveURL);
+ })->pack(-side => "left",-padx => "2m", -pady => "2m");
+ $f1->pack;
+ $f2->pack;
+
+ my $f = $sw->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub { $changeddefaults{'location'}{'value'} =
+ $changeddefaults{'location'}{'display'} =
+ $entry->get;
+ $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 toggle_setting() {
+ my ($key) = @_;
+ my $old = $changeddefaults{$key}{'value'};
+ my $new = ($old ? 0 : 1);
+ $changeddefaults{$key}{'display'} = ($new ? __("Yes") : __("No"));
+ $changeddefaults{$key}{'value'} = $new;
+}
+
+
+sub apply_paper_changes {
+ $mw->Busy(-recurse => 1);
+ for my $k (keys %changedpaper) {
+ if ($currentpaper{$k} ne $changedpaper{$k}) {
+ execute_action_gui ( "paper", $k, "paper", $changedpaper{$k});
+ &{$init_paper_subs{$k}}();
+ }
+ }
+ $mw->Unbusy;
+}
+
+sub change_paper {
+ my ($prog, $pap) = @_;
+ if ($prog eq "all") {
+ for my $k (keys %changedpaper) {
+ $changedpaper{$k} = $pap;
+ }
+ } else {
+ $changedpaper{$prog} = $pap;
+ }
+}
+
+sub select_paper {
+ my $back_config = shift;
+ my $prog = shift;
+ my $foo = $back_config->Toplevel(-title => __("Select paper format for") . " $prog");
+ $foo->transient($back_config);
+ $foo->grab();
+ my $var = $changedpaper{$prog};
+ my $opt = $foo->BrowseEntry(-label => __("Default paper for") . " $prog", -variable => \$var);
+ foreach my $p (sort @{$papers{$prog}}) {
+ $opt->insert("end",$p);
+ }
+ $opt->pack(-padx => "2m", -pady => "2m");
+ my $f = $foo->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"), -command => sub { change_paper($prog,$var); $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ $f->pack;
+ $foo->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+}
+
+sub select_autobackup {
+ my $mw = shift;
+ my $foo = $mw->Toplevel(-title => __("Auto backup setting"));
+ $foo->transient($mw);
+ $foo->grab();
+ my $var = $defaults{"autobackup"};
+ my $opt = $foo->BrowseEntry(-label => __("Auto backup setting"),
+ -variable => \$var);
+ my @al;
+ push @al, "-1 (" . __("keep arbitrarily many") . ")";
+ push @al, "0 (" . __("disable") . ")";
+ for my $i (1..100) {
+ push @al, $i;
+ }
+ foreach my $p (@al) {
+ $opt->insert("end",$p);
+ }
+ $opt->pack(-padx => "2m", -pady => "2m");
+ my $f = $foo->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub {
+ $var =~ s/ .*$//;
+ $changeddefaults{"autobackup"}{'value'} = $var;
+ $changeddefaults{"autobackup"}{'display'} = $var;
+ $foo->destroy;
+ }
+ )->pack(-side => "left", -padx => "2m", -pady => "2m");
+ my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ $f->pack;
+ $foo->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+}
+
+
+sub select_file_assocs {
+ my $sw = shift;
+ my $foo = $sw->Toplevel(-title => __("Change file associations"));
+ $foo->transient($mw);
+ $foo->grab();
+ my $var = $defaults{"file_assocs"};
+ my $opt = $foo->BrowseEntry(-label => __("Change file associations"),
+ -variable => \$var);
+ my @al;
+ for my $i (0..2) {
+ push @al, "$i $fileassocdesc[$i]";
+ }
+ foreach my $p (@al) {
+ $opt->insert("end",$p);
+ }
+ $opt->pack(-padx => "2m", -pady => "2m");
+ my $f = $foo->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub {
+ $var = substr($var,0,1);
+ $changeddefaults{"file_assocs"}{'display'} = $fileassocdesc[$var];
+ $changeddefaults{"file_assocs"}{'value'} = $var;
+
+ $foo->destroy;
+ }
+ )->pack(-side => "left", -padx => "2m", -pady => "2m");
+ my $cancelbutton = $f->Button(-text => __("Cancel"), -command => sub { $foo->destroy; })->pack(-side => "left", -padx => "2m", -pady => "2m");
+ $f->pack;
+ $foo->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $foo->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+}
+
+
+
+################ END FUNCTIONS
+
+if ($opts{"load"}) {
+ run_update_functions();
+}
+
+
+info(__("Completed") . "\n");
+$mw->deiconify;
+
+
+if (!$::we_can_save) {
+ my $no_write_warn = $mw->Dialog(-title => "warning",
+ -text => __("You don't have permissions to change the installation in any way,\nspecifically, the directory %s is not writable.\nPlease run this program as administrator, or contact your local admin.\n\nMost buttons will be disabled.", "$Master/tlpkg/"),
+ -buttons => [ __("Ok") ])->Show();
+}
+
+Tk::MainLoop();
+
+
+sub init_install_media {
+ my $newroot = $location;
+ if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) {
+ # nothing to be done
+ } else {
+ $mw->Busy(-recurse => 1);
+ info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n");
+ $tlmediasrc = TeXLive::TLMedia->new($newroot);
+ info(__("Completed") . "\n");
+ $mw->Unbusy;
+ if (!defined($tlmediasrc)) {
+ # something went badly wrong, maybe the newroot is wrong?
+ $mw->Dialog(-title => "warning",
+ -text => __("Could not load the TeX Live Database from %s\nIf you want to install or update packages, please try with a different package repository!\n\nFor configuration and removal you don\'t have to do anything.", $newroot),
+ -buttons => [ __("Ok") ])->Show;
+ $tlmediatlpdb = undef;
+ $tlmediasrc = undef;
+ update_list_remote();
+ update_grid();
+ update_loaded_location_string("none");
+ } else {
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ update_list_remote();
+ update_grid();
+ }
+ }
+}
+
+sub set_text_win {
+ my ($w, $t) = @_;
+ $w->delete("0.0", "end");
+ $w->insert("0.0", "$t");
+ $w->see("0.0");
+}
+
+sub install_selected_packages {
+ my @foo = SelectedPackages();
+ if (@foo) {
+ my @args = qw/install/;
+ push @args, @foo;
+ 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(__("Installation"), @_) if $do_warn;
+ }
+}
+
+sub SelectedPackages {
+ my @ret;
+ # first select those that are
+ for my $p (keys %Packages) {
+ next if !$Packages{$p}{'selected'};
+ if ($action_apply_filter) {
+ if (MatchesFilters($p)) {
+ push @ret, $p;
+ }
+ } else {
+ push @ret, $p;
+ }
+ }
+ return @ret;
+}
+
+sub update_all_packages {
+ my @args = qw/update/;
+ if ($critical_updates_present) {
+ $opts{"self"} = 1;
+ } else {
+ $opts{"all"} = 1;
+ }
+ execute_action_gui(qw/update/);
+ if ($critical_updates_present) {
+ # terminate here immediately so that we are sure the auto-updater
+ # is run immediately
+ # make sure we exit in finish(0)
+ $::gui_mode = 0;
+ finish(0);
+ }
+ reinit_local_tlpdb();
+}
+
+sub update_selected_packages {
+ my @foo = SelectedPackages();
+ if (@foo) {
+ my @args = qw/update/;
+ # argument processing
+ # in case we have critical updates present we do put the list of
+ # critical updates into the argument instead of --all
+ if ($critical_updates_present) {
+ $opts{"self"} = 1;
+ }
+ push @args, @foo;
+ execute_action_gui(@args);
+ if ($critical_updates_present) {
+ # terminate here immediately so that we are sure the auto-updater
+ # is run immediately
+ # make sure we exit in finish(0)
+ $::gui_mode = 0;
+ finish(0);
+ }
+ reinit_local_tlpdb();
+ }
+}
+
+sub remove_selected_packages {
+ my @foo = SelectedPackages();
+ if (@foo) {
+ my @args = qw/remove/;
+ push @args, @foo;
+ 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 backup_selected_packages {
+ my @foo = SelectedPackages();
+ if (@foo) {
+ my @args = qw/backup/;
+ push @args, @foo;
+ execute_action_gui(@args);
+ }
+}
+
+sub reinit_local_tlpdb {
+ $mw->Busy(-recurse => 1);
+ $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+ die("cannot find tlpdb!") unless (defined($localtlpdb));
+ setup_list();
+ update_grid();
+ $mw->Unbusy;
+}
+
+#
+# creates/updates the list of packages as shown in tix grid
+#
+sub setup_list {
+ my @do_later;
+ for my $p ($localtlpdb->list_packages()) {
+ # collect packages containing a . for later
+ # we want to ignore them in most cases but those where there is
+ # no father package (without .)
+ if ($p =~ m;\.;) {
+ push @do_later, $p;
+ next;
+ }
+ my $tlp = $localtlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'localrevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'longdesc' } = $tlp->longdesc;
+ $Packages{$p}{'installed'} = 1;
+ $Packages{$p}{'selected'} = 0;
+ $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'});
+ if (($tlp->category eq "Collection") ||
+ ($tlp->category eq "Scheme")) {
+ $Packages{$p}{'category'} = $tlp->category;
+ } else {
+ $Packages{$p}{'category'} = "Other";
+ }
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ for my $p (@do_later) {
+ my $s = $p;
+ $s =~ s!\.[^.]*$!!;
+ if (!defined($Packages{$s})) {
+ my $tlp = $localtlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'localrevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'longdesc' } = $tlp->longdesc;
+ $Packages{$p}{'installed'} = 1;
+ $Packages{$p}{'selected'} = 0;
+ $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'});
+ if (($tlp->category eq "Collection") ||
+ ($tlp->category eq "Scheme")) {
+ $Packages{$p}{'category'} = $tlp->category;
+ } else {
+ $Packages{$p}{'category'} = "Other";
+ }
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ update_list_remote();
+}
+
+sub update_list_remote {
+ my @do_later_media;
+ print "TODO move the check from critical_updates_present from the old sub create_update_list here!!!";
+ # clear old info from remote media
+ for my $p (keys %Packages) {
+ if (!$Packages{$p}{'installed'}) {
+ delete $Packages{$p};
+ next;
+ }
+ delete $Packages{$p}{'remoterevision'};
+ delete $Packages{$p}{'remotecatalogueversion'};
+ }
+ if (defined($tlmediatlpdb)) {
+ for my $p ($tlmediatlpdb->list_packages()) {
+ if ($p =~ m;\.;) {
+ push @do_later_media, $p;
+ next;
+ }
+ my $tlp = $tlmediatlpdb->get_package($p);
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'remoterevision'} = $tlp->revision;
+ # overwrite, we assume that the remove version is better ;-)
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'longdesc' } = $tlp->longdesc;
+ $Packages{$p}{'selected'} = 0
+ unless defined $Packages{$p}{'selected'};
+ $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'})
+ unless defined $Packages{$p}{'cb'};
+ if (($tlp->category eq "Collection") ||
+ ($tlp->category eq "Scheme")) {
+ $Packages{$p}{'category'} = $tlp->category;
+ } else {
+ $Packages{$p}{'category'} = "Other";
+ }
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ for my $p (@do_later_media) {
+ my $s = $p;
+ $s =~ s!\.[^.]*$!!;
+ if (!defined($Packages{$s})) {
+ my $tlp = $tlmediatlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'remoterevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'longdesc' } = $tlp->longdesc;
+ $Packages{$p}{'selected'} = 0
+ unless defined $Packages{$p}{'selected'};
+ $Packages{$p}{'cb'} = $g->Checkbutton(-variable => \$Packages{$p}{'selected'})
+ unless defined $Packages{$p}{'cb'};
+ if (($tlp->category eq "Collection") ||
+ ($tlp->category eq "Scheme")) {
+ $Packages{$p}{'category'} = $tlp->category;
+ } else {
+ $Packages{$p}{'category'} = "Other";
+ }
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ # change display names
+ for my $p (keys %Packages) {
+ if ($p =~ m/^collection-documentation-(.*)$/) {
+ $Packages{$p}{'displayname'} = "collection-doc-$1";
+ }
+ }
+}
+
+
+sub menu_edit_location {
+ my $key = shift;
+ my $val;
+ my $sw = $mw->Toplevel(-title => __("Load package repository"));
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => __("Package repository:"))->pack(@p_ii);
+ my $entry = $sw->Entry(-text => $location, -width => 30);
+ $entry->pack();
+ my $f1 = $sw->Frame;
+ $f1->Button(-text => __("Choose Directory"),
+ -command => sub {
+ my $var = $sw->chooseDirectory;
+ if (defined($var)) {
+ $entry->delete(0,"end");
+ $entry->insert(0,$var);
+ }
+ })->pack(@left, @p_ii);
+ $f1->Button(-text => __("Default net package repository"),
+ -command => sub {
+ $entry->delete(0,"end");
+ $entry->insert(0,$TeXLiveURL);
+ })->pack(@left, @p_ii);
+ $f1->pack;
+ my $f = $sw->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub { $location = $entry->get;
+ $sw->destroy;
+ update_loaded_location_string();
+ run_update_functions();
+ })->pack(@left, @p_ii);
+ my $cancelbutton = $f->Button(-text => __("Cancel"),
+ -command => sub { $sw->destroy })->pack(@right, @p_ii);
+ $f->pack(-expand => 1);
+ $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+}
+
+sub update_loaded_location_string {
+ my $arg = shift;
+ $arg || ($arg = $location);
+ $menu->entryconfigure('end', -label => "Loaded repository: $arg");
+}
+
+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 {
+ $mw->Busy(-recurse => 1);
+ info ("Executing action @_\n");
+ execute_action(@_);
+ info(__("Completed") . "\n");
+ $mw->Unbusy;
+}
+
+sub give_warning_window {
+ my ($act, @args) = @_;
+ my $sw = $mw->DialogBox(-title => __("Warning Window"), -buttons => [ __("Ok") ]);
+ $sw->add("Label", -text => __("Running %s failed.\nPlease consult the log window for details.", "$act @args")
+ )->pack(@p_iii);
+ $sw->Show;
+}
+
+1;
+
+__END__
+
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #