summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-04-12 14:40:16 +0000
committerFrancois Pons <fpons@mandriva.com>2000-04-12 14:40:16 +0000
commitf767bf7493bd00eae8719d5c590ef0c7366fe59a (patch)
treee9eda9c1697c3583194632466ec745daf960d097 /perl-install
parent270af6008741d1a94b885668072eb5fc51b906bc (diff)
downloaddrakx-f767bf7493bd00eae8719d5c590ef0c7366fe59a.tar
drakx-f767bf7493bd00eae8719d5c590ef0c7366fe59a.tar.gz
drakx-f767bf7493bd00eae8719d5c590ef0c7366fe59a.tar.bz2
drakx-f767bf7493bd00eae8719d5c590ef0c7366fe59a.tar.xz
drakx-f767bf7493bd00eae8719d5c590ef0c7366fe59a.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog7
-rw-r--r--perl-install/install2.pm3
-rw-r--r--perl-install/install_any.pm22
-rw-r--r--perl-install/install_steps.pm4
-rw-r--r--perl-install/install_steps_gtk.pm3
-rw-r--r--perl-install/pkgs.pm21
6 files changed, 52 insertions, 8 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 324746da4..56d23eefd 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,10 @@
+2000-04-12 François Pons <fpons@mandrakesoft.com>
+
+ * install2.pm: force installation step if package have been
+ selected on step choose packages.
+ * install_any.pm: protected against die in perl (setstep or
+ theme_changed).
+
2000-04-11 François Pons <fpons@mandrakesoft.com>
* resize_fat: added some limits verification.
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index d99fd741d..986ee9c56 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -357,6 +357,9 @@ sub choosePackages {
#- check pre-condition where base backage has to be selected.
pkgs::packageFlagSelected(pkgs::packageByName($o->{packages}, 'basesystem')) or die "basesystem package not selected";
+
+ #- check if there are package that need installation.
+ $o->{steps}{doInstallStep}{done} = 0 if $o->{steps}{doInstallStep}{done} && pkgs::packagesToInstall($o->{packages}) > 0;
}
}
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 67edf08b0..d180921bb 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -31,6 +31,9 @@ use log;
#- package that have to be copied for proper installation (just to avoid changing cdrom)
#- here XFree86 is copied entirey if not already installed, maybe better to copy only server.
@needToCopy = qw(
+XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
+XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
+XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs
XFree86 dhcpxd pump ppp ypbind rhs-printfilters samba ncpfs kernel-fb
);
@@ -61,6 +64,15 @@ sub relGetFile($) {
"base/": "RPMS$asked_medium/";
"Mandrake/$dir$_";
}
+sub askChangeMedium($$) {
+ my ($method, $medium) = @_;
+ my $allow;
+ do {
+ local $::no_theme_change = 1; #- avoid changing theme here!
+ eval { $allow = changeMedium($method, $medium) };
+ } while ($@); #- really it is not allowed to die in changeMedium!!! or install will cores with rpmlib!!!
+ $allow;
+}
sub errorOpeningFile($) {
my ($file) = @_;
$file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction.
@@ -72,7 +84,7 @@ sub errorOpeningFile($) {
cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| or return;
my $cdrom = $1;
ejectCdrom($cdrom);
- while ($max > 0 && changeMedium($::o->{method}, $asked_medium)) {
+ while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) {
$current_medium = $asked_medium;
eval { fs::mount($cdrom, "/tmp/rhimage", "iso9660", 'readonly') };
my $getFile = getFile($file); $getFile and return $getFile;
@@ -81,7 +93,7 @@ sub errorOpeningFile($) {
--$max;
}
} else {
- while ($max > 0 && changeMedium($::o->{method}, $asked_medium)) {
+ while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) {
$current_medium = $asked_medium;
my $getFile = getFile($file); $getFile and return $getFile;
$current_medium = 'unknown'; #- don't know what CD image has been copied.
@@ -136,11 +148,13 @@ sub setup_postinstall_rpms($$) {
require pkgs;
- #- compute closure of unselected package that may be copied.
+ #- compute closure of unselected package that may be copied,
+ #- don't complain if package does not exists as it may happen
+ #- for the various architecture taken into account (X servers).
my %toCopy;
foreach (@needToCopy) {
my $pkg = pkgs::packageByName($packages, $_);
- pkgs::selectPackage($packages, $pkg, 0, \%toCopy);
+ pkgs::selectPackage($packages, $pkg, 0, \%toCopy) if $pkg;
}
my @toCopy; push @toCopy, map { pkgs::packageByName($packages, $_) } keys %toCopy;
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index df669f465..cabd1e724 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -241,8 +241,8 @@ sub installPackages($$) { #- complete REWORK, TODO and TOCHECK!
}
#- small transaction will be built based on this selection and depslist.
- my @toInstall = grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagInstalled($_) } values %{$packages->[0]};
- pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $o->{packages}[1], $o->{packages}[2]);
+ my @toInstall = pkgs::packagesToInstall($packages);
+ pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $packages->[1], $packages->[2]);
}
sub afterInstallPackages($) {
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 97cc61553..889c4060d 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -689,7 +689,8 @@ sub create_steps_window {
my $w = new Gtk::Button('');
$w->set_name($t);
$w->set_usize(0, 7);
- gtksignal_connect($w, clicked => sub {
+ gtksignal_connect($w, clicked => sub {
+ $::no_theme_change and return; #- no theme wanted!
$::setstep or return; #- just as setstep s
install_theme($o, $t); die "theme_changed\n"
});
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 9cc164435..550e4cc26 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -200,6 +200,10 @@ sub packagesOfMedium {
my $medium = $packages->[2]{$mediumName};
grep { $_->{medium} == $medium } @{$packages->[1]};
}
+sub packagesToInstall {
+ my ($packages) = @_;
+ grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagInstalled($_) } values %{$packages->[0]};
+}
#- selection, unselection of package.
sub selectPackage($$;$$$) {
@@ -907,7 +911,7 @@ sub install($$$;$$) {
c::rpmtransFree($trans);
};
- c::rpmdepOrder($trans) or
+ c::rpmdepOrder($trans) or
cdie "error ordering package list: " . c::rpmErrorString(), sub {
&$close();
c::rpmdbClose($db);
@@ -918,6 +922,21 @@ sub install($$$;$$) {
my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, \&installCallback, 0);
log::l("rpmRunTransactions done");
+
+ my @badpkgs = map { $_->{file} } grep { !packageFlagInstalled($_) } @transToInstall;
+ @badpkgs > 0 and
+ cdie _("The following packages have not been installed because of errors: %s", join("\n", @badpkgs)), sub {
+ &$close();
+ c::rpmdbClose($db);
+ };
+ #- check for uninstalled package, avoid keeping them selected to avoid trying installing them
+ foreach (@transToInstall) {
+ if (!packageFlagInstalled($_)) {
+ log::l("bad package $_->{file}");
+ packageSetFlagSelected($_, 0);
+ }
+ }
+
&$close();
log::l("after close");
if (@probs) {