summaryrefslogtreecommitdiffstats
path: root/perl-install/do_pkgs.pm
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2005-05-25 08:56:46 +0000
committerMystery Man <unknown@mandriva.org>2005-05-25 08:56:46 +0000
commit45e61de16e073594e8532af5b1fff8e76901ee88 (patch)
treeeda23f712150bace0146c6011c39319484f1a715 /perl-install/do_pkgs.pm
parent2be3766b2c1fafa44da4b93b2851044d977a128a (diff)
downloaddrakx-backup-do-not-use-MDK10-LACIE-restore-2.tar
drakx-backup-do-not-use-MDK10-LACIE-restore-2.tar.gz
drakx-backup-do-not-use-MDK10-LACIE-restore-2.tar.bz2
drakx-backup-do-not-use-MDK10-LACIE-restore-2.tar.xz
drakx-backup-do-not-use-MDK10-LACIE-restore-2.zip
This commit was manufactured by cvs2svn to create tagMDK10-LACIE-restore-2
'MDK10-LACIE-restore-2'.
Diffstat (limited to 'perl-install/do_pkgs.pm')
-rw-r--r--perl-install/do_pkgs.pm238
1 files changed, 0 insertions, 238 deletions
diff --git a/perl-install/do_pkgs.pm b/perl-install/do_pkgs.pm
deleted file mode 100644
index f8ed44028..000000000
--- a/perl-install/do_pkgs.pm
+++ /dev/null
@@ -1,238 +0,0 @@
-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;
- $do->install($pkg) or return;
- }
- if ($o_file && ! -e "$::prefix$o_file") {
- $do->in->ask_warn('', N("Mandatory package %s is missing", $pkg));
- 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;
- $do->install($pkg) or 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 ($short_name) = $base_name =~ /^(.*)-kernel$/;
- my @rpms = $do->are_available("dkms-$short_name",
- 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;
-}