support tlmgr arch remove, both in command line and gui

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

2 files changed, 97 insertions, 22 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index e8cbdd9c0b0..ba7751c90e9 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -2369,7 +2369,7 @@ sub action_arch {
         next;
       }
       if (!TeXLive::TLUtils::member($a, @available_arch)) {
-        print "Arch $a not available, use 'tlmgr available_archs'!\n";
+        print "Arch $a not available, use 'tlmgr arch list'!\n";
         next;
       }
       push @todoarchs, $a;
@@ -2381,11 +2381,10 @@ sub action_arch {
         if ($dep =~ m/^(.*)\.ARCH$/) {
           # we have to install something
           foreach my $a (@todoarchs) {
-            if ($opts{"dry-run"}) {
-              info("Installing $pkg.$a\n");
-            } else {
+            if ($tlmediatlpdb->get_package("$pkg.$a")) {
               info("install: $pkg.$a\n");
-              $tlmediasrc->install_package("$pkg.$a", $localtlpdb);
+              $tlmediasrc->install_package("$pkg.$a", $localtlpdb)
+                if (!$opts{"dry-run"});
             }
           }
         }
@@ -2394,17 +2393,73 @@ sub action_arch {
     if (TeXLive::TLUtils::member('win32', @todoarchs)) {
       # install the necessary w32 stuff
       info("install: tlperl.win32\n");
-      $tlmediasrc->install_package("tlperl.win32", $localtlpdb);
+      $tlmediasrc->install_package("tlperl.win32", $localtlpdb) if (!$opts{"dry-run"});
       info("install: tlgs.win32\n");
-      $tlmediasrc->install_package("tlgs.win32", $localtlpdb);
+      $tlmediasrc->install_package("tlgs.win32", $localtlpdb) if (!$opts{"dry-run"});
       info("install: tlpsv.win32\n");
-      $tlmediasrc->install_package("tlpsv.win32", $localtlpdb);
+      $tlmediasrc->install_package("tlpsv.win32", $localtlpdb) if (!$opts{"dry-run"});
     }
     # update the option("available_architectures") list of installed archs
-    my @larchs = $localtlpdb->setting("available_architectures");
-    push @larchs, @todoarchs;
-    $localtlpdb->setting("available_architectures",@larchs);
-    $localtlpdb->save;
+    if (!$opts{"dry-run"}) {
+      my @larchs = $localtlpdb->setting("available_architectures");
+      push @larchs, @todoarchs;
+      $localtlpdb->setting("available_architectures",@larchs);
+      $localtlpdb->save;
+    }
+  } elsif ($what =~ m/^remove$/i) {
+    my @already_installed_arch = $localtlpdb->available_architectures;
+    my @todoarchs;
+    my $currentarch = $localtlmedia->platform();
+    foreach my $a (@ARGV) {
+      if (!TeXLive::TLUtils::member($a, @already_installed_arch)) {
+        print "Arch $a not installed, use 'tlmgr arch list'!\n";
+        next;
+      }
+      if ($currentarch eq $a) {
+        info("You are running on arch $a, you cannot remove that one!\n");
+        next;
+      }
+      push @todoarchs, $a;
+    }
+    foreach my $pkg ($localtlpdb->list_packages) {
+      next if ($pkg =~ m/^00texlive/);
+      my $tlp = $localtlpdb->get_package($pkg);
+      if (!$tlp) {
+        # that is a package foobar.$a that has already been remove but
+        # is still in the list above, so ignore that
+        next;
+      }
+      foreach my $dep ($tlp->depends) {
+        if ($dep =~ m/^(.*)\.ARCH$/) {
+          # we have to install something
+          foreach my $a (@todoarchs) {
+            if ($localtlpdb->get_package("$pkg.$a")) {
+              info("remove: $pkg.$a\n");
+              $localtlmedia->remove_package("$pkg.$a") if (!$opts{"dry-run"});
+            }
+          }
+        }
+      }
+    }
+    if (TeXLive::TLUtils::member('win32', @todoarchs)) {
+      # remove the additionally installed w32 stuff
+      info("remove: tlperl.win32\n");
+      $localtlmedia->remove_package("tlperl.win32") if (!$opts{"dry-run"});
+      info("remove: tlgs.win32\n");
+      $localtlmedia->remove_package("tlgs.win32") if (!$opts{"dry-run"});
+      info("remove: tlpsv.win32\n");
+      $localtlmedia->remove_package("tlpsv.win32") if (!$opts{"dry-run"});
+    }
+    if (!$opts{"dry-run"}) {
+      # update the option("available_architectures") list of installed archs
+      my @larchs = $localtlpdb->setting("available_architectures");
+      my @newarchs;
+      for my $a (@larchs) {
+        push @newarchs, $a if !member($a, @todoarchs);
+      }
+      $localtlpdb->setting("available_architectures",@newarchs);
+      $localtlpdb->save;
+    }
   } else {
     die "Unknown option for arch: $what";
   }
@@ -4131,13 +4186,19 @@ longstanding C<texconfig> script, which supports other configuration
 settings for some programs, notably C<dvips>.  C<tlmgr> does not support
 those extra settings at present.
 
-=head2 arch list|add I<arch>...
+=head2 arch list|add|remove I<arch>...
 
 C<arch list> lists the TeX Live names of all the architectures
 (C<i386-linux>, ...) available at the default install location.
 
-C<arch add> I<arch> adds the executables for each given architecture
-I<arch> to the installation.  Options:
+C<arch add> I<arch>... adds the executables for each given architecture
+I<arch> to the installation. 
+
+C<arch remove> I<arch>... removes the executables for each given 
+architecture I<arch> from the installation, but keeps the currently 
+running architecture in any case.
+
+Options:
 
 =over 4
 
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
index 653430fe96f..83db3a01945 100644
--- a/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/gui-arch.pl
@@ -17,6 +17,7 @@ $screens{"arch"} = $back_arch;
 our @archsavail;
 our @archsinstalled;
 our %archs;
+our $currentarch;
 
 our %archsbuttons;
 our $arch_frame;
@@ -33,6 +34,7 @@ sub init_archs {
   } else {
     @archsavail = $tlmediatlpdb->available_architectures;
   }
+  $currentarch = $localtlmedia->platform();
   @archsinstalled = $localtlpdb->available_architectures;
   foreach my $a (@archsavail) {
     $archs{$a} = 0;
@@ -62,24 +64,36 @@ sub init_archs {
 
 sub check_on_removal {
   my $a = shift;
-  if (!$archs{$a} && grep(/^$a$/,@archsinstalled)) {
+  if (!$archs{$a} && $a eq $currentarch) {
     # removal not supported
     $archs{$a} = 1;
     $arch_frame->Dialog(-title => "info",
-                        -text => __("Removals of binary systems currently not supported!"),
+                        -text => __("Removals of the main architecture not possible!"),
                         -buttons => [ __("Ok") ])->Show;
   }
 }
 
 
 sub apply_changes {
-  my @todo;
+  my @todo_add;
+  my @todo_remove;
   foreach my $a (@archsavail) {
-    next if grep(/^$a$/,@archsinstalled);
-    push @todo, $a if $archs{$a};
+    if (!$archs{$a} && grep(/^$a$/,@archsinstalled)) {
+      push @todo_remove, $a;
+      next;
+    }
+    if ($archs{$a} && !grep(/^$a$/,@archsinstalled)) {
+      push @todo_add, $a;
+      next;
+    }
+  }
+  if (@todo_add) {
+    execute_action_gui ( "arch", "add", @todo_add );
+  }
+  if (@todo_remove) {
+    execute_action_gui ( "arch", "remove", @todo_remove );
   }
-  if (@todo) {
-    execute_action_gui ( "arch", "add", @todo );
+  if (@todo_add || @todo_remove) {
     reinit_local_tlpdb();
     init_archs();
   }