#!/usr/bin/env perl # $Id$ # # Copyright 2008, 2009 Norbert Preining # This file is licensed under the GNU General Public License version 2 # or any later version. # # TODO: # - in GUI mode updating bin-texlive/texlive.infra DOES work without # the warning, but it does NOT force to restart the GUI. THAT IS BAD!!! # # - when tlmgr2.pl is shipped globally as tlmgr.pl we can switch the # installer from using either texconfig paper or texlua ... to # tlmgr paper letter which will work on all platforms transparently. # # - tlmgr should have a "progress" bar for the update --all and install # etc options, echoing number of total packages etc etc. # my $svnrev = '$Revision$'; my $datrev = '$Date$'; my $tlmgrrevision; if ($svnrev =~ m/: ([0-9]+) /) { $tlmgrrevision = $1; } else { $tlmgrrevision = "unknown"; } $datrev =~ s/^.*Date: //; $datrev =~ s/ \(.*$//; $tlmgrrevision .= " ($datrev)"; our $Master; BEGIN { $^W = 1; # make subprograms (including kpsewhich) have the right path: ($mydir = $0) =~ s,/[^/]*$,,; $ENV{"PATH"} = "$mydir:$ENV{PATH}"; # chomp($Master = `kpsewhich -var-value=SELFAUTOPARENT`); # # make Perl find our packages first: unshift (@INC, "$Master/tlpkg"); unshift (@INC, "$Master/texmf/scripts/texlive"); } use Cwd qw/abs_path/; use Pod::Usage; use Getopt::Long qw(:config no_autoabbrev permute); use strict; use TeXLive::TLConfig; use TeXLive::TLMedia; use TeXLive::TLPDB; use TeXLive::TLPOBJ; use TeXLive::TLPostActions; use TeXLive::TLUtils; use TeXLive::TLWinGoo; TeXLive::TLUtils->import(qw(member info give_ctan_mirror win32 dirname mkdirhier merge_into copy log debug)); use TeXLive::TLPaper; binmode(STDOUT, ":utf8"); binmode(STDERR, ":utf8"); our $tlmediasrc; # media from which we install/update our $tlmediatlpdb; our $location; # location from which the new packages come our $localtlpdb; # local installation which we are munging my %options; # TL options from local tlpdb # flags for machine readable form our $FLAG_REMOVE = "d"; our $FLAG_FORCIBLE_REMOVED = "f"; our $FLAG_UPDATE = "u"; our $FLAG_REVERSED_UPDATE = "r"; our $FLAG_AUTOINSTALL = "a"; # option variables $::gui_mode = 0; $::machinereadable = 0; my %globaloptions = ( "location" => "=s", "gui" => 1, "gui-lang" => "=s", "package-logfiles" => "=s", "machine-readable" => 1, "version" => 1, "pause" => 1, "help|h|?" => 1); my %actionoptions = ( "remove" => { "no-depends" => 1, "no-depends-at-all" => 1, "force" => 1, "dry-run|n" => 1 }, "show" => { "list" => 1 }, "search" => { "global" => 1, "file" => 1 }, "restore" => { "backupdir" => "=s", "dry-run|n" => 1, "force" => 1 }, "backup" => { "backupdir" => "=s", "clean" => ":-99", "all" => 1, "dry-run|n" => 1 }, "update" => { "no-depends" => 1, "no-depends-at-all" => 1, "all" => 1, "list" => 1, "no-remove" => 1, "force" => 1, "backupdir" => "=s", "backup" => 1, "dry-run|n" => 1 }, "paper" => { "list" => 1 }, "install" => { "no-depends" => 1, "no-depends-at-all" => 1, "reinstall" => 1, "force" => 1, "dry-run|n" => 1 }, "arch" => { "dry-run|n" => 1 }, "generate" => { "localcfg" => "=s", "dest" => "=s" }, "uninstall"=> { "force" => 1 }, "check" => { "use-svn" => 1 } ); my %optarg; for my $k (keys %globaloptions) { if ($globaloptions{$k} eq "1") { $optarg{$k} = 1; } else { $optarg{"$k" . $globaloptions{$k}} = 1; } } for my $v (values %actionoptions) { for my $k (keys %$v) { if ($v->{$k} eq "1") { $optarg{$k} = 1; } else { $optarg{"$k" . $v->{$k}} = 1; } } } TeXLive::TLUtils::process_logging_options(); our %opts; GetOptions(\%opts, keys(%optarg)) or pod2usage(2); $::machinereadable = $opts{"machine-readable"} if (defined($opts{"machine-readable"})); my $action = shift; if (!defined($action)) { $action = $opts{"gui"} ? "gui" : ""; } ddebug("action = $action\n"); for my $k (keys %opts) { ddebug("$k => $opts{$k}\n"); } ddebug("arguments: @ARGV\n") if @ARGV; sub give_version { if (!defined($::version_string)) { $::version_string = ""; $::version_string .= "tlmgr revision $tlmgrrevision\n"; $::version_string .= "tlmgr using installation: $Master\n"; if (open (REL_TL, "$Master/release-texlive.txt")) { # print first and last lines, which have the TL version info. my @rel_tl = ; $::version_string .= $rel_tl[0]; $::version_string .= $rel_tl[$#rel_tl]; close (REL_TL); } } return $::version_string; } if ($opts{"version"} || (defined $action && $action eq "version")) { info(give_version()); finish(0); } if (defined($action) && ($action =~ m/^help/i)) { $opts{"help"} = 1; } if ((!defined($action) || !$action) && !$opts{"help"}) { die "$0: missing action; try --help if you need it.\n"; } if ($opts{"help"}) { # perldoc does ASCII emphasis on the output, so it's nice to use it. # But not all Unix platforms have it, and on Windows our Config.pm # can apparently interfere, so always skip it there. my @noperldoc = (); if (win32() || ! TeXLive::TLUtils::which("perldoc")) { @noperldoc = ("-noperldoc", "1"); } pod2usage("-exitstatus" => 0, "-verbose" => 2, @noperldoc); } # unify arguments so that the $action contains paper in all cases # and push the first arg back to @ARGV for action_paper processing if ($action =~ /^(paper|xdvi|pdftex|dvips|dvipdfmx?|context)$/) { unshift(@ARGV, $action); $action = "paper"; } # check on supported arguments # my %suppargs; %suppargs = %{$actionoptions{$action}} if defined($actionoptions{$action}); my @notvalidargs; for my $k (keys %opts) { my $kk = $k; if ($k eq "n" || $k eq "dry-run") { $kk = "dry-run|n"; } if (!defined($suppargs{$kk}) && !defined($globaloptions{$kk})) { push @notvalidargs, $k; } } if (@notvalidargs) { my $msg = "The following arguments are not supported for the action $action:\n"; for my $c (@notvalidargs) { $msg .= " $c"; } $msg .= "\n"; # here we should call pod2usage actually with the argument # -verbose => 99 # -sections => "ACTIONS/$action.*" # to show the correct invocation of the action my @noperldoc = (); if (win32() || ! TeXLive::TLUtils::which("perldoc")) { @noperldoc = ("-noperldoc", "1"); } pod2usage(-msg => $msg, -exitstatus => 1, -verbose => 1, @noperldoc); } # besides doing normal logging if -logfile is specified, we try to log # package related actions (install, remove, update) to # the package-log file TEXMFSYSVAR/web2c/tlmgr.log my $packagelogged = 0; # how many msgs we logged chomp (my $texmfsysvar = `kpsewhich -var-value=TEXMFSYSVAR`); my $packagelogfile = $opts{"package-logfile"}; $packagelogfile ||= "$texmfsysvar/web2c/tlmgr.log"; # # 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 "; execute_action($action, @ARGV); # end of main program. sub execute_action { my ($action, @argv) = @_; my %ret; # we have to set @ARGV to the @argv since many of the action_* subs # use GetOption @ARGV = @argv; # actions which shouldn't have any lasting effects, such as search or # list, end by calling finish(0), which skips postinstall actions. if ($action =~ m/^_include_tlpobj$/) { # this is an internal function that should not be used outside init_local_db(); for my $f (@ARGV) { my $tlpobj = TeXLive::TLPOBJ->new; $tlpobj->from_file($f); # we now have to check whether that is a .doc or .src package, so shipping # src or doc files from a different package. # We should have that package already installed ... my $pkg = $tlpobj->name; if ($pkg =~ m/^(.*)\.(src|doc)$/) { # got a .src or .doc package my $type = $2; my $mothership = $1; my $mothertlp = $localtlpdb->get_package($mothership); if (!defined($mothertlp)) { tlwarn("We are trying to add ${type}files to a not existing package $mothership!\n"); tlwarn("Trying to continue!\n"); # the best we can do is rename that package to $mothername and add it! $tlpobj->name($mothership); # add the src/docfiles tlpobj under the mothership name $localtlpdb->add_tlpobj($tlpobj); } else { 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/^get-mirror$/i) { my $loc = give_ctan_mirror(); print "$loc\n"; finish(0); } elsif ($action =~ m/^generate$/i) { merge_into(\%ret, action_generate()); } elsif ($action =~ m/^gui$/i) { action_gui(); } elsif ($action =~ m/^arch$/i) { merge_into(\%ret, action_arch()); } elsif ($action =~ m/^option$/i) { merge_into(\%ret, action_option()); finish(0); } elsif ($action =~ m/^list$/i) { merge_into(\%ret, action_list()); finish(0); } elsif ($action =~ m/^check$/i) { merge_into(\%ret, action_check()); } elsif ($action =~ m/^install$/i) { merge_into(\%ret, action_install()); } elsif ($action =~ m/^update$/i) { merge_into(\%ret, action_update()); } elsif ($action =~ m/^backup$/i) { merge_into(\%ret, action_backup()); } elsif ($action =~ m/^restore$/i) { merge_into(\%ret, action_restore()); } elsif ($action =~ m/^symlinks$/i) { merge_into(\%ret, action_symlinks()); finish(0); } elsif ($action =~ m/^search$/i) { merge_into(\%ret, action_search()); finish(0); } elsif ($action =~ m/^show$/i) { merge_into(\%ret, action_show()); finish(0); } elsif ($action =~ m/^remove$/i) { merge_into(\%ret, action_remove()); } elsif ($action =~ /^paper$/) { merge_into(\%ret, action_paper()); } elsif ($action =~ m/^uninstall$/i) { merge_into(\%ret, action_uninstall()); finish(0); } else { die "$0: unknown action: $action; try --help if you need it.\n"; } # close the special log file if ($packagelogfile && !$::gui_mode) { info("tlmgr: package log updated at $packagelogfile\n") if $packagelogged; close(PACKAGELOG); } # run external programs. my $error_count = &handle_ret_hash(%ret); # done, just in case there are 256 errors. finish($error_count ? 1 : 0); } # run external programs (mktexlsr, updmap-sys, etc.) as specified by the # keys in the RET hash. We return the number of unsuccessful runs, zero # if all ok. # sub handle_ret_hash { my (%ret) = @_; my $errors = 0; if (exists $ret{'mktexlsr'}) { info("running mktexlsr\n"); $errors += system("mktexlsr"); } if (exists $ret{'map'}) { foreach my $m (@{$ret{'map'}}) { info("$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`); # format means create missing formats (because a new one was added). # format-regenerate is used when the paper size changes. In that # case, if option_create_formats is set, we simply want to generate # all formats; if not, then we only want to refresh existing ones. # my $opt_fmt = $localtlpdb->option_create_formats; if (exists $ret{'format'}) { info("regenerating fmtutil.cnf in $TEXMFSYSVAR\n"); TeXLive::TLUtils::create_fmtutil($localtlpdb, "$TEXMFSYSVAR/web2c/fmtutil.cnf", "$TEXMFLOCAL/web2c/fmtutil-local.cnf"); if ($opt_fmt && !$ret{'format-regenerate'}) { info("running fmtutil-sys --missing\n"); $errors += system("fmtutil-sys", "--missing"); } } # if (exists $ret{'format-regenerate'}) { my $a = $opt_fmt ? "--all" : "--refresh"; info("running fmtutil-sys $a to regenerate formats\n"); $errors += system("fmtutil-sys", $a); } if (exists $ret{'language'}) { for my $ext ("dat", "def") { my $lang = "language.$ext"; info("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"; } if ($localtlpdb->option_create_formats) { info("running fmtutil-sys --byhyphen $lang\n"); $errors += system("fmtutil-sys", "--byhyphen", $lang); } } } return $errors / 256; # we were accumulating wait statuses } # # remove_package removes a single package with all files (including the # tlpobj files) and the entry from the tlpdb. # 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 ($opts{"gui"}) { action_gui("remove"); } tlwarn("machine-readable output not supported for remove\n") if $::machinereadble; # 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; $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my %already_removed; my @more_removal; init_local_db(); info("remove: dry run, no changes will be made\n") if $opts{"dry-run"}; 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 $opts{"no-depends-at-all"} @packs = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @packs) unless $opts{"no-depends-at-all"}; # remove deps unless $opts{"no-depends"} @packs = $localtlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; my %allpacks; for my $p ($localtlpdb->list_packages) { $allpacks{$p} = 1; } for my $p (@packs) { delete($allpacks{$p}); } my @neededpacks = $localtlpdb->expand_dependencies($localtlpdb, keys %allpacks); my %packs; my %origpacks; my @origpacks = $localtlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; for my $p (@origpacks) { $origpacks{$p} = 1; } for my $p (@packs) { $packs{$p} = 1; } for my $p (@neededpacks) { if (defined($origpacks{$p})) { # that package was asked for to be removed on the cmd line my @needed = $localtlpdb->needed_by($p); if ($opts{"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)) { info("$pkg: package not present, cannot remove\n"); } else { # in the first round we only remove collections, nothing else # but removing collections will remove all dependencies, too # 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 ($opts{"dry-run"}) { # we need to set $foo to something positive otherwise # the rest will not be run in dry_run mode $foo{'mktexlsr'} = 1; } 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 (!$opts{"dry-run"}) { 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 ($opts{"dry-run"}) { # stop here, don't do any postinstall actions return; } else { $localtlpdb->save; my @foo = sort keys %already_removed; if (@foo) { info("tlmgr: actually removed these packages: @foo\n"); } else { info("tlmgr: no packages removed.\n"); } return(\%ret); } } # PAPER # ARGV can look like: # paper a4 # paper letter # [xdvi|dvips|pdftex|dvipdfm|dvipdfmx|context] paper [help|papersize|--list] # sub action_paper { my %ret; action_gui("config") if $opts{"gui"}; tlwarn("machine-readable output not supported for paper\n") if $::machinereadble; init_local_db(); chomp(my $texmfsysconfig = `kpsewhich -var-value=TEXMFSYSCONFIG`); $ENV{"TEXMFCONFIG"} = $texmfsysconfig; my $action = shift @ARGV; if ($action =~ m/^paper$/i) { my $newpaper = shift @ARGV; if (!defined($newpaper) || $newpaper !~ /^(a4|letter)$/) { $newpaper = "the empty string." if !defined($newpaper); tlwarn("tlmgr: paper expects `a4' or `letter', not $newpaper.\n"); return; } merge_into(\%ret, TeXLive::TLPaper::paper_all($texmfsysconfig, $newpaper)); } else { my $prog = $action; # first argument is the program to change my $arg = shift @ARGV; # get "paper" argument if (!defined($arg) || $arg ne "paper") { $arg = "the empty string." if ! $arg; tlwarn("tlmgr: expected `paper' after $prog, not $arg\n"); return; } # the do_paper progs check for the arguments --list, so if given # put it back on the cmd line unshift(@ARGV, "--list") if $opts{"list"}; merge_into(\%ret, TeXLive::TLPaper::do_paper($prog,$texmfsysconfig,@ARGV)); } return \%ret; } # SHOW # sub action_show { if ($opts{"gui"}) { action_gui("config"); } tlwarn("machine-readable output not supported for show\n") if $::machinereadble; 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 ($opts{"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; } # SYMLINKS # sub action_symlinks { my %ret; tlwarn("machine-readable output not supported for search\n") if $::machinereadble; my $what = shift @ARGV; if (!defined($what) || ($what !~ m/^(add|remove)$/i)) { tlwarn("action symlinks needs one argument, either add or remove\n"); return; } init_local_db(); if ($what =~ m/^add$/i) { $localtlpdb->add_symlinks(); } elsif ($what =~ m/^remove$/i) { # remove symlinks $localtlpdb->remove_symlinks(); } else { # that should not happen tlwarn("that should not happen, action_symlinks what=$what\n"); exit 1; } return; } # SEARCH # sub action_search { my %ret; tlwarn("machine-readable output not supported for search\n") if $::machinereadble; my $r = shift @ARGV; my $ret = ""; my $tlpdb; init_local_db(); if ($opts{"global"}) { init_tlmedia(); $tlpdb = $tlmediasrc->tlpdb; } else { $tlpdb = $localtlpdb; } foreach my $pkg ($tlpdb->list_packages) { if ($opts{"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 tlwarn("machine-readable output not supported for restore\n") if $::machinereadble; my %ret; # check the backup dir argument if ($opts{"backupdir"}) { my $ob = abs_path($opts{"backupdir"}); $ob && ($opts{"backupdir"} = $ob); if (! -d $opts{"backupdir"}) { tlwarn ("backupdir argument $opts{'backupdir'} is not a directory.\n"); tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } } else { # no argument, check for presence in TLPDB $opts{"backupdir"} = $localtlpdb->option("backupdir"); if (!$opts{"backupdir"}) { tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } # we are stil here, there is something set in tlpdb my $ob = abs_path($opts{"backupdir"}); $ob && ($opts{"backupdir"} = $ob); if (! -d $opts{"backupdir"}) { tlwarn ("backupdir as set in tlpdb $opts{'backupdir'} is not a directory.\n"); tlwarn ("Don't know from where to restore backups, terminating.\n"); exit 1; } } info("restore: dry run, no changes will be made\n") if $opts{"dry"}; # initialize the hash(packages) of hash(revisions) my %backups; opendir (DIR, $opts{"backupdir"}) || die "opendir($opts{'backupdir'}) failed: $!"; my @dirents = readdir (DIR); closedir (DIR) || warn "closedir($opts{'backupdir'}) failed: $!"; for my $dirent (@dirents) { next if (-d $dirent); next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.lzma$/); $backups{$1}->{$2} = 1; } my ($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 $opts{'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 (!$opts{"force"}) { print "Do you really want to restore $pkg to revision $rev (y/N): "; my $yesno = ; if ($yesno !~ m/^y(es)?$/i) { print "Ok, cancelling the restore!\n"; finish(0); } } print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.lzma\n"; if (!$opts{"dry"}) { init_local_db(1); # first remove the package, then reinstall it # this way we get rid of useless files $opts{"backupdir"} = abs_path($opts{"backupdir"}); merge_into(\%ret, &remove_package($pkg, $localtlpdb)); TeXLive::TLMedia->_install_package("$opts{'backupdir'}/${pkg}.r${rev}.tar.lzma" , [] ,$localtlpdb); logpackage("restore: $pkg ($rev)"); # now we have to read the .tlpobj file and add it to the DB my $tlpobj = TeXLive::TLPOBJ->new; $tlpobj->from_file($localtlpdb->root . "/tlpkg/tlpobj/$pkg.tlpobj"); $localtlpdb->add_tlpobj($tlpobj); merge_into(\%ret, $localtlpdb->get_package($pkg)->make_return_hash_from_executes("enable")); $localtlpdb->save; } } else { print "revision $rev for $pkg is not present in $opts{'backupdir'}\n"; } return \%ret; } sub action_backup { tlwarn("machine-readable output not supported for backup\n") if $::machinereadble; init_local_db(1); # --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. # We have set clean to clean:-99 which makes -99 the default value # if only --clean is given without any argument # !defined($opts{"clean"}) -> no --clean given # $opts{"clean"} = -99 -> --clean without argument given, check tlpdb # $opts{"clean"} = -1, 0, N -> --clean=N given, check argument # my $clean_mode = 0; $clean_mode = 1 if defined($opts{"clean"}); if ($clean_mode) { if ($opts{"clean"} == -99) { # we need to check the tlpdb $opts{"clean"} = $localtlpdb->option("autobackup"); if (!$opts{"clean"}) { tlwarn ("--clean given without an argument, but no default clean\n"); tlwarn ("mode specified in the tlpdb, terminating.\n"); exit 1; } } # now $opts{"clean"} is something, but maybe not a number, check for # validity if ($opts{"clean"} =~ m/^(-1|[0-9]+)$/) { # get rid of leading zeros etc etc $opts{"clean"} = $opts{"clean"} + 0; } else { tlwarn ("clean mode as specified on the command line or as given by default\n"); tlwarn ("must be an integer larger or equal than -1, terminating.\n"); exit 1; } } # check the backup dir argument if ($opts{"backupdir"}) { my $ob = abs_path($opts{"backupdir"}); $ob && ($opts{"backupdir"} = $ob); if (! -d $opts{"backupdir"}) { tlwarn ("backupdir argument $opts{'backupdir'} is not a directory.\n"); if ($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 $opts{"backupdir"} = $localtlpdb->option("backupdir"); if (!$opts{"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($opts{"backupdir"}); $ob && ($opts{"backupdir"} = $ob); if (! -d $opts{"backupdir"}) { tlwarn ("backupdir as set in tlpdb $opts{'backupdir'} is not a directory.\n"); if ($clean_mode) { tlwarn ("Cannot clean a non existing directory, terminating.\n"); } else { tlwarn ("Don't know where to save backups, terminating.\n"); } exit 1; } } my %ret; my @todo; if ($opts{"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, $opts{"backupdir"}, $opts{"clean"}, $opts{"dry-run"}); } else { my $tlp = $localtlpdb->get_package($pkg); info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" . $tlp->revision . "tar.lzma\n"); if (!$opts{"dry-run"}) { $tlp->make_container("lzma", $localtlpdb->root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); } } } return(\%ret); } $::updater_started = 0; # sub grow_w32_updater { my ($tlp, $dry) = @_; my $pkg = $tlp->name; # that could be more intelligent for decent $dry output my $root = $localtlpdb->root; my $temp = "$root/temp"; return if $dry; if (!$::updater_started) { $::updater_started = 1; $::updater_string = <<'EOF'; rem update program, can savely removed after it has been done cd /d %~dp0 rem now we are in .../tlpkg/installer rem create tar.exe backup copy tar.exe tarsave.exe cd ..\.. rem now we are in the root EOF ; } sub do_one {# moved down to 'preserve' the flow of the batch script upon reading my $pkg = shift; $::updater_string .= " 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 temp\\$pkg.tar "; } # 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 write_w32_updater { if ($::updater_started) { $::updater_string .= <<'EOF'; del tlpkg\installer\tarsave.exe rmdir temp EOF ; open UPDATER, ">" . $localtlpdb->root . "/tlpkg/installer/updater.bat" or die "Cannot create updater.bat: $!"; # print STDOUT $::updater_string; print UPDATER $::updater_string; close UPDATER; tlwarn("UPDATER script has been created:\n"); tlwarn(" " . $localtlpdb->root . "\\tlpkg\\installer\\updater.bat\n"); } } # 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 INSTALLS ONLY ONE PACKAGE, no deps whatsoever # anymore. That has all to be done by hand. # sub machine_line { my ($flag1) = @_; my $ret = 0; if ($flag1 eq "-ret") { $ret = 1; shift; } my ($pkg, $flag, $lrev, $rrev, @args) = @_; $lrev ||= "-"; $rrev ||= "-"; $flag ||= "?"; my $str = "$pkg\t$flag\t$lrev\t$rrev\t" . join("\t", @args) . "\n"; return($str) if $ret; print $str; } sub action_update { if ($opts{"gui"}) { action_gui("update"); } init_local_db(1); # initialize the TLMedia from $location $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my %ret; init_tlmedia(); my $mediatlpdb = $tlmediasrc->tlpdb; info("update: dry run, no changes will be made\n") if $opts{"dry-run"}; # if the update is not for one of the critical packages then do # check for updates to tlmgr and die unless either --force or --list # is given my $other_updates_asked_for = 0; if ($opts{"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 ($opts{"force"}) { tlwarn("$0: Continuing due to --force.\n"); } elsif ($opts{"list"}) { # do not warn here } else { if ($::gui_mode) { # return here and don't do any updates return; } else { die "$0: Exiting, please read above warning.\n"; } } } } # do backup dir checking now so that we don't run into troubles # later, and exit if that doesn't work if ($opts{"backupdir"}) { $opts{"backupdir"} = abs_path($opts{"backupdir"}); if (! -d $opts{"backupdir"}) { 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 (!$opts{"backup"}) { $autobackup = $localtlpdb->option("autobackup"); if ($autobackup) { # check the format, we currently allow only natural numbers, and -1 if ($autobackup eq "-1") { debug ("Automatic backups activated, keeping \\infty backups.\n"); $opts{"backup"} = 1; } elsif ($autobackup eq "0") { debug ("Automatic backups disabled.\n"); } elsif ($autobackup =~ m/^[0-9]+$/) { debug ("Automatic backups activated, keeping $autobackup backups.\n"); $opts{"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 ($opts{"backup"}) { my $diebackupdir = 0; if (!$opts{"backupdir"}) { $opts{"backupdir"} = $localtlpdb->option("backupdir"); if ($opts{"backupdir"}) { # check again: $opts{"backupdir"} = abs_path($opts{"backupdir"}); $diebackupdir = 1 if (! -d $opts{"backupdir"}); } else { # not set in the tlpdb, and not set on cmd line, but asked for # --backup $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 $opts{"backup"} = 1 if $opts{"backupdir"}; debug("Doing backups to $opts{'backupdir'}\n") if $opts{"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 $opts{"dry-run"}; } 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 ($opts{"all"} || $opts{"list"}) { @todo = $localtlpdb->list_packages; } else { @todo = @ARGV; } # don't do anything if we have been invoced in a strange way if (!@todo) { tlwarn("tlmgr update: please specify a list of packages or --all.\n"); } # update all .ARCH dependencies, too, unless $opts{"no-depends-at-all"}: @todo = $mediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @todo) unless $opts{"no-depends-at-all"}; # # update general deps unless $opts{"no-depends"}: @todo = $mediatlpdb->expand_dependencies("-no-collections",$localtlpdb,@todo) unless $opts{"no-depends"}; # # we first collect the list of packages to be actually updated or installed my @updated; my @new; my @addlines; 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) { if ($::machinereadable) { # TODO should we add a revision number push @addlines, machine_line("-ret", $pkg, $FLAG_FORCIBLE_REMOVED, "-", "-", "-"); } else { info("skipping forcibly removed package $pkg\n"); } next; } elsif ($newpkg_coll) { # do nothing here, it will be reported below. } elsif (defined($removals{$pkg})) { # skipping this package, it has been removed due to server removal # and has already been removed next; } else { tlwarn("\ntlmgr: $pkg mentioned, neither new nor forcibly removed\n"); 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; push @new, $pkg; next; } my $rev = $tlp->revision; my $mediatlp = $mediatlpdb->get_package($pkg); if (!defined($mediatlp)) { debug("$pkg cannot be found in $location\n"); next; } my $mediarev = $mediatlp->revision; if ($rev < $mediarev) { push @updated, $pkg; } elsif ($rev > $mediarev) { if ($::machinereadable) { push @addlines, machine_line("-ret", $pkg, $FLAG_REVERSED_UPDATE, $rev, $mediarev, "-"); } else { info("$pkg: local revision ($rev) is newer than revision in $location" . " ($mediarev), not updating.\n"); } } } for my $i (sort @new) { debug("$i new package\n"); } for my $i (sort @updated) { debug("$i upd package\n"); } # number calculation my $totalnr = $#new + $#updated + 2; my $nrupdated = 0; my $currnr = 1; # sizes_of_packages returns the sizes of *all* packages if nothing # is passed over, so if @new and @updated both are empty we will # get something wrong back, namely the total size of all packages my %sizes; if ($totalnr > 0) { %sizes = %{$mediatlpdb->sizes_of_packages( $localtlpdb->option_install_srcfiles, $localtlpdb->option_install_docfiles, @new, @updated )}; } else { $sizes{'__TOTAL__'} = 0; } print "total-bytes\t$sizes{'__TOTAL__'}\n" if $::machinereadable; print "end-of-header\n" if $::machinereadable; # print out deferred machine readable lines after the header for (@addlines) { print; } # # we have to remove all the stuff before we install other packages # to support moving of files from one package to another. # remove the packages that have disappeared: for my $p (keys %removals) { if ($opts{"no-remove"}) { info("not removing $p due to -no-remove (removed on server)\n"); } else { if ($::machinereadable) { # TODO version numbers machine_line($p, $FLAG_REMOVE, "-", "-", "-"); } else { info("remove $p (removed on server)\n"); } } if (!($opts{"dry-run"} or $opts{"list"} or $opts{"no-remove"})) { merge_into(\%ret, &remove_package($p, $localtlpdb)); logpackage("remove: $p"); } } # install all the new packages first for my $pkg (sort @new) { # install new packages my $mediatlp = $mediatlpdb->get_package($pkg); if (!defined($mediatlp)) { tlwarn("\nShould not happen: $pkg not found in $location\n"); next; } my $mediarev = $mediatlp->revision; if ($::machinereadable) { machine_line($pkg, $FLAG_AUTOINSTALL, "-", $mediatlp->revision, $sizes{$pkg}); } else { info("[$currnr/$totalnr] auto-install: $pkg\n"); } $currnr++; next if ($opts{"dry-run"} || $opts{"list"}); my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); if (ref $foo) { # installation succeeded because we got a reference merge_into (\%ret, $foo); logpackage("auto-install new: $pkg ($mediarev)"); $nrupdated++; } else { tlwarn("$0: couldn't install new package $pkg\n"); } } # foreach my $pkg (sort @updated) { next if ($pkg =~ m/^00texlive/); my $tlp = $localtlpdb->get_package($pkg); # we checked already that this package is present! my $unwind_package; my $remove_unwind_container = 0; my $rev = $tlp->revision; my $mediatlp = $mediatlpdb->get_package($pkg); if (!defined($mediatlp)) { debug("$pkg cannot be found in $location\n"); next; } my $mediarev = $mediatlp->revision; $nrupdated++; if ($opts{"list"}) { if ($::machinereadable) { machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}); } else { info("$pkg: local: $rev, source: $mediarev\n"); } } else { if ($opts{"backup"} && !$opts{"dry-run"}) { $tlp->make_container("lzma", $root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); $unwind_package = "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.lzma"; if ($autobackup) { # in case we do auto backups we remove older backups clear_old_backups($pkg, $opts{"backupdir"}, $autobackup); } } if (win32() && ($pkg =~ m/$WinSpecialUpdatePackagesRegexp/)) { grow_w32_updater($mediatlp, $opts{"dry-run"}); } else { if ($::machinereadable) { machine_line($pkg, $FLAG_UPDATE, $rev, $mediarev, $sizes{$pkg}); } else { info("[$currnr/$totalnr] update: $pkg ($rev -> $mediarev)"); } $currnr++; if ($opts{"dry-run"}) { info("\n") unless $::machinereadable; next; } else { info(" ... ") unless $::machinereadable; # more to come } if (!$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") unless $::machinereadable; } } } # that already checks whether we actually have to do something write_w32_updater(); if (($nrupdated == 0) && ($tlmediasrc->media ne "NET") && $opts{"all"}) { # for all but net updates we warn if nothing is updated tlwarn("\nNothing to update.\n"); tlwarn("\nYour installation is set up to look on the disk for updates.\n"); 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 ($opts{"gui"}) { action_gui("install"); } tlwarn("machine-readable output not supported for install\n") if $::machinereadble; init_local_db(1); # initialize the TLMedia from $location $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; my %ret; init_tlmedia(); my $tlmediatlpdb = $tlmediasrc->tlpdb; # check for updates to tlmgr itself, and die unless --force is given if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) { if ($opts{"force"}) { tlwarn("Continuing due to --force\n"); } else { if ($::gui_mode) { # return here and don't do any updates return; } else { die "tlmgr: Not continuing, please see warning above!\n"; } } } $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; info("install: dry run, no changes will be made\n") if $opts{"dry-run"}; my @packs = @ARGV; # first expand the .ARCH dependencies unless $opts{"no-depends-at-all"} @packs = $tlmediatlpdb->expand_dependencies("-only-arch", $localtlpdb, @ARGV) unless $opts{"no-depends-at-all"}; # now expand all others unless $opts{"no-depends"} # if $opts{"reinstall"} do not collection->collection dependencies if ($opts{"reinstall"}) { @packs = $tlmediatlpdb->expand_dependencies("-no-collections", $localtlpdb, @packs) unless $opts{"no-depends"}; } else { @packs = $tlmediatlpdb->expand_dependencies($localtlpdb, @packs) unless $opts{"no-depends"}; } foreach my $pkg (sort @packs) { my $re = ""; if (defined($localtlpdb->get_package($pkg))) { if ($opts{"reinstall"}) { $re = "re"; } else { debug("already installed: $pkg\n"); next; } } info("${re}install: $pkg\n"); if (!$opts{"dry-run"}) { merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb)); logpackage("${re}install: $pkg"); } } if ($opts{"dry-run"}) { # stop here, don't do any postinstall actions return(0); } return(\%ret); } sub action_list { tlwarn("machine-readable output not supported for list\n") if $::machinereadble; 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 ($opts{"gui"}) { action_gui("config"); } tlwarn("machine-readable output not supported for option\n") if $::machinereadble; my $what = shift @ARGV; $what = "show" unless defined($what); init_local_db(); if ($what =~ m/^show$/i) { print "Default installation location (location): ", $localtlpdb->option_location, "\n"; print "Create formats on installation (formats): ", ($localtlpdb->option_create_formats ? "yes" : "no"), "\n"; print "Install documentation files (docfiles): ", ($localtlpdb->option_install_docfiles ? "yes": "no"), "\n"; print "Install source files (srcfiles): ", ($localtlpdb->option_install_srcfiles ? "yes": "no"), "\n"; print "Destination for symlinks for binaries (sys_bin): ", $localtlpdb->option_sys_bin, "\n" if $localtlpdb->option_sys_bin; print "Destination for symlinks for man pages (sys_man): ", $localtlpdb->option_sys_man, "\n" if $localtlpdb->option_sys_man; print "Destination for symlinks for info docs (sys_info): ", $localtlpdb->option_sys_info, "\n" if $localtlpdb->option_sys_info; print "Directory for backups (backupdir): ", $localtlpdb->option("backupdir"), "\n" if $localtlpdb->option("backupdir"); print "Number of backups to keep (autobackup): ", $localtlpdb->option("autobackup"), "\n" if $localtlpdb->option("autobackup"); } elsif ($what =~ m/^location$/i) { # 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/^sys_man$/i) { # changes the default sys_man my $loc = shift @ARGV; if (defined($loc)) { info ( "Setting default destination for symlinks to man pages to $loc\n"); $localtlpdb->option_sys_man ($loc); $localtlpdb->save; } else { print "Default destination for symlinks to man pages: ", $localtlpdb->option_sys_man, "\n"; } } elsif ($what =~ m/^sys_info$/i) { # changes the default sys_info my $loc = shift @ARGV; if (defined($loc)) { info ( "Setting default destination for symlinks to info pages to $loc\n"); $localtlpdb->option_sys_info ($loc); $localtlpdb->save; } else { print "Default destination for symlinks to info pages: ", $localtlpdb->option_sys_info, "\n"; } } elsif ($what =~ m/^sys_bin$/i) { # changes the default sys_bin my $loc = shift @ARGV; if (defined($loc)) { info ( "Setting default destination for symlinks to binaries to $loc\n"); $localtlpdb->option_sys_bin ($loc); $localtlpdb->save; } else { print "Default destination for symlinks to binaries: ", $localtlpdb->option_sys_bin, "\n"; } } elsif (member($what, @AllowedConfigOptions)) { # for all further options not handled till now we check that they # appear in the list of allowed options and if they do, we set/read # the values, otherwise we warn my $val = shift @ARGV; if (defined($val)) { print "Setting option $what to $val.\n"; $localtlpdb->option($what,$val); $localtlpdb->save; } else { print "Option $what = ", $localtlpdb->option($what), "\n";; } } else { tlwarn "Option $what is currently not supported.\n"; } return; } # ARCH # sub action_arch { if ($^O=~/^MSWin(32|64)$/i) { warn("action `arch' not supported on Windows\n"); } if ($opts{"gui"}) { action_gui("arch"); } tlwarn("machine-readable output not supported for arch\n") if $::machinereadble; my %ret; my $what = shift @ARGV; init_local_db(1); info("arch: dry run, no changes will be made\n") if $opts{"dry-run"}; $what || ($what = "list"); if ($what =~ m/^list$/i) { # list the available architectures # 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 ($opts{"dry-run"}) { info("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); } # GENERATE # sub action_generate { my $dest = defined($opts{"dest"}) ? $opts{"dest"} : ""; my $localconf = defined($opts{"localcfg"}) ? $opts{"localcfg"} : ""; my $what = shift @ARGV; tlwarn("machine-readable output not supported for generate\n") if $::machinereadble; init_local_db(); # we create fmtutil.cnf, language.dat, language.def in TEXMFSYSVAR # and updmap.cfg in TEXMFSYSCONFIG. The reason is that calls to # updmap-sys (as is done by the tlmgr update call when packages with # maps are installed) will create the updmap.cfg file in TEXMFSYSCONFIG # from the version in TEXMFSYSVAR. But after that the TEXMFSYSCONFIG # takes precedence and the mechanism explained in updmap.cfg header # does not work. # chomp (my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`); chomp (my $TEXMFSYSCONFIG = `kpsewhich -var-value=TEXMFSYSCONFIG`); 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 ||= "$TEXMFSYSCONFIG/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; } # GUI # sub action_gui { my ($guiscreen) = @_; # yes, two times to make perl warnings shut up ... $::guiscreen = $guiscreen; $::guiscreen = $guiscreen; unshift (@INC, "$Master/texmf/scripts/texlive/tlmgrgui"); eval { require Tk; }; if ($@) { # that didn't work out, give some usefull error message and stop my $tkmissing = 0; if ($@ =~ /^Can\'t locate Tk\.pm/) { $tkmissing = 1; } if ($tkmissing) { if ($^O=~/^MSWin(32|64)$/i) { # that should not happen, we are shipping Tk!! require Win32; my $msg = "Cannot load Tk, that should not happen as we ship it!\nHow did you start tlmgrgui??\n(Error message: $@)\n"; Win32::MsgBox($msg, 1|Win32::MB_ICONSTOP(), "Warning"); } else { printf STDERR " Cannot load Tk, thus the GUI cannot be started! The Perl/Tk module is not shipped with the TeX Live installation. You have to install it to get tlmgr GUI running. See http://tug.org/texlive/distro.html for more details. "; } } else { printf STDERR "Problem loading Tk: $@\n"; } exit 1; } # now check that we can actually create a top level window, # on darwin the X server might not be started, or on unix we are working # on a console, or whatever. eval { my $foo = Tk::MainWindow->new; $foo->destroy; }; if ($@) { printf STDERR "perl/Tk unusable, cannot create main windows. That could be a consequence of not having X Windows installed or started! Error message from creating MainWindow: $@ "; exit 1; } # be sure that sub actions do *not* finish $::gui_mode = 1; # also unset the $opts{"gui"} to make recursive calls to action_* not starting # another GUI instance (or better trying to ...) $opts{"gui"} = 0; require("tlmgrgui2.pl"); # should not be reached exit(1); } # UNINSTALL # sub action_uninstall { if (win32()) { printf STDERR "Please use \"Add/Remove Programs\" from the Control Panel to removing TeX Live!\n"; finish(1); } if ($opts{"gui"}) { action_gui("uninstall"); } my $force = defined($opts{"force"}) ? $opts{"force"} : 0; if (!$force) { print("If you answer yes here the whole TeX Live installation will be removed!\n"); print "Remove TeX Live (y/N): "; my $yesno = ; if ($yesno !~ m/^y(es)?$/i) { print "Ok, cancelling the removal!\n"; finish(0); } } print ("Ok, removing the whole installation:\n"); init_local_db(); $localtlpdb->remove_symlinks; # now do remove the rest system("rm", "-rf", "$Master/texmf-dist"); system("rm", "-rf", "$Master/texmf-doc"); system("rm", "-rf", "$Master/texmf-var"); system("rm", "-rf", "$Master/texmf"); system("rm", "-rf", "$Master/tlpkg"); system("rm", "-rf", "$Master/bin"); system("rm", "-rf", "$Master/readme-html.dir"); system("rm", "-rf", "$Master/readme-txt.dir"); for my $f (qw/doc.html index.html LICENSE.CTAN LICENSE.TL README README.usergroups release-texlive.txt texmf.cnf/) { system("rm", "-f", "$Master/$f"); } if (-d "$Master/temp") { system("rmdir", "--ignore-fail-on-non-empty", "$Master/temp"); } unlink("$Master/install-tl.log"); # should we do that???? system("rm", "-rf", "$Master/texmf-config"); system("rmdir", "--ignore-fail-on-non-empty", "$Master"); } # CHECK # sub action_check { my $svn = defined($opts{"use-svn"}) ? $opts{"use-svn"} : 0; 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/libexec 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"; } # Subroutines galore. # # set global $location variable. # if we cannot read tlpdb, die if arg SHOULD_I_DIE is true. # sub init_local_db { my ($should_i_die) = @_; $localtlpdb = TeXLive::TLPDB->new ("root" => $Master); die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); # setup the programs, for w32 we need the shipped wget/lzma etc, so we # pass the location of these files to setup_programs. my $ret = setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform); if ($ret == -1) { tlwarn("no binary of lzmadec for $::_platform_ detected.\n"); if (defined($should_i_die) && $should_i_die) { exit 1; } else { tlwarn("Continuing anyway ...\n"); } } if (!$ret) { tlwarn("Couldn't set up the necessary programs.\nInstallation of packages is not supported.\nPlease report to texlive\@tug.org.\n"); if (defined($should_i_die) && $should_i_die) { finish(1); } else { tlwarn("Continuing anyway ...\n"); } } # let cmd line options override the settings in localtlpdb my $loc = $localtlpdb->option_location; if (defined($loc)) { $location = $loc; } if (defined($opts{"location"})) { $location = $opts{"location"}; } if (!defined($location)) { die("No installation source found, nor in the texlive.tlpdb nor on the cmd line.\nPlease specify one!"); } if ($location =~ m/^ctan$/i) { $location = "$TeXLive::TLConfig::TeXLiveURL"; } # we normalize the path only if it is # - neither a URL starting with http or ftp # - if we are on windows it does not start with Drive: if (! ( $location =~ m!^(http|ftp)://!i || (win32() && $location =~ m!^.:!) ) ) { # seems to be a local path, try to normalize it my $testloc = abs_path($location); # however, if we were given a url, that will get "normalized" to the # empty string, it not being a path. Restore the original value if so. $location = $testloc if $testloc; } } # initialize the global $tlmediasrc object, or die. # uses the global $location. # sub init_tlmedia { if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { # nothing to be done } else { if ($location =~ m/^($TeXLiveServerURL|ctan$)/) { $location = give_ctan_mirror(); } # that "location-url" line should not be changed since GUI programs # depend on it. In case of $::machinereadable all the info # output is also going to STDERR. print "location-url\t$location\n" if $::machinereadable; info("tlmgr: installation location $location\n"); # $tlmediasrc is a global variable $tlmediasrc = TeXLive::TLMedia->new($location); $tlmediatlpdb = $tlmediasrc->tlpdb; die($loadmediasrcerror . $location) unless defined($tlmediasrc); } } # finish # evaluates only the -pause option, and then exits # if the global $::gui_mode is set to 1 then the not exit, but return is called # sub finish { my ($ret) = @_; if ($ret > 0) { print "tlmgr: exiting unsuccessfully (status $ret).\n"; } if ($opts{"pause"}) { print "Press Enter to exit the program.\n"; ; } if ($::gui_mode) { return($ret); } else { exit($ret); } } # if the packagelog variable is set then write to PACKAGELOG filehandle # sub logpackage { if ($packagelogfile) { $packagelogged++; my $tim = localtime(); print PACKAGELOG "[$tim] @_\n"; } } # clear the backup dir for $pkg and keep only $autobackup packages # mind that with $autobackup == 0 all packages are cleared sub clear_old_backups { my ($pkg, $backupdir, $autobackup, $dry) = @_; my $dryrun = 0; $dryrun = 1 if ($dry); # keep arbitrary many backups return if ($autobackup == -1); opendir (DIR, $backupdir) || die "opendir($backupdir) failed: $!"; my @dirents = readdir (DIR); closedir (DIR) || warn "closedir($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 $backupdir/$pkg.r$e.tar.lzma\n"); unlink("$backupdir/$pkg.r$e.tar.lzma") unless $dryrun; } $i++; } } # check for updates to tlcritical packages # sub check_for_critical_updates { 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 packages 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