1 files changed, 208 insertions, 62 deletions

diff --git a/perl-install/do_pkgs.pm b/perl-install/do_pkgs.pm
index c98019062..ba9283000 100644
--- a/perl-install/do_pkgs.pm
+++ b/perl-install/do_pkgs.pm
@@ -1,4 +1,22 @@
-package do_pkgs; # $Id$
+package do_pkgs;
+
+=head1 SYNOPSYS
+
+B<do_pkgs> enables to install packages (through urpmi) from our tools.
+It works both during installer and in standalone tools by using dedicate sub packages (B<do_pkgs_standalone> and B<do_pkgs_during_install>), both relying onrelying on  do_pkgs_common.
+
+
+=head1 Functions
+
+=over
+
+=cut
+
+=item do_pkgs($in)
+
+Returns a new B<do_pkgs> object from a L<interactive> object.
+
+=cut
 
 sub do_pkgs {
     my ($in) = @_;
@@ -9,57 +27,133 @@ sub do_pkgs {
 package do_pkgs_common;
 use common;
 
+=item ensure_is_installed($do, $pkg, $o_file, $b_auto)
+
+Makes sure that the $pkg package is installed.
+If $o_file is provided, the already installed check is I<way> faster.
+If $b_auto is set, (g)urpmi will not ask any questions.
+
+=cut
+
 sub ensure_is_installed {
     my ($do, $pkg, $o_file, $b_auto) = @_;
 
-    if (! $o_file || ! -e "$::prefix$o_file") {
-	$do->in->ask_okcancel('', N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) 
-	  or return if !$b_auto;
+    if ($do->is_installed($pkg, $o_file)) {
+	return 1;
+    }
+
+	$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) 
+	  or return if !$b_auto && $do->in;
+
 	if (!$do->install($pkg)) {
-	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg));
+	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in;
 	    return;
 	}
-    }
+
     if ($o_file && ! -e "$::prefix$o_file") {
-	$do->in->ask_warn('', N("Mandatory package %s is missing", $pkg));
+	$do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in;
 	return;
     }
     1;
 }
 
+=item ensure_are_installed($do, $pkgs, $b_auto)
+
+Makes sure that the packages listed in $pkgs array ref are installed.
+If $b_auto is set, (g)urpmi will not ask any questions.
+
+It's quite costly, so it's better to use the B<ensure_files_are_installed> instead.
+
+=cut
+
 sub ensure_are_installed {
     my ($do, $pkgs, $b_auto) = @_;
 
     my @not_installed = difference2($pkgs, [ $do->are_installed(@$pkgs) ]) or return 1;
 
     $do->in->ask_okcancel(N("Warning"), N("The following packages need to be installed:\n") . join(', ', @not_installed), 1)
-	  or return if !$b_auto;
+	  or return if !$b_auto && $do->in;
 
     if (!$do->install(@not_installed)) {
-	$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0]));
+	if ($do->in) {
+	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0]));
+	} else {
+	    log::l("Could not install packages: " . join(' ', @not_installed));
+	}
 	return;
     }
     1;
 }
 
+=item ensure_binary_is_installed($do, $pkg, $binary, $b_auto)
+
+Makes sure that the $pkg package is installed.
+$binary is looked for in $PATH. If not found, the package is installed.
+If $b_auto is set, (g)urpmi will not ask any questions.
+
+=cut
+
 sub ensure_binary_is_installed {
     my ($do, $pkg, $binary, $b_auto) = @_;
 
     if (!whereis_binary($binary, $::prefix)) {
-	$do->in->ask_okcancel('', N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) 
-	  or return if !$b_auto;
+	$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) 
+	  or return if !$b_auto && $do->in;
 	if (!$do->install($pkg)) {
-	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg));
+            $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in;
 	    return;
 	}
     }
     if (!whereis_binary($binary, $::prefix)) {
-	$do->in->ask_warn('', N("Mandatory package %s is missing", $pkg));
+        $do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in;
 	return;
     }
     1;
 }
 
+sub _find_file {
+    my ($file) = @_;
+    if ($file =~ m!/!) {
+	-e "$::prefix$file";
+    } else {
+	# assume it's a binary to search in $PATH:
+	whereis_binary($file, $::prefix);
+    }
+}
+
+=item ensure_files_are_installed($do, $pkgs, $b_auto)
+
+Takes a list of [ "package", "file" ] and installs package if file is not there.
+If $b_auto is set, (g)urpmi will not ask any questions.
+
+=cut
+
+sub ensure_files_are_installed {
+    my ($do, $pkgs, $b_auto) = @_;
+
+    my @not_installed = map { my ($package, $file) = @$_; if_(!_find_file($file), $package) } @$pkgs;
+    return 1 if !@not_installed;
+
+    $do->in->ask_okcancel(N("Warning"), N("The following packages need to be installed:\n") . join(', ', @not_installed), 1)
+	  or return if !$b_auto && $do->in;
+
+    if (!$do->install(@not_installed)) {
+	if ($do->in) {
+	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0]));
+	} else {
+	    log::l("Could not install packages: " . join(' ', @not_installed));
+	}
+	return;
+    }
+    1;
+}
+
+=item ensure_is_installed_if_available($do, $pkg, $file) = @_;
+
+Install $pkg if $file is not present and if $pkg is actually known to urpmi.
+
+=cut
+
 sub ensure_is_installed_if_available {
     my ($do, $pkg, $file) = @_;
     if (-e "$::prefix$file" || $::testing) {
@@ -69,30 +163,63 @@ sub ensure_is_installed_if_available {
     }
 }
 
+=item is_available($do, $name)
+
+=item are_available($do, @names)
+
+Returns name(s) of package(s) that are available (aka known to urpmi).
+This is somewhat costly (needs to parse urpmi synthesis...)
+
+=cut
+
 sub is_available {
     my ($do, $name) = @_;
     $do->are_available($name);
 }
 
+=item is_installed($do, $name)
+
+=item are_installed($do, @names)
+
+Returns name(s) of package(s) that are already installed on the system.
+This is less costly (needs to query RPM DB)
+
+=cut
+
 sub is_installed {
-    my ($do, $name) = @_;
-    $do->are_installed($name);
+    my ($do, $name, $o_file) = @_;
+    $o_file ? -e "$::prefix$o_file" : $do->are_installed($name);
 }
 
+=item check_kernel_module_packages($do, $base_name)
+
+Takes something like C<ati-kernel> and returns:
+
+=over 4
+
+=item * the various C<ati-kernel-3.Y.XX-ZZmga> available for the installed kernels
+
+=item * C<dkms-ati> if available
+
+=back
+
+=cut
+
 sub check_kernel_module_packages {
-    my ($do, $base_name, $o_ext_name) = @_;
+    my ($do, $base_name) = @_;
     
     require bootloader;
-    my @rpms = $do->are_available(if_($base_name =~ /^(.*)-kernel$/, "dkms-$1"),
-                                  map {
-                                      $base_name . '-' . bootloader::vmlinuz2version($_);
-                                  } bootloader::installed_vmlinuz());
-    my @ext = $o_ext_name ? $do->are_available($o_ext_name) : ();
+    my @test_rpms = (
+	'dkms-' . $base_name,
+	map { $base_name . '-kernel-' . bootloader::vmlinuz2version($_) } bootloader::installed_vmlinuz()
+    );
+    my @rpms = $do->are_available(@test_rpms);
+    @rpms = $do->are_installed(@test_rpms) if !@rpms;
+    @rpms or return;
 
-    log::l("found kernel module packages $_") foreach @rpms, @ext;
+    log::l("those kernel module packages can be installed: " . join(' ', @rpms));
 
-    #- we want at least a kernel package and the ext package if specified
-    @rpms && (!$o_ext_name || @ext) && [ @rpms, @ext ];
+    \@rpms;
 }
 
 ################################################################################
@@ -102,9 +229,18 @@ use common;
 
 our @ISA = qw(do_pkgs_common);
 
+=item new($type, $in)
+
+Returns a C<do_pkg> object.
+
+=cut
+
 sub new {
     my ($type, $in) = @_;
-    require pkgs;
+
+    $in->isa('interactive') or undef $in;
+
+    require install::pkgs;
     bless { in => $in, o => $::o }, $type;
 }
 
@@ -116,28 +252,29 @@ sub in {
 sub install {
     my ($do, @l) = @_;
     log::l("do_pkgs_during_install::install");
-    if ($::testing || $::globetrotter) {
+    if ($::testing) {
 	log::l("i would install packages " . join(' ', @l));
-	return 1;
+	1;
     } else {
 	$do->{o}->pkg_install(@l);
+	1; #- HACK, need better fix in install::steps::pkg_install()
     }
 }
 
 sub what_provides {
     my ($do, $name) = @_;
-    map { $_->name } pkgs::packagesProviding($do->{o}{packages}, $name);
+    map { $_->name } install::pkgs::packagesProviding($do->{o}{packages}, $name);
 }
 
 sub are_available {
     my ($do, @pkgs) = @_;
-    grep { pkgs::packageByName($do->{o}{packages}, $_) } @pkgs;
+    grep { install::pkgs::packageByName($do->{o}{packages}, $_) } @pkgs;
 }
 
 sub are_installed {
     my ($do, @l) = @_;
     grep {
-	my $p = pkgs::packageByName($do->{o}{packages}, $_);
+	my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
 	$p && $p->flag_available;
     } @l;
 }
@@ -146,8 +283,8 @@ sub remove {
     my ($do, @l) = @_;
 
     @l = grep {
-	my $p = pkgs::packageByName($do->{o}{packages}, $_);
-	pkgs::unselectPackage($do->{o}{packages}, $p) if $p;
+	my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
+	install::pkgs::unselectPackage($do->{o}{packages}, $p) if $p;
 	$p;
     } @l;
     run_program::rooted($::prefix, 'rpm', '-e', @l);
@@ -157,7 +294,7 @@ sub remove_nodeps {
     my ($do, @l) = @_;
 
     @l = grep {
-	my $p = pkgs::packageByName($do->{o}{packages}, $_);
+	my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
 	if ($p) {
 	    $p->set_flag_requested(0);
 	    $p->set_flag_required(0);
@@ -172,6 +309,7 @@ package do_pkgs_standalone;
 use run_program;
 use common;
 use log;
+use feature qw(state);
 
 our @ISA = qw(do_pkgs_common);
 
@@ -182,10 +320,6 @@ sub new {
 
 sub in {
     my ($do) = @_;
-    $do->{in} ||= do {
-	require interactive;
-	interactive->vnew;
-    };
     $do->{in};
 }
 
@@ -199,12 +333,18 @@ sub install {
 	return 1;
     }
 
-    my $_wait = $do->in->wait_message('', N("Installing packages..."));
-    $do->in->suspend;
-    log::explanations("installed packages @l");
-    #- --expect-install added in urpmi 4.6.11
-    my $ret = system('urpmi', '--allow-medium-change', '--auto', '--no-verify-rpm', '--gui', '--expect-install', @l) == 0;
-    $do->in->resume;
+    my @wrapper = $::isLiveInstall && $::prefix ? ('chroot', $::prefix) : ();
+    my @options = ('--allow-medium-change', '--auto', '--no-verify-rpm', '--expect-install', @l);
+    my $ret;
+    if (check_for_xserver() && -x '/usr/bin/gurpmi') {
+        $ret = system(@wrapper, 'gurpmi', @options) == 0;
+    } else {
+        my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Installing packages..."));
+        $do->in->suspend if $do->in;
+        log::explanations("installing packages @l");
+        $ret = system(@wrapper, 'urpmi', @options) == 0;
+        $do->in->resume if $do->in;
+    }
     $ret;
 }
 
@@ -212,17 +352,19 @@ sub are_available {
     my ($_do, @pkgs) = @_;
     my %pkgs = map { $_ => 1 } @pkgs;
 
+    require urpm::media;
+    state $urpm;
     eval {
-	local *_;
-	require urpm;
-	my $urpm = urpm->new;
-	$urpm->read_config(nocheck_access => 1);
-	foreach (grep { !$_->{ignore} } @{$urpm->{media} || []}) {
-	    $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$_->{hdlist}");
+	if (!$urpm) {
+	    $urpm = urpm->new;
+	    $urpm->{log} = \&log::l;
+	    urpm::media::configure($urpm, 
+				   nocheck_access => 1,
+				   no_skiplist => 1,
+				   no_second_pass => 1);
 	}
 	map { $_->name } grep { $pkgs{$_->name} } @{$urpm->{depslist} || []};
     };
-    
 }
 
 sub what_provides {
@@ -230,25 +372,25 @@ sub what_provides {
     split('\|', chomp_(run_program::get_stdout('urpmq', $name)));
 }
 
-sub is_installed {
-    my ($do, $name) = @_;
-    are_installed($do, $name);
-}
-
 sub are_installed {
     my ($_do, @l) = @_;
+    @l or return;
+
     my @l2;
-    run_program::run('/bin/rpm', '>', \@l2, '-q', '--qf', "%{name}\n", @l); #- do not care about the return value
-    intersection(\@l, [ chomp_(@l2) ]); #- can not return directly @l2 since it contains things like "package xxx is not installed"
+    my $query_all = (any { /\*/ } @l) ? 'a' : '';
+    my $rooted = $::isLiveInstall && $::prefix ? { root => $::prefix } : {};
+    run_program::raw($rooted, '/bin/rpm', '>', \@l2, '-q' . $query_all, '--qf', "%{name}\n", @l); #- do not care about the return value
+    $query_all ? chomp_(@l2) : intersection(\@l, [ chomp_(@l2) ]); #- cannot return directly @l2 since it contains things like "package xxx is not installed"
 }
 
 sub remove {
     my ($do, @l) = @_;
-    my $_wait = $do->in->wait_message('', N("Removing packages..."));
-    $do->in->suspend;
-    log::explanations("removed packages @l");
-    my $ret = system('rpm', '-e', @l) == 0;
-    $do->in->resume;
+    my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Removing packages..."));
+    $do->in->suspend if $do->in;
+    log::explanations("removing packages @l");
+    my @wrapper = $::isLiveInstall && $::prefix ? ('chroot', $::prefix) : ();
+    my $ret = system(@wrapper, 'rpm', '-e', @l) == 0;
+    $do->in->resume if $do->in;
     $ret;
 }
 
@@ -256,3 +398,7 @@ sub remove_nodeps {
     my ($do, @l) = @_;
     remove($do, '--nodeps', @l) == 0;
 }
+
+=back
+
+=cut