diff options
author | Norbert Preining <preining@logic.at> | 2011-05-09 22:56:11 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2011-05-09 22:56:11 +0000 |
commit | 18af170a779e1ab19ed1ee433007cebb22ef6349 (patch) | |
tree | 475efa993981459a7d016e8615f6a15454c814f6 /Master/tlpkg/dev | |
parent | 6e1df2e361a83766f6360f4dfd8325ce3efa6426 (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/dev')
-rw-r--r-- | Master/tlpkg/dev/TLDownload.pm.complicated_way | 366 | ||||
-rw-r--r-- | Master/tlpkg/dev/tlmgr1.pl-with-recreate-tlpdb | 3038 | ||||
-rw-r--r-- | Master/tlpkg/dev/tlmgrgui2-withtabs.pl | 1532 |
3 files changed, 0 insertions, 4936 deletions
diff --git a/Master/tlpkg/dev/TLDownload.pm.complicated_way b/Master/tlpkg/dev/TLDownload.pm.complicated_way deleted file mode 100644 index 409f707af96..00000000000 --- a/Master/tlpkg/dev/TLDownload.pm.complicated_way +++ /dev/null @@ -1,366 +0,0 @@ -# $Id: TLDownload.pm -1 $ -# TeXLive::TLDownload.pm - module for abstracting the download modes -# Copyright 2009 Norbert Preining -# -# This file is licensed under the GNU General Public License version 2 -# or any later version. -# -# TODO: -# - retrials for opening the connections are now implemented (see -# $RETRIES and $SLEEP_BETWEEN_RETRIES) -# retrials for getting files are not implemented (and I am not sure -# if it makes sense) -# - re-opening of a dropped connection, detection of dropped connection? -# in ftp mode we check that we can send the pwd command before getting -# a file. If this does not succeed we try to reopen the connection -# In http mode I don't know. -# - timeout for ftp: default is AFAIR 120sec, that is probably not enough -# for a normal user to select all options and go press/enter "i"nstall -# either extend timeout or care for reopening of closed connections -# See above, for ftp that should be fixed by automatic reopening. -# - - -package TeXLive::TLDownload; - -use TeXLive::TLUtils; -use File::Temp qw/tempfile/; - -my $svnrev = '$Revision: -1 $'; -my $_modulerevision; -if ($svnrev =~ m/: ([0-9]+) /) { - $_modulerevision = $1; -} else { - $_modulerevision = "unknown"; -} -sub module_revision { - return $_modulerevision; -} - - -my $CONNECT_RETRIES = 5; -my $SLEEP_BETWEEN_CONNECT_RETRIES = 2; # (in seconds) -my $GET_RETRIES = 5; -my $SLEEP_BETWEEN_GET_RETRIES = 10; # (in seconds) - - -# since Net::HTTP and Net::FTP are shipped by the same packages -# we only test for Net::HTTP, if that fails, let us know ;-) -our $net_lib_avail = 0; -eval { require Net::HTTP; }; -if ($@) { - debug("Net::HTTP is not available, falling back to wget mode.\n"); - $net_lib_avail = 0; -} else { - require Net::HTTP; - require Net::FTP; - require HTTP::Status; - $net_lib_avail = 1; - debug("Net::HTTP available!\n"); -} - - -sub new -{ - my $class = shift; - my %params = @_; - my $self = { - server => $params{'server'}, - mode => defined($params{'mode'}) ? $params{'mode'} : "wget", - }; - if ($self->{'mode'} eq "http" || - $self->{'mode'} eq "ftp") { - die "Net::HTTP and Net::FTP is not available, cannot use http/ftp mode." - if (!$net_lib_avail); - } elsif ($self->{'mode'} eq "wget") { - # noting to be done - } else { - die "Unknown download mode: ", $self->{'mode'}; - } - bless $self, $class; - return $self; -} - - - -sub start_connection -{ - my $self = shift; - if ($self->mode eq "wget") { - debug("TLDownload::start_connection: no need to call start_connection in wget mode\n"); - return 1; - } - if (!defined($self->server)) { - die "TLDownload::start_connection: No server defined, cannot start connection."; - } - if (($self->mode eq "http") || ($self->mode eq "ftp")) { - my $handle; - for my $tries (1..$CONNECT_RETRIES) { - if ($self->mode eq "http") { - $handle = Net::HTTP->new(Host => $self->server, KeepAlive => 1); - } else { - $handle = Net::FTP->new($self->server, Debug => 0); - } - if ($handle) { - debug("TLDownload::start_connection: succeeded.\n"); - last; # of $tries - } - sleep($SLEEP_BETWEEN_CONNECT_RETRIES); - } - # if still not have a handle give up - if (!$handle) { - tlwarn("TLDownload::start_connection: Could not connect to server " . $self->server . " ($CONNECT_RETRIES trials), giving up.\n"); - return 0; - } - if ($self->mode eq "ftp") { - # special ftp stuff - if (!$handle->login("anonymous",'-texlive@')) { - tlwarn("TLDownload::start_connection: Cannot login to server: " . $handle->message . "\n"); - return 0; - } - if (!$handle->binary) { - tlwarn("TLDownload::start_connection: Cannot set transfer mode to binary: " . $handle->message . "\n"); - return 0; - } - } - # again for both http and ftp - # now we got a handle, save it simply into $self for later reuse - $self->{'handle'} = $handle; - return 1; - } - # we are still here, that cannot be - return 0; -} - - - -sub get_file -{ - my ($self, $url, $out, $size) = @_; - # - # first split the $url into components. we might get a full url - # or some relative path - my $protocol; - my $server; - my $path; - if ($url =~ m!^(http|ftp)://([^/]*)(/.*)$!i) { - $protocol = lc($1); - $server = lc($2); - $path = $3; - } elsif ($url =~ m!^/.*$!) { - $path = $url; - } else { - tlwarn("TLDownload::get_file: do not understand that url: $url\n"); - return 0; - } - # - # wget case - # simple fall back to TLUtils::_download_file - # - if ($self->mode eq "wget") { - if (!defined($protocol)) { - tlwarn("TLDownload::get_file: cannot download relative url $url in wget mode.\n"); - return 0; - } - my $wget; - if (defined($::progs{'wget'})) { - $wget = $progs->{'wget'}; - } else { - tlwarn ("TLDownload::get_file: programs not set up, trying literal wget\n"); - $wget = "wget"; - } - return TeXLive::TLUtils::_download_file($url, $out, $wget); - } - # - # check for incompatible server names or protocols - # - if (defined($protocol) && ($protocol ne $self->mode)) { - tlwarn("TLDownload::get_file: protocols mismatch, url uses $protocol, server " . $self->mode . ".\n"); - return 0; - } - if (defined($server) && ($server ne lc($self->server))) { - tlwarn("TLDownload::get_file: server mismatch, url uses $server, but current download server is " . $self->server . ".\n"); - return 0; - } - # - # for both http and ftp we want to support the destination "|" which - # should return a file handle. - my $realout = $out; - if ($out eq "|") { - my $outfh = tempfile(); - $realout = $outfh; - } - # - # ftp mode - # - if ($self->mode eq "ftp") { - # test if handle is alive: - if (defined($self->{'handle'})) { - if (!$handle->pwd) { - # connection droped, time-out or similar ... - # delete the handle so that the following code restarts the - # connection - delete($self->{'handle'}); - } - } - if (!defined($self->{'handle'})) { - if (!$self->start_connection) { - # warnings are already issued by start_connection - # which also does retrials - return; - } - } - # now we should have a $handle - my $handle = $self->{'handle'}; - my $got_it = 0; - for my $tries (1..$GET_RETRIES) { - if ($handle->get($path, $realout)) { - $got_it = 1; - last; - } - sleep($SLEEP_BETWEEN_GET_RETRIES); - } - if (!$got_it) { - tlwarn("TLDownload::get_file: Could not get $path:\n"); - tlwarn($handle->message . "\n"); - tlwarn("($GET_RETRIES trials), giving up.\n"); - return; - } - return 1; - } - # - # http mode - # - if ($self->mode eq "http") { - if (!defined($self->{'handle'})) { - if (!$self->start_connection) { - # start_connection already warns ... - return 0; - } - } - # now we should have a $handle - my $handle = $self->{'handle'}; - my $got_it = 0; - for my $tries (1..$GET_RETRIES) { - if ($handle->write_request(GET => $path, 'User-Agent' => 'texlive (net::http)')) { - $got_it = 1; - last; - } - sleep($SLEEP_BETWEEN_GET_RETRIES); - } - if (!$got_it) { - tlwarn("TLDownload::get_file: Could not send GET request.\n"); - tlwarn("($GET_RETRIES trials), giving up.\n"); - return; - } - my ($code, $msg, %h) = $handle->read_response_headers; - if (HTTP::Status::is_error($code)) { - tlwarn("Problem downloading from server ($code): $msg\n"); - return; - } - my $buffer = ""; - my $bytes_read = 0; - while (1) { - my $buf; - my $n = $handle->read_entity_body($buf, (defined($size) ? $size : 4096)); - if (!defined($n)) { - tlwarn("TLDownload::get_file: Cannot read file from server: $!\n"); - return 0; - } - last unless $n; - dddebug("- http read got $n bytes\n"); - $bytes_read += $n; - $buffer .= $buf; - } - if (defined($size) && ($bytes_read != $size)) { - tlwarn("TLDownload::get_file: didn't get $size bytes, expect breakage\n"); - } - my $outhandle; - if ($out ne "|") { - if (!open (OUT, ">$out")) { - tlwarn("TLDownload::get_file: cannot open $out for writing: $!\n"); - return 0; - } - $outhandle = \*OUT; - } else { - $outhandle = $realout; - } - binmode($outhandle); - print $outhandle $buffer; - if ($out ne "|") { - if (!close(OUT)) { - tlwarn("TLDownload::get_file: strange, cannot close file handle ...\n"); - } - return 1; - } else { - # seek to beginning of file - seek $outhandle, 0, 0; - return $outhandle; - } - } - # - # we are still here, strange - # - tlwarn("TLDownload::get_file: still around, strange, mode = " . $self->mode . "\n"); - return 0; -} - - - -sub mode -{ - my $self = shift; - if (@_) { $self->{'mode'} = shift } - return $self->{'mode'}; -} -sub server -{ - my $self = shift; - if (@_) { $self->{'server'} = shift } - return $self->{'server'}; -} - -1; -__END__ - - -=head1 NAME - -C<TeXLive::TLDownload> -- TeX Live Download abstraction module - -=head1 SYNOPSIS - - use TeXLive::TLDownload; - - $TeXLive::TLDownload::net_lib_avail - my $dl = TeXLive::TLDownload->new(server => "www.foo.com", mode => "http"); - my $dl = TeXLive::TLDownload->new(server => "www.foo.com", mode => "ftp"); - my $dl = TeXLive::TLDownload->new(server => "http://www.foo.com", mode => "wget"); - $dl->start_connection; - $dl->get_file($relpath, $output [, $expected_size ]); - -=head1 DESCRIPTION - -The C<TeXLive::TLDownload> module handles TeX Live Download abstractions -to make it possible to use persistent network connections instead of -calling wget for each single file. It depends on the modules Net::HTTP -and Net::FTP, and will check for these at loading time. If they are -not present only "wget" mode will be available. - -=head1 SEE ALSO - - -=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 - -### Local Variables: -### perl-indent-level: 2 -### tab-width: 2 -### indent-tabs-mode: nil -### End: -# vim:set tabstop=2 expandtab: # diff --git a/Master/tlpkg/dev/tlmgr1.pl-with-recreate-tlpdb b/Master/tlpkg/dev/tlmgr1.pl-with-recreate-tlpdb deleted file mode 100644 index 261de5a4e71..00000000000 --- a/Master/tlpkg/dev/tlmgr1.pl-with-recreate-tlpdb +++ /dev/null @@ -1,3038 +0,0 @@ -#!/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/dev/tlmgrgui2-withtabs.pl b/Master/tlpkg/dev/tlmgrgui2-withtabs.pl deleted file mode 100644 index 1e683d8f255..00000000000 --- a/Master/tlpkg/dev/tlmgrgui2-withtabs.pl +++ /dev/null @@ -1,1532 +0,0 @@ -#!/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: # |