# This file belongs to TLPM v2.14, TeX Live Package Manager # Public Domain, P.Jackowski@gust.org.pl # uninst [-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;