From b385e98d1fc6dc8ba8b322bb11f176b5b0b201c5 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 3 Apr 2008 12:25:36 +0000 Subject: add uninstall-tl.pl micro version git-svn-id: svn://tug.org/texlive/trunk@7292 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf/scripts/texlive/uninstall-tl.pl | 152 +++++++++++++++++++++++++++ 1 file changed, 152 insertions(+) create mode 100755 Master/texmf/scripts/texlive/uninstall-tl.pl diff --git a/Master/texmf/scripts/texlive/uninstall-tl.pl b/Master/texmf/scripts/texlive/uninstall-tl.pl new file mode 100755 index 00000000000..9eab203e38c --- /dev/null +++ b/Master/texmf/scripts/texlive/uninstall-tl.pl @@ -0,0 +1,152 @@ +#!/usr/bin/env perl + +# $Id: uninstall-tl.pl 6381 2008-01-23 17:50:54Z preining $ +# uninstall-tl.pl +# +# Copyright 2008 Norbert Preining, Siep Kroonenberg +# This file is licensed under the GNU General Public License version 2 +# or any later version. +# + + +my $Master; + +BEGIN { + $^W = 1; + $Master = `kpsewhich -var-value=SELFAUTOPARENT`; + chomp($Master); + unshift (@INC, "$Master/tlpkg"); +} + + +use TeXLive::TLWinGoo; +use TeXLive::TLPDB; +use Cwd qw/abs_path/; +use strict; + +&main (); + +sub win32 +{ + return ($^O=~/^MSWin(32|64)$/i ? 1 : 0); +} + +sub main +{ + # get the db. + my $tlpdb = TeXLive::TLPDB->new ("root" => "$Master"); + 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_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 { + warn("Cannot find tlpdb in $Master!\n"); + } + # we have to + # - (win32) remove the entry of bin/arch from the PATH environment + # - (unix) remove the links if opt_symlinks + # - (win32) remove the .texlua association + # - (win32) remove the entry of PATHEXT + # - (unix) ... the links + if (win32()) { + remove_texbindirs_from_path(); + unregister_script_type(".texlua"); + broadcast_env(); + update_assocs(); + } else { + # 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"; + } + } + } +} + + +__END__ + + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # -- cgit v1.2.3