diff options
Diffstat (limited to 'Master/texmf/scripts/texlive/tlmgr.pl')
-rwxr-xr-x | Master/texmf/scripts/texlive/tlmgr.pl | 196 |
1 files changed, 68 insertions, 128 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index 9afccb86c7c..fab861a322a 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -36,13 +36,13 @@ BEGIN { # make subprograms (including kpsewhich) have the right path: $mydir = $0; $mydir =~ s,/[^/]*$,,; - if (!$^O=~/^MSWin(32|64)$/i) { - $ENV{"PATH"} = "$mydir:$ENV{PATH}"; + my $kpsewhichname; + if (!$^O =~ /^MSWin/i) { + $ENV{"PATH"} = "$mydir;$ENV{PATH}"; $kpsewhichname = "kpsewhich.exe"; } else { $kpsewhichname = "kpsewhich"; } - # if (! -r "$mydir/$kpsewhichname") { # no kpsewhich in the same directory, so we are in a bootstrapping # mode, use for Master $mydir/../.. @@ -66,7 +66,6 @@ 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 @@ -80,6 +79,7 @@ binmode(STDERR, ":utf8"); our $tlmediasrc; # media from which we install/update our $tlmediatlpdb; our $location; # location from which the new packages come +our $localtlmedia; # local installation which we are munging our $localtlpdb; # local installation which we are munging my %options; # TL options from local tlpdb @@ -408,6 +408,21 @@ sub execute_action { + +sub do_cmd_and_check { + my $cmd = shift; + info("running $cmd ... "); + my ($out, $ret) = TeXLive::TLUtils::run_cmd("$cmd 2>&1"); + if ($ret == 0) { + info("done\n"); + log("Output of $cmd:\n$out\n"); + } else { + info("\n"); + tlwarn("$cmd failed (status $ret), output:\n$out\n"); + } + return $ret; +} + # run external programs (mktexlsr, updmap-sys, etc.) as specified by the # keys in the RET hash. We return the number of unsuccessful runs, zero # if all ok. @@ -420,8 +435,7 @@ sub handle_ret_hash { my $errors = 0; if (exists $ret{'mktexlsr'}) { - info("running mktexlsr\n"); - $errors += system("mktexlsr"); + $errors += do_cmd_and_check("mktexlsr"); } if (exists $ret{'map'}) { @@ -431,12 +445,9 @@ sub handle_ret_hash { # been the documented way to add fonts for many years. If we called # create_updmap, such user maps would be lost. foreach my $m (@{$ret{'map'}}) { - my $cmd = "updmap-sys --nomkmap --nohash --$m"; - info("running $cmd\n"); - $errors += system($cmd); + $errors += do_cmd_and_check("updmap-sys --nomkmap --nohash --$m"); } - info("running updmap-sys once more\n"); - $errors += system("updmap-sys"); # runs mktexlsr. + $errors += do_cmd_and_check("updmap-sys"); # runs mktexlsr. } chomp(my $TEXMFSYSVAR = `kpsewhich -var-value=TEXMFSYSVAR`); @@ -454,15 +465,13 @@ sub handle_ret_hash { "$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"); + $errors += do_cmd_and_check("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); + $errors += do_cmd_and_check("fmtutil-sys $a"); } if (exists $ret{'language'}) { @@ -483,95 +492,12 @@ sub handle_ret_hash { $lang = "$TEXMFSYSVAR/tex/generic/config/$lang"; } if ($localtlpdb->option_create_formats) { - info("running fmtutil-sys --byhyphen $lang\n"); - $errors += system("fmtutil-sys", "--byhyphen", $lang); + $errors += do_cmd_and_check("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.source.tlpobj") { - push @files, "tlpkg/tlpobj/$pkg.source.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; + return $errors; } @@ -686,7 +612,8 @@ sub action_remove { # the rest will not be run in dry_run mode $foo{'mktexlsr'} = 1; } else { - merge_into(\%foo, &remove_package($pkg, $localtlpdb)); + merge_into(\%foo, + $localtlmedia->remove_package($pkg)); logpackage("remove: $pkg"); } if (keys %foo) { @@ -709,7 +636,8 @@ sub action_remove { info ("remove $pkg\n"); if (!$opts{"dry-run"}) { my %foo; - merge_into(\%foo, &remove_package($pkg, $localtlpdb)); + merge_into(\%foo, + $localtlmedia->remove_package($pkg)); if (keys %foo) { # removal was successful logpackage("remove: $pkg"); @@ -913,8 +841,13 @@ sub action_search { $tlpdb = $localtlpdb; } foreach my $pkg ($tlpdb->list_packages) { + my $tlp = $tlpdb->get_package($pkg); if ($opts{"file"}) { - my @ret = grep(m;$r;, $tlpdb->get_package($pkg)->all_files); + my @files = $tlp->all_files; + if ($tlp->relocated) { + for (@files) { s:^$RelocPrefix/:$RelocTree/:; } + } + my @ret = grep(m;$r;, @files); if (@ret) { print "$pkg:\n"; foreach (@ret) { @@ -983,7 +916,7 @@ sub action_restore { closedir (DIR) || warn "closedir($opts{'backupdir'}) failed: $!"; for my $dirent (@dirents) { next if (-d $dirent); - next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.lzma$/); + next if ($dirent !~ m/^(.*)\.r([0-9]+)\.tar\.xz$/); $backups{$1}->{$2} = 1; } my ($pkg, $rev) = @ARGV; @@ -1016,14 +949,14 @@ sub action_restore { finish(0); } } - print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.lzma\n"; + print "Restoring $pkg, $rev from $opts{'backupdir'}/${pkg}.r${rev}.tar.xz\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); + merge_into(\%ret, $localtlmedia->remove_package($pkg)); + TeXLive::TLMedia->_install_package("$opts{'backupdir'}/${pkg}.r${rev}.tar.xz" , [] ,$localtlpdb); logpackage("restore: $pkg ($rev)"); # now we have to read the .tlpobj file and add it to the DB my $tlpobj = TeXLive::TLPOBJ->new; @@ -1132,9 +1065,9 @@ sub action_backup { } else { my $tlp = $localtlpdb->get_package($pkg); info("saving current status of $pkg to $opts{'backupdir'}/${pkg}.r" . - $tlp->revision . "tar.lzma\n"); + $tlp->revision . "tar.xz\n"); if (!$opts{"dry-run"}) { - $tlp->make_container("lzma", $localtlpdb->root, + $tlp->make_container("xz", $localtlpdb->root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); } } @@ -1191,22 +1124,22 @@ sub write_w32_updater { } foreach $pkg_part (@pkg_parts) { if ($media eq 'CD') { - copy("$repo/$pkg_part.tar.lzma", "$temp"); + copy("$repo/$pkg_part.tar.xz", "$temp"); } else { # net - TeXLive::TLUtils::download_file("$repo/$pkg_part.tar.lzma", "$temp/$pkg_part.tar.lzma"); + TeXLive::TLUtils::download_file("$repo/$pkg_part.tar.xz", "$temp/$pkg_part.tar.xz"); } # now we should have the file present - if (!-r "$temp/$pkg_part.tar.lzma") { - tlwarn("Couldn't get $pkg_part.tar.lzma, that is bad\n"); + if (!-r "$temp/$pkg_part.tar.xz") { + tlwarn("Couldn't get $pkg_part.tar.xz, that is bad\n"); return 1; # abort } - # unpack lzma archive - $sysret = system("$::progs{'lzmadec'} < \"$temp/$pkg_part.tar.lzma\" > \"$temp/$pkg_part.tar\""); + # unpack xz archive + $sysret = system("$::progs{'xzdec'} < \"$temp/$pkg_part.tar.xz\" > \"$temp/$pkg_part.tar\""); if ($sysret) { - tlwarn("Couldn't unpack $pkg_part.tar.lzma\n"); + tlwarn("Couldn't unpack $pkg_part.tar.xz\n"); return 1; # unpack failed? abort } - unlink("$temp/$pkg_part.tar.lzma"); # we don't need that archive anymore + unlink("$temp/$pkg_part.tar.xz"); # we don't need that archive anymore push @updater_args, $pkg_part, $oldrev, $newrev; } } @@ -1577,7 +1510,7 @@ sub action_update { } } if (!($opts{"dry-run"} or $opts{"list"} or $opts{"no-remove"})) { - merge_into(\%ret, &remove_package($p, $localtlpdb)); + merge_into(\%ret, $localtlmedia->remove_package($p)); logpackage("remove: $p"); } } @@ -1635,10 +1568,10 @@ sub action_update { } if ($opts{"backup"} && !$opts{"dry-run"}) { - $tlp->make_container("lzma", $root, + $tlp->make_container("xz", $root, $opts{"backupdir"}, "${pkg}.r" . $tlp->revision); $unwind_package = - "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.lzma"; + "$opts{'backupdir'}/${pkg}.r" . $tlp->revision . ".tar.xz"; if ($autobackup) { # in case we do auto backups we remove older backups @@ -1680,7 +1613,7 @@ sub action_update { # # the remove_package should also remove empty dirs in case # a dir is changed into a file - merge_into(\%ret, &remove_package($pkg, $localtlpdb)); + merge_into(\%ret, $localtlmedia->remove_package($pkg)); my $foo = $tlmediasrc->install_package($pkg, $localtlpdb); if (ref $foo) { # installation succeeded because we got a reference @@ -2313,7 +2246,7 @@ sub action_recreate_tlpdb { my $tlpdb = TeXLive::TLPDB->new; $tlpdb->root($Master); my $inst = TeXLive::TLPOBJ->new; - $inst->name("00texlive-installation.config"); + $inst->name("00texlive.installation"); $inst->category("TLCore"); my @deps; push @deps, "location:$TeXLive::TLConfig::TeXLiveURL"; @@ -2422,7 +2355,11 @@ sub check_files { # ignore files in the installer next if ($p eq "00texlive.installer"); my $tlp = $localtlpdb->get_package($p); - for my $f ($tlp->all_files) { + my @files = $tlp->all_files; + if ($tlp->relocated) { + for (@files) { s:^$RelocPrefix/:$RelocTree/:; } + } + for my $f (@files) { push @{$filetopacks{$f}}, $p; } } @@ -2554,10 +2491,13 @@ sub init_local_db { # if the localtlpdb is already defined do simply return here already # to make sure that the settings in the local tlpdb do not overwrite # stuff changed via the GUI + return if defined $localtlmedia; return if defined $localtlpdb; - $localtlpdb = TeXLive::TLPDB->new ("root" => $Master); + $localtlmedia = TeXLive::TLMedia->new ( $Master ); + die("cannot setup TLMedia in $Master") unless (defined($localtlmedia)); + $localtlpdb = $localtlmedia->tlpdb; die("cannot find tlpdb in $Master") unless (defined($localtlpdb)); - # setup the programs, for w32 we need the shipped wget/lzma etc, so we + # setup the programs, for w32 we need the shipped wget/xz etc, so we # pass the location of these files to setup_programs. if (!setup_programs("$Master/tlpkg/installer", $localtlpdb->option_platform)) { @@ -2668,14 +2608,14 @@ sub clear_old_backups my @backups; for my $dirent (@dirents) { next if (-d $dirent); - next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.lzma$/); + next if ($dirent !~ m/^$pkg\.r([0-9]+)\.tar\.xz$/); 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; + info ("Removing backup $backupdir/$pkg.r$e.tar.xz\n"); + unlink("$backupdir/$pkg.r$e.tar.xz") unless $dryrun; } $i++; } |