1 |
package do_pkgs; # $Id: do_pkgs.pm 263860 2009-11-30 15:20:14Z blino $ |
2 |
|
3 |
sub do_pkgs { |
4 |
my ($in) = @_; |
5 |
($::isInstall ? 'do_pkgs_during_install' : 'do_pkgs_standalone')->new($in); |
6 |
} |
7 |
|
8 |
################################################################################ |
9 |
package do_pkgs_common; |
10 |
use common; |
11 |
|
12 |
sub ensure_is_installed { |
13 |
my ($do, $pkg, $o_file, $b_auto) = @_; |
14 |
|
15 |
if ($o_file ? -e "$::prefix$o_file" : $do->is_installed($pkg)) { |
16 |
return 1; |
17 |
} |
18 |
|
19 |
$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) |
20 |
or return if !$b_auto && $do->in; |
21 |
|
22 |
if (!$do->install($pkg)) { |
23 |
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in; |
24 |
return; |
25 |
} |
26 |
|
27 |
if ($o_file && ! -e "$::prefix$o_file") { |
28 |
$do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in; |
29 |
return; |
30 |
} |
31 |
1; |
32 |
} |
33 |
|
34 |
sub ensure_are_installed { |
35 |
my ($do, $pkgs, $b_auto) = @_; |
36 |
|
37 |
my @not_installed = difference2($pkgs, [ $do->are_installed(@$pkgs) ]) or return 1; |
38 |
|
39 |
$do->in->ask_okcancel(N("Warning"), N("The following packages need to be installed:\n") . join(', ', @not_installed), 1) |
40 |
or return if !$b_auto && $do->in; |
41 |
|
42 |
if (!$do->install(@not_installed)) { |
43 |
if ($do->in) { |
44 |
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0])); |
45 |
} else { |
46 |
log::l("Could not install packages: " . join(' ', @not_installed)); |
47 |
} |
48 |
return; |
49 |
} |
50 |
1; |
51 |
} |
52 |
|
53 |
sub ensure_binary_is_installed { |
54 |
my ($do, $pkg, $binary, $b_auto) = @_; |
55 |
|
56 |
if (!whereis_binary($binary, $::prefix)) { |
57 |
$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) |
58 |
or return if !$b_auto && $do->in; |
59 |
if (!$do->install($pkg)) { |
60 |
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in; |
61 |
return; |
62 |
} |
63 |
} |
64 |
if (!whereis_binary($binary, $::prefix)) { |
65 |
$do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in; |
66 |
return; |
67 |
} |
68 |
1; |
69 |
} |
70 |
|
71 |
# takes a list of [ "package", "file" ] and installs package if file is not there |
72 |
sub ensure_files_are_installed { |
73 |
my ($do, $pkgs, $b_auto) = @_; |
74 |
|
75 |
my @not_installed = map { my ($package, $file) = @$_; if_(!-e "$::prefix$file", $package) } @$pkgs; |
76 |
|
77 |
$do->in->ask_okcancel(N("Warning"), N("The following packages need to be installed:\n") . join(', ', @not_installed), 1) |
78 |
or return if !$b_auto && $do->in; |
79 |
|
80 |
if (!$do->install(@not_installed)) { |
81 |
if ($do->in) { |
82 |
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0])); |
83 |
} else { |
84 |
log::l("Could not install packages: " . join(' ', @not_installed)); |
85 |
} |
86 |
return; |
87 |
} |
88 |
1; |
89 |
} |
90 |
|
91 |
sub ensure_is_installed_if_available { |
92 |
my ($do, $pkg, $file) = @_; |
93 |
if (-e "$::prefix$file" || $::testing) { |
94 |
1; |
95 |
} else { |
96 |
$do->what_provides($pkg) && $do->install($pkg); |
97 |
} |
98 |
} |
99 |
|
100 |
sub is_available { |
101 |
my ($do, $name) = @_; |
102 |
$do->are_available($name); |
103 |
} |
104 |
|
105 |
sub is_installed { |
106 |
my ($do, $name) = @_; |
107 |
$do->are_installed($name); |
108 |
} |
109 |
|
110 |
#- takes something like "ati-kernel" |
111 |
#- returns: |
112 |
#- - the various ati-kernel-2.6.XX-XXmdk available for the installed kernels |
113 |
#- - dkms-ati if available |
114 |
sub check_kernel_module_packages { |
115 |
my ($do, $base_name) = @_; |
116 |
|
117 |
require bootloader; |
118 |
my @test_rpms = ( |
119 |
'dkms-' . $base_name, |
120 |
map { $base_name . '-kernel-' . bootloader::vmlinuz2version($_) } bootloader::installed_vmlinuz() |
121 |
); |
122 |
my @rpms = $do->are_available(@test_rpms); |
123 |
@rpms = $do->are_installed(@test_rpms) if !@rpms; |
124 |
@rpms or return; |
125 |
|
126 |
log::l("those kernel module packages can be installed: " . join(' ', @rpms)); |
127 |
|
128 |
\@rpms; |
129 |
} |
130 |
|
131 |
################################################################################ |
132 |
package do_pkgs_during_install; |
133 |
use run_program; |
134 |
use common; |
135 |
|
136 |
our @ISA = qw(do_pkgs_common); |
137 |
|
138 |
sub new { |
139 |
my ($type, $in) = @_; |
140 |
|
141 |
$in->isa('interactive') or undef $in; |
142 |
|
143 |
require install::pkgs; |
144 |
bless { in => $in, o => $::o }, $type; |
145 |
} |
146 |
|
147 |
sub in { |
148 |
my ($do) = @_; |
149 |
$do->{in}; |
150 |
} |
151 |
|
152 |
sub install { |
153 |
my ($do, @l) = @_; |
154 |
log::l("do_pkgs_during_install::install"); |
155 |
if ($::testing) { |
156 |
log::l("i would install packages " . join(' ', @l)); |
157 |
1; |
158 |
} else { |
159 |
$do->{o}->pkg_install(@l); |
160 |
1; #- HACK, need better fix in install::steps::pkg_install() |
161 |
} |
162 |
} |
163 |
|
164 |
sub what_provides { |
165 |
my ($do, $name) = @_; |
166 |
map { $_->name } install::pkgs::packagesProviding($do->{o}{packages}, $name); |
167 |
} |
168 |
|
169 |
sub are_available { |
170 |
my ($do, @pkgs) = @_; |
171 |
grep { install::pkgs::packageByName($do->{o}{packages}, $_) } @pkgs; |
172 |
} |
173 |
|
174 |
sub are_installed { |
175 |
my ($do, @l) = @_; |
176 |
grep { |
177 |
my $p = install::pkgs::packageByName($do->{o}{packages}, $_); |
178 |
$p && $p->flag_available; |
179 |
} @l; |
180 |
} |
181 |
|
182 |
sub remove { |
183 |
my ($do, @l) = @_; |
184 |
|
185 |
@l = grep { |
186 |
my $p = install::pkgs::packageByName($do->{o}{packages}, $_); |
187 |
install::pkgs::unselectPackage($do->{o}{packages}, $p) if $p; |
188 |
$p; |
189 |
} @l; |
190 |
run_program::rooted($::prefix, 'rpm', '-e', @l); |
191 |
} |
192 |
|
193 |
sub remove_nodeps { |
194 |
my ($do, @l) = @_; |
195 |
|
196 |
@l = grep { |
197 |
my $p = install::pkgs::packageByName($do->{o}{packages}, $_); |
198 |
if ($p) { |
199 |
$p->set_flag_requested(0); |
200 |
$p->set_flag_required(0); |
201 |
} |
202 |
$p; |
203 |
} @l; |
204 |
run_program::rooted($::prefix, 'rpm', '-e', '--nodeps', @l); |
205 |
} |
206 |
|
207 |
################################################################################ |
208 |
package do_pkgs_standalone; |
209 |
use run_program; |
210 |
use common; |
211 |
use log; |
212 |
use feature qw(state); |
213 |
|
214 |
our @ISA = qw(do_pkgs_common); |
215 |
|
216 |
sub new { |
217 |
my ($type, $o_in) = @_; |
218 |
bless { in => $o_in }, $type; |
219 |
} |
220 |
|
221 |
sub in { |
222 |
my ($do) = @_; |
223 |
$do->{in}; |
224 |
} |
225 |
|
226 |
sub install { |
227 |
my ($do, @l) = @_; |
228 |
|
229 |
return 1 if listlength(are_installed($do, @l)) == @l; |
230 |
|
231 |
if ($::testing) { |
232 |
log::l("i would install packages " . join(' ', @l)); |
233 |
return 1; |
234 |
} |
235 |
|
236 |
my @options = ('--allow-medium-change', '--auto', '--no-verify-rpm', '--expect-install', @l); |
237 |
my $ret; |
238 |
if (check_for_xserver() && -x '/usr/bin/gurpmi') { |
239 |
$ret = system('gurpmi', @options) == 0; |
240 |
} else { |
241 |
my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Installing packages...")); |
242 |
$do->in->suspend if $do->in; |
243 |
log::explanations("installing packages @l"); |
244 |
#- --expect-install added in urpmi 4.6.11 |
245 |
$ret = system('urpmi', '--gui', @options) == 0; |
246 |
$do->in->resume if $do->in; |
247 |
} |
248 |
$ret; |
249 |
} |
250 |
|
251 |
sub are_available { |
252 |
my ($_do, @pkgs) = @_; |
253 |
my %pkgs = map { $_ => 1 } @pkgs; |
254 |
|
255 |
require urpm::media; |
256 |
state $urpm; |
257 |
eval { |
258 |
if (!$urpm) { |
259 |
$urpm = urpm->new; |
260 |
$urpm->{log} = \&log::l; |
261 |
urpm::media::configure($urpm, |
262 |
nocheck_access => 1, |
263 |
no_skiplist => 1, |
264 |
no_second_pass => 1); |
265 |
} |
266 |
map { $_->name } grep { $pkgs{$_->name} } @{$urpm->{depslist} || []}; |
267 |
}; |
268 |
} |
269 |
|
270 |
sub what_provides { |
271 |
my ($_do, $name) = @_; |
272 |
split('\|', chomp_(run_program::get_stdout('urpmq', $name))); |
273 |
} |
274 |
|
275 |
sub are_installed { |
276 |
my ($_do, @l) = @_; |
277 |
@l or return; |
278 |
|
279 |
my @l2; |
280 |
my $query_all = (any { /\*/ } @l) ? 'a' : ''; |
281 |
run_program::run('/bin/rpm', '>', \@l2, '-q' . $query_all, '--qf', "%{name}\n", @l); #- do not care about the return value |
282 |
$query_all ? chomp_(@l2) : intersection(\@l, [ chomp_(@l2) ]); #- cannot return directly @l2 since it contains things like "package xxx is not installed" |
283 |
} |
284 |
|
285 |
sub remove { |
286 |
my ($do, @l) = @_; |
287 |
my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Removing packages...")); |
288 |
$do->in->suspend if $do->in; |
289 |
log::explanations("removing packages @l"); |
290 |
my $ret = system('rpm', '-e', @l) == 0; |
291 |
$do->in->resume if $do->in; |
292 |
$ret; |
293 |
} |
294 |
|
295 |
sub remove_nodeps { |
296 |
my ($do, @l) = @_; |
297 |
remove($do, '--nodeps', @l) == 0; |
298 |
} |