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;
|
