summaryrefslogtreecommitdiffstats
path: root/perl-install/diskdrake/interactive.pm
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-08-23 17:27:20 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-08-23 17:27:20 +0000
commit9ed27110c23e2d73957e116929470829088bcb9c (patch)
tree4c84c87d6e3894c2636751e3fbbbf18271445708 /perl-install/diskdrake/interactive.pm
parentbd046906c20f915982e46b06f0c5d4f2901cf538 (diff)
downloaddrakx-9ed27110c23e2d73957e116929470829088bcb9c.tar
drakx-9ed27110c23e2d73957e116929470829088bcb9c.tar.gz
drakx-9ed27110c23e2d73957e116929470829088bcb9c.tar.bz2
drakx-9ed27110c23e2d73957e116929470829088bcb9c.tar.xz
drakx-9ed27110c23e2d73957e116929470829088bcb9c.zip
auto allocate on the current LV first (only partially fix bug #16175 since it will also auto allocate on other drives)
Diffstat (limited to 'perl-install/diskdrake/interactive.pm')
-rw-r--r--perl-install/diskdrake/interactive.pm2
1 files changed, 1 insertions, 1 deletions
diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm
index b65e05597..aeccf5e01 100644
--- a/perl-install/diskdrake/interactive.pm
+++ b/perl-install/diskdrake/interactive.pm
@@ -339,7 +339,7 @@ sub Auto_allocate {
my $suggestions = partitions_suggestions($in) or return;
my %all_hds_ = %$all_hds;
- $all_hds_{hds} = [ sort { $a == $hd ? -1 : 1 } @{$all_hds->{hds}} ];
+ $all_hds_{hds} = [ sort { $a == $hd ? -1 : 1 } fs::get::hds($all_hds) ];
eval { fsedit::auto_allocate(\%all_hds_, $suggestions) };
if ($@) {
generated by cgit v1.2.1 (git 2.21.0) at 2024-12-03 22:07:05 +0000
n185'>185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 
package do_pkgs; # $Id$

sub do_pkgs {
    my ($in) = @_;
    ($::isInstall ? 'do_pkgs_during_install' : 'do_pkgs_standalone')->new($in);
}

################################################################################
package do_pkgs_common;
use common;

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->install($pkg)) {
	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg));
	    return;
	}
    }
    if ($o_file && ! -e "$::prefix$o_file") {
	$do->in->ask_warn('', N("Mandatory package %s is missing", $pkg));
	return;
    }
    1;
}

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;

    if (!$do->install(@not_installed)) {
	$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0]));
	return;
    }
    1;
}

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;
	if (!$do->install($pkg)) {
	    $do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg));
	    return;
	}
    }
    if (!whereis_binary($binary, $::prefix)) {
	$do->in->ask_warn('', N("Mandatory package %s is missing", $pkg));
	return;
    }
    1;
}

sub ensure_is_installed_if_available {
    my ($do, $pkg, $file) = @_;
    if (-e "$::prefix$file" || $::testing) {
	1;
    } else {
        $do->what_provides($pkg) && $do->install($pkg);
    }
}

sub is_available {
    my ($do, $name) = @_;
    $do->are_available($name);
}

sub is_installed {
    my ($do, $name) = @_;
    $do->are_installed($name);
}

sub check_kernel_module_packages {
    my ($do, $base_name, $o_ext_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) : ();

    log::l("found kernel module packages $_") foreach @rpms, @ext;

    #- we want at least a kernel package and the ext package if specified
    @rpms && (!$o_ext_name || @ext) && [ @rpms, @ext ];
}

################################################################################
package do_pkgs_during_install;
use run_program;
use common;

our @ISA = qw(do_pkgs_common);

sub new {
    my ($type, $in) = @_;
    require pkgs;
    bless { in => $in, o => $::o }, $type;
}

sub in {
    my ($do) = @_;
    $do->{in};
}

sub install {
    my ($do, @l) = @_;
    log::l("do_pkgs_during_install::install");
    if ($::testing || $::globetrotter) {
	log::l("i would install packages " . join(' ', @l));
	return 1;
    } else {
	$do->{o}->pkg_install(@l);
    }
}

sub what_provides {
    my ($do, $name) = @_;
    map { $_->name } pkgs::packagesProviding($do->{o}{packages}, $name);
}

sub are_available {
    my ($do, @pkgs) = @_;
    grep { pkgs::packageByName($do->{o}{packages}, $_) } @pkgs;
}

sub are_installed {
    my ($do, @l) = @_;
    grep {
	my $p = pkgs::packageByName($do->{o}{packages}, $_);
	$p && $p->flag_available;
    } @l;
}

sub remove {
    my ($do, @l) = @_;

    @l = grep {
	my $p = pkgs::packageByName($do->{o}{packages}, $_);
	pkgs::unselectPackage($do->{o}{packages}, $p) if $p;
	$p;
    } @l;
    run_program::rooted($::prefix, 'rpm', '-e', @l);
}

sub remove_nodeps {
    my ($do, @l) = @_;

    @l = grep {
	my $p = pkgs::packageByName($do->{o}{packages}, $_);
	if ($p) {
	    $p->set_flag_requested(0);
	    $p->set_flag_required(0);
	}
	$p;
    } @l;
    run_program::rooted($::prefix, 'rpm', '-e', '--nodeps', @l);
}

################################################################################
package do_pkgs_standalone;
use run_program;
use common;
use log;

our @ISA = qw(do_pkgs_common);

sub new {
    my ($type, $o_in) = @_;
    bless { in => $o_in }, $type;
}

sub in {
    my ($do) = @_;
    $do->{in} ||= do {
	require interactive;
	interactive->vnew;
    };
    $do->{in};
}

sub install {
    my ($do, @l) = @_;

    return 1 if listlength(are_installed($do, @l)) == @l;

    if ($::testing) {
	log::l("i would install packages " . join(' ', @l));
	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;
    $ret;
}

sub are_available {
    my ($_do, @pkgs) = @_;
    my %pkgs = map { $_ => 1 } @pkgs;

    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}");
	}
	map { $_->name } grep { $pkgs{$_->name} } @{$urpm->{depslist} || []};
    };
    
}

sub what_provides {
    my ($_do, $name) = @_;
    split('\|', chomp_(run_program::get_stdout('urpmq', $name)));
}

sub is_installed {
    my ($do, $name) = @_;
    are_installed($do, $name);
}

sub are_installed {
    my ($_do, @l) = @_;
    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"
}

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;
    $ret;
}

sub remove_nodeps {
    my ($do, @l) = @_;
    remove($do, '--nodeps', @l) == 0;
}
generated by cgit v1.2.1 (git 2.21.0) at 2024-12-03 22:07:05 +0000