uninstaller work

git-svn-id: svn://tug.org/texlive/trunk@6982 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 146 insertions, 8 deletions

diff --git a/Master/install-tl.pl b/Master/install-tl.pl
index 72d7fe42dcf..8197dce0237 100755
--- a/Master/install-tl.pl
+++ b/Master/install-tl.pl
@@ -362,6 +362,8 @@ sub do_installation {
     &$h();
   }
   do_postinst_stuff();
+  save_options_into_tlpdb();
+  $localtlpdb->save;
   foreach my $h (@::end_install_hook) {
     &$h();
   }
@@ -707,6 +709,40 @@ sub do_install_packages {
   install_packages($tlpdb,$localtlpdb,\@what,\@netarchs,$vars{'option_src'},$vars{'option_doc'});
 }
 
+# for later complete removal we want to save some options and values
+# into the local tlpdb:
+# - should links be set, and if yes, the destination (bin,man,info)
+sub save_options_into_tlpdb {
+  my $tlp = new TeXLive::TLPOBJ;
+  $tlp->name("00texlive-installation.config");
+  $tlp->category("TLCore");
+  my @deps;
+  if ($vars{'option_letter'}) {
+    push @deps, "option_letter";
+  }
+  if ($vars{'option_fmt'}) {
+    push @deps, "option_fmt";
+  }
+  if ($vars{'option_symlinks'}) {
+    push @deps, "option_symlinks";
+    push @deps, "sys_bin/$vars{'sys_bin'}";
+    push @deps, "sys_info/$vars{'sys_info'}";
+    push @deps, "sys_man/$vars{'sys_man'}";
+  }
+  if ($vars{'option_doc'}) {
+    push @deps, "option_doc";
+  }
+  if ($vars{'option_src'}) {
+    push @deps, "option_src";
+  }
+  push @deps, "TEXDIR/$vars{'TEXDIR'}";
+  push @deps, "TEXMFSYSVAR/$vars{'TEXMFSYSVAR'}";
+  push @deps, "TEXMFLOCAL/$vars{'TEXMFLOCAL'}";
+  push @deps, "TEXMFHOME/$vars{'TEXMFHOME'}";
+  $tlp->depends(@deps);
+  $localtlpdb->add_tlpobj($tlp);
+  $localtlpdb->save();
+}
 
 # do_postinst_stuff has to fix up the texmf tree and install some missing
 # files. The things to do are taken from the install-live.sh installer
diff --git a/Master/tlpkg/installer/uninstall-tl.pl b/Master/tlpkg/installer/uninstall-tl.pl
index 43bc5a2588d..4d15ebca19c 100755
--- a/Master/tlpkg/installer/uninstall-tl.pl
+++ b/Master/tlpkg/installer/uninstall-tl.pl
@@ -24,6 +24,7 @@ BEGIN {
 }
 
 use TeXLive::TLWinGoo;
+use TeXLive::TLPDB;
 use Cwd qw/abs_path/;
 use strict;
 
@@ -38,9 +39,31 @@ sub main
 {
   # get the db.
   my $Master = abs_path("$me/.."); # another step up
-
+  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) {
+    my $tlp = $tlpdb->get_package("00texlive-installation.config");
+    if (defined($tlp)) {
+      my @deps = $tlp->depends;
+      foreach my $d (@deps) {
+        $opt_symlinks = 1 if ($d =~ m/^option_symlinks$/);
+        if ($d =~ m;^sys_bin/(.*)$;) { $sys_bin = $1 ; }
+        if ($d =~ m;^sys_man/(.*)$;) { $sys_man = $1 ; }
+        if ($d =~ m;^sys_info/(.*)$;) { $sys_info = $1 ; }
+        if ($d =~ m;^TEXDIR/(.*)$;) { $texdir = $1 ; }
+        if ($d =~ m;^TEXMFHOME/(.*)$;) { $texmfhome = $1 ; }
+        if ($d =~ m;^TEXMFSYSVAR/(.*)$;) { $texmfsysvar = $1 ; }
+        if ($d =~ m;^TEXMFLOCAL/(.*)$;) { $texmflocal = $1 ; }
+      }
+    }
+  } else {
+    warn("Cannot find tlpdb in $Master!\n");
+  }
   # we have to
-  # - remove the entry of bin/arch from the PATH environment
+  # - (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
@@ -49,14 +72,93 @@ sub main
     unregister_script_type(".texlua");
     broadcast_env();
     update_assocs();
-    # now remove all the OTHER dirs (nothing done here atm)
-    # ...
-    # remove all the directories ... howto do that on windows ...
+    # remove all the directories
+    system("rmdir /s /q \"$Master\\texmf-dist\"");
+    system("rmdir /s /q \"$Master\\texmf-doc\"");
+    system("rmdir /s /q \"$Master\\texmf-var\"");
+    system("rmdir /s /q \"$Master\\texmf-config\"");
+    system("rmdir /s /q \"$Master\\texmf\"");
+    system("rmdir /s /q \"$Master\\bin\"");
+    system("rmdir /s /q \"$Master\\tlpkg\"");
+    system("del /q \"$Master\\install-tl.log\"");
+    # now everything should be removed ...
+    system("rmdir /q \"$Master\"");
   } else {
     # remove the links missing
-    # We have to save some information about these options into the
-    # texlive.tlpdb otherwise we will not be able to undo that
-    # ...
+    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";
+      }
+    }
     # remove all the directories
     system("rm -rf \"$Master/texmf-dist\"");
     system("rm -rf \"$Master/texmf-doc\"");