1 files changed, 117 insertions, 0 deletions
diff --git a/Master/setuptl/TLPM/uninst.pm b/Master/setuptl/TLPM/uninst.pm
new file mode 100644
index 00000000000..8c2697d6095
--- /dev/null
+++ b/Master/setuptl/TLPM/uninst.pm
@@ -0,0 +1,117 @@
+# This file belongs to TLPM v2.14, TeX Live Package Manager
+# Public Domain, P.Jackowski@gust.org.pl
+
+# uninst <pkg> [-rjF] [dir]
+# remove given package respecting dependencies
+
+sub uninst
+{
+      my ($arg,$pkg,@pkg_list);
+      local $tl_target_new;
+      local ($force,$Force) = (0,0);
+      local $uninst_method = \&uninst_all;
+      while(defined($arg = shift))
+      {
+            $arg eq ''                       and next
+            or &no_opt($arg)                 and push(@pkg_list,$arg)
+            or &is_opt($arg,'j','justone')   and $uninst_method = \&uninst_one
+            or &is_opt($arg,'r','recurse')   and $uninst_method = \&uninst_all
+            or &is_opt($arg,'i','ignore')    and $force = 1
+            or &is_opt($arg,'I','Ignore')    and ($Force,$force) = (1,1)
+            or &is_opt($arg,'d','directory') and do {$tl_target_new = shift;1}
+            or &is_opt($arg,'h','help')      and return $heeelp -> ('uninst')
+            or &rem_opt($arg)                and return $error{'wrong_opt'} -> ($arg,'uninst --help');
+      }
+      return $error{'pkg_unspec'} -> () unless @pkg_list;
+      &read_target();
+      return if &open_log();
+      foreach $pkg (@pkg_list)
+      {
+            &is_pkg($pkg,$target_pkges) or $error{'pkg_not_inst'} -> ($pkg) and next;
+            $uninst_method -> ($pkg);
+      }
+      &close_log;
+}
+
+sub uninst_all
+{
+      my $pkg = shift;
+      my $val;
+      local %uninst_pkges = map {($_,undef)} &get_pkg_requires_all($pkg,$target_pkges);
+      $uninst_pkges{$pkg} = undef;
+      &uninst_next($pkg);
+      unless($Force){$force = $false}
+      while(($pkg,$val) = each %uninst_pkges)
+      {
+            next if defined $val;
+            &uninst_next($pkg);
+      }
+}
+
+sub uninst_one
+{
+      my $pkg = shift;
+      local $uninst_pkges{$pkg} = undef;
+      &uninst_next($pkg);
+}
+
+sub uninst_next
+{
+      my $pkg = shift;
+      if($force)
+      {
+            &uninst_pkg($pkg);
+      }
+      else
+      {
+            &try_uninst_pkg($pkg);
+      }
+}
+
+sub uninst_pkg
+{
+      my $pkg = shift;
+      $messf -> ($row_fmt,$pkg);
+      &rem_files($pkg);
+      $messf -> ("%s\n","uninstalled");
+      $uninst_pkges{$pkg} = 1;
+      delete $target_pkges -> {$pkg};
+}
+
+sub leave_pkg
+{
+      my $pkg = shift;
+      $messf -> ($row_fmt . "required by %s\n",$pkg,join(",\n" . ' ' x ($row_skip + 12),@_));
+      $uninst_pkges{$pkg} = 0;
+}
+
+
+sub rem_files
+{
+    map {unlink "$tl_target$chr_dirsep$_"} &get_pkg_contains($_[0],$target_pkges);
+}
+
+sub try_uninst_pkg
+{
+    my $pkg = shift;
+    return(0) unless exists $uninst_pkges{$pkg};
+      return $uninst_pkges{$pkg} if defined $uninst_pkges{$pkg};
+    my $try = 1;
+    my @req = &get_pkg_belongs($pkg,$target_pkges);
+    foreach(@req)
+    {
+         $try *= &try_uninst_pkg($_);
+      }
+      if($try)
+      {
+            &uninst_pkg($pkg);
+            return(1);
+      }
+      else
+      {
+            &leave_pkg($pkg,grep {$uninst_pkges{$_} == 0} @req);
+            return(0);
+      }
+}
+
+1;