summaryrefslogtreecommitdiff
path: root/Master/setuptl/TLPM/uninst.pm
blob: b8b8f54d5ef9c0f2496aa1f3f21c99f2dbecfb5b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
# This file belongs to TLPM v2.21, TeX Live Package Manager
# Public Domain, P.Jackowski@gust.org.pl

# uninst <pkg> [-rjF] [dir]
# uninstall 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;