From f1669da7e3a6ce5f267dc5aec5d14f6814a0a6af Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Fri, 9 Jan 2004 18:02:00 +0000 Subject: new do_pkgs package which get rid of pkgs_interactive::* which was in install_any and standalone, and partially duplicated --- perl-install/do_pkgs.pm | 218 ++++++++++++++++++++++++++++++++++++++++++++ perl-install/interactive.pm | 6 ++ perl-install/standalone.pm | 129 -------------------------- 3 files changed, 224 insertions(+), 129 deletions(-) create mode 100644 perl-install/do_pkgs.pm diff --git a/perl-install/do_pkgs.pm b/perl-install/do_pkgs.pm new file mode 100644 index 000000000..baf96b7f0 --- /dev/null +++ b/perl-install/do_pkgs.pm @@ -0,0 +1,218 @@ +package do_pkgs; # $Id$ +use common; + +sub new { + my ($type, $in) = @_; + bless { in => $in }, $type; +} + +sub vnew { + my ($_type, $in) = @_; + ($::isInstall ? 'do_pkgs_during_install' : 'do_pkgs_standalone')->new($in); +} + +sub ensure_is_installed { + my ($do, $pkg, $file, $b_auto) = @_; + + if (! -e "$::prefix$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); + } + if (! -e "$::prefix$file") { + $do->{in}->ask_warn('', N("Mandatory package %s is missing", $pkg)); + return; + } + 1; +} + +sub is_installed { + my ($do, $name) = @_; + $do->are_installed($name); +} + +################################################################################ +package do_pkgs_during_install; +use run_program; +use common; + +our @ISA = qw(do_pkgs); + +sub new { + my ($type, $in) = @_; + require pkgs; + bless { in => $in, o => $::o }, $type; +} + +sub install { + my ($do, @l) = @_; + log::l("do_pkgs_during_install::install"); + if ($::testing) { + log::l("i would install packages " . join(' ', @l)); + return 1; + } else { + $do->{o}->pkg_install(@l); + } +} + +sub check_kernel_module_packages { + my ($do, $base_name, $o_ext_name) = @_; + + if (!$o_ext_name || pkgs::packageByName($do->{o}{packages}, $o_ext_name)) { + my @rpms; + foreach my $p (@{$do->{o}{packages}{depslist}}) { + my ($ext, $version_release) = $p->name =~ /kernel[^\-]*(-smp|-enterprise|-secure|-i686-up-4GB)?(?:-([^\-]+))?$/ + or next; + $p->flag_available or next; + my $name = "$base_name$ext-$version_release"; + pkgs::packageByName($do->{o}{packages}, $name) or next; + log::l("found kernel module packages $name"); + push @rpms, $name; + } + @rpms > 0 and return [ @rpms, if_($o_ext_name, $o_ext_name) ]; + } + return undef; +} + +sub what_provides { + my ($do, $name) = @_; + map { $do->{o}{packages}{depslist}[$_]->name } keys %{$do->{o}{packages}{provides}{$name} || {}}; +} + +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); + +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"); + my $ret = system('urpmi', '--allow-medium-change', '--auto', '--best-output', '--no-verify-rpm', @l) == 0; + $do->{in}->resume; + $ret; +} + +sub check_kernel_module_packages { + my ($_do, $base_name, $o_ext_name) = @_; + my ($result, %list, %select); + my @rpm_qa if 0; + + #- initialize only once from rpm -qa output... + @rpm_qa or @rpm_qa = `rpm -qa`; + + 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}"); + } + foreach (@{$urpm->{depslist} || []}) { + $_->name eq $o_ext_name and $list{$_->name} = 1; + $_->name =~ /$base_name/ and $list{$_->name} = 1; + } + foreach (@rpm_qa) { + my ($name) = /(.*?)-[^-]*-[^-]*$/ or next; + $name eq $o_ext_name and $list{$name} = 0; + $name =~ /$base_name/ and $list{$name} = 0; + } + }; + if (!$o_ext_name || exists $list{$o_ext_name}) { + eval { + my ($version_release, $ext); + if (c::kernel_version() =~ /([^-]*)-([^-]*mdk)(\S*)/) { + $version_release = "$1.$2"; + $ext = $3 ? "-$3" : ""; + exists $list{"$base_name$ext-$version_release"} or die "no $base_name for current kernel"; + $list{"$base_name$ext-$version_release"} and $select{"$base_name$ext-$version_release"} = 1; + } else { + #- kernel version is not recognized, what to do ? + } + foreach (@rpm_qa) { + ($ext, $version_release) = /kernel[^\-]*(-smp|-enterprise|-secure)?(?:-([^\-]+))$/; + $list{"$base_name$ext-$version_release"} and $select{"$base_name$ext-$version_release"} = 1; + } + $result = [ keys(%select), if_($o_ext_name, $o_ext_name) ]; + } + } + return $result; +} + +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); #- don't care about the return value + intersection(\@l, [ chomp_(@l2) ]); #- can't 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; +} diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 2cb1afa31..cb6f3c74a 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -119,6 +119,12 @@ sub resume {} sub end {} sub exit { exit($_[0]) } +sub do_pkgs { + my ($in) = @_; + require do_pkgs; + do_pkgs->vnew($in); +} + #-###################################################################################### #- Interactive functions #-###################################################################################### diff --git a/perl-install/standalone.pm b/perl-install/standalone.pm index 5c5162d20..8f8299282 100644 --- a/perl-install/standalone.pm +++ b/perl-install/standalone.pm @@ -146,135 +146,6 @@ Copyright (C) 1999-2003 MandrakeSoft by } ################################################################################ -package pkgs_interactive; - -use run_program; -use common; -require 'log.pm'; - -our @ISA = qw(); #- tell perl_checker this is a class - -sub interactive::do_pkgs { - my ($in) = @_; - bless { in => $in }, 'pkgs_interactive'; -} - -sub install { - my ($o, @l) = @_; - - return 1 if is_installed($o, @l); - - if ($::testing) { - log::l("i would install packages " . join(' ', @l)); - return 1; - } - - my $wait = $o->{in}->wait_message('', N("Installing packages...")); - $o->{in}->suspend; - log::explanations("installed packages @l"); - my $ret = system('urpmi', '--allow-medium-change', '--auto', '--best-output', '--no-verify-rpm', @l) == 0; - $o->{in}->resume; - $ret; -} - -sub ensure_is_installed { - my ($o, $pkg, $file, $b_auto) = @_; - - if (! -e $file) { - $o->{in}->ask_okcancel('', N("The package %s needs to be installed. Do you want to install it?", $pkg), 1) - or return if !$b_auto; - $o->{in}->do_pkgs->install($pkg); - } - if (! -e $file) { - $o->{in}->ask_warn('', N("Mandatory package %s is missing", $pkg)); - return; - } - 1; -} - -sub check_kernel_module_packages { - my ($_o, $base_name, $o_ext_name) = @_; - my ($result, %list, %select); - my @rpm_qa if 0; - - #- initialize only once from rpm -qa output... - @rpm_qa or @rpm_qa = `rpm -qa`; - - 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}"); - } - foreach (@{$urpm->{depslist} || []}) { - $_->name eq $o_ext_name and $list{$_->name} = 1; - $_->name =~ /$base_name/ and $list{$_->name} = 1; - } - foreach (@rpm_qa) { - my ($name) = /(.*?)-[^-]*-[^-]*$/ or next; - $name eq $o_ext_name and $list{$name} = 0; - $name =~ /$base_name/ and $list{$name} = 0; - } - }; - if (!$o_ext_name || exists $list{$o_ext_name}) { - eval { - my ($version_release, $ext); - if (c::kernel_version() =~ /([^-]*)-([^-]*mdk)(\S*)/) { - $version_release = "$1.$2"; - $ext = $3 ? "-$3" : ""; - exists $list{"$base_name$ext-$version_release"} or die "no $base_name for current kernel"; - $list{"$base_name$ext-$version_release"} and $select{"$base_name$ext-$version_release"} = 1; - } else { - #- kernel version is not recognized, what to do ? - } - foreach (@rpm_qa) { - ($ext, $version_release) = /kernel[^\-]*(-smp|-enterprise|-secure)?(?:-([^\-]+))$/; - $list{"$base_name$ext-$version_release"} and $select{"$base_name$ext-$version_release"} = 1; - } - $result = [ keys(%select), if_($o_ext_name, $o_ext_name) ]; - } - } - return $result; -} - -sub what_provides { - my ($_o, $name) = @_; - split('\|', chomp_(run_program::get_stdout('urpmq', $name))); -} - -sub is_installed { - my ($o, $name) = @_; - are_installed($o, $name); -} - -sub are_installed { - my ($_o, @l) = @_; - my @l2; - run_program::run('/bin/rpm', '>', \@l2, '-q', '--qf', "%{name}\n", @l); #- don't care about the return value - intersection(\@l, [ chomp_(@l2) ]); #- can't return directly @l2 since it contains things like "package xxx is not installed" -} - -sub remove { - my ($o, @l) = @_; - my $_wait = $o->{in}->wait_message('', N("Removing packages...")); - $o->{in}->suspend; - log::explanations("removed packages @l"); - my $ret = system('rpm', '-e', @l) == 0; - $o->{in}->resume; - $ret; -} - -sub remove_nodeps { - my ($o, @l) = @_; - remove($o, '--nodeps', @l) == 0; -} - -################################################################################ - - -package standalone; #- stuff will go to special /var/log/explanations file my $standalone_name; -- cgit v1.2.1