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
118
|
#!/usr/bin/perl
# Copyright (C) 1999,2002 MandrakeSoft <pixel@linux-mandrake.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#We only make good software ;-)
use strict;
#use strict qw(subs vars refs);
use urpm;
#- get I18N translation method.
import urpm _;
my ($auto, $matches, $maymatch, %provides, @l, @m, @toremove);
my $askok = _("Is it OK?");
my $askrm = _("Remove them all?");
# Translator: Add here the keys which might be pressed in the "No"-case.
my $noexpr = _("Nn");
# Translator: Add here the keys which might be pressed in the "Yes"-case.
my $yesexpr = _("Yy");
local $_ = ' ' . join(' ', @ARGV) . ' ';
if ( / --?h/ || @ARGV == 0 ) {
print STDERR _("usage: urpme [-a] [--auto] <packages...>\n");
exit(0);
}
$matches = / -a /;
$auto = / --?auto /;
my $DIR = "/var/lib/urpmi";
@l = grep { !/^-/ } @ARGV;
if (!$matches) {
@m = map { chop; $_ } `rpm -q @l 2>&1`;
if ($?) {
$maymatch = _("unknown package(s) ") . join(", ", map { /package (\S+) is not installed/ ? $1 : () } @m) . "\n";
$auto || @l > 1 and die $maymatch;
}
}
if ($matches || $maymatch) {
my $match = join "|", map { quotemeta } @l;
@m = grep { /$match/ } map { chop; $_ } `rpm -qa`;
if ($maymatch) {
@m or die $maymatch;
my $msg = _("Using \"%s\" as a substring, I found", $match);
print STDOUT "$msg:\n@m\n$askrm" . _(" (y/N) ");
<STDIN> =~ /[$yesexpr]/ or exit 1;
}
}
load_provides();
my %toremove;
@toremove{$_, @{$provides{$_} || []}} = () foreach @m;
my $changed = 1;
while ($changed) {
$changed = 0;
local *F;
open F, "LANGUAGE=C rpm -e --test " . join(" ", keys %toremove) . " 2>&1 |";
foreach (<F>) {
if (/package (\S+) is not installed/) {
delete $toremove{$1};
} elsif (/is needed by (\S+)/ && ! exists $toremove{$1}) {
$toremove{$1} = 1;
$changed = 1;
}
}
}
if ( ! (@toremove = keys %toremove) ) {
print _("Nothing to remove.\n");
exit(0);
}
if (@toremove > @l && !$auto) {
my $sum = 0;
map { $sum += $_ } `rpm -q --queryformat "%{SIZE}\n" @toremove`;
my $msg = _("To satisfy dependencies, the following packages are going to be removed (%d MB)", toMb($sum));
print STDOUT "$msg:\n@toremove\n$askok" . _(" (Y/n) ");
<STDIN> =~ /[$noexpr]/ and exit 0;
}
system("rpm", "-e", @toremove);
sub load_provides {
local *F;
open F, "$DIR/depslist.ordered" or return;
my @packages_id;
my %provides_id;
foreach (<F>) {
my ($p, $size, @l) = split;
#$size{$p} = $size;
push @packages_id, $p;
push @{$provides_id{$_}}, $p foreach @l;
}
foreach (keys %provides_id) {
$provides{$packages_id[$_]} = $provides_id{$_};
}
}
sub toMb {
my $nb = $_[0] / 1024 / 1024;
int $nb + 0.5;
}
|
