From cb3afbddbc98accde27da668b88ce12790677bc6 Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Fri, 21 Sep 2001 15:05:48 +0000 Subject: reworked medium management. --- perl-install/install_any.pm | 2 +- perl-install/install_steps_gtk.pm | 6 +++--- perl-install/install_steps_interactive.pm | 7 +++---- perl-install/pkgs.pm | 32 +++++++++++++++---------------- 4 files changed, 23 insertions(+), 24 deletions(-) (limited to 'perl-install') diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index d35877bba..18bc4ead7 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -80,7 +80,7 @@ sub askChangeMedium($$) { do { eval { $allow = changeMedium($method, $medium) }; } while ($@); #- really it is not allowed to die in changeMedium!!! or install will cores with rpmlib!!! - $allow or $::o->{packages}{mediums}{$medium}{selected} = undef; #- disable selected if medium refused. + log::l($allow ? "accepting medium $medium" : "refusing medium $medium"); $allow; } sub errorOpeningFile($) { diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index a00fb8001..bed787d04 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -344,7 +344,7 @@ sub choosePackagesTree { }, node_state => sub { my $p = pkgs::packageByName($packages,$_[0]) or return; - pkgs::packageMedium($p)->{selected} or return; + pkgs::packageMedium($packages, $p)->{selected} or return; pkgs::packageFlagBase($p) and return 'base'; pkgs::packageFlagInstalled($p) and return 'installed'; pkgs::packageFlagSelected($p) and return 'selected'; @@ -376,7 +376,7 @@ sub choosePackagesTree { }, get_info => sub { my $p = pkgs::packageByName($packages, $_[0]) or return ''; - pkgs::extractHeaders($o->{prefix}, [$p], pkgs::packageMedium($p)); + pkgs::extractHeaders($o->{prefix}, [$p], pkgs::packageMedium($packages, $p)); pkgs::packageHeader($p) or die; my $imp = translate($pkgs::compssListDesc{pkgs::packageFlagBase($p) ? @@ -603,7 +603,7 @@ Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done. If you don't have it, press Cancel to avoid installation from this Cd-Rom.", $name), 1); #- add the elapsed time (otherwise the predicted time will be rubbish) $start_time += time() - $time; - $r; + return $r; }; }; my $install_result; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 4751d2bda..68c53295d 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -538,7 +538,7 @@ sub choosePackagesTree { $o->ask_many_from_list('', _("Choose the packages you want to install"), { - list => [ #grep { pkgs::packageMedium($_)->{selected} } + list => [ map { pkgs::packageByName($packages, $_) } keys %{$packages->{names}} ], value => \&pkgs::packageFlagSelected, @@ -676,7 +676,7 @@ sub chooseCD { my @mediumsDescr = (); my %mediumsDescr = (); - if (!common::usingRamdisk()) { + if (0 && !common::usingRamdisk()) { #- mono-cd in case of no ramdisk undef $packages->{mediums}{$_}{selected} foreach @mediums; log::l("low memory install, using single CD installation (as it is not ejectable)"); @@ -744,7 +744,6 @@ sub installPackages { #- if not using a cdrom medium, always abort. $method eq 'cdrom' and do { - local $my_gtk::grab = 1; #- only used with install_step_gtk or safely ignored. my $name = pkgs::mediumDescr($o->{packages}, $medium); local $| = 1; print "\a"; my $r = $name !~ /Application/ || ($o->{useless_thing_accepted2} ||= $o->ask_from_list_('', formatAlaTeX($com_license), [ __("Accept"), __("Refuse") ], "Accept") eq "Accept"); @@ -752,7 +751,7 @@ sub installPackages { Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done. If you don't have it, press Cancel to avoid installation from this Cd-Rom.", $name), 1); - $r; + return $r; }; }; my $install_result; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index c7727c40d..f44fff788 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -100,8 +100,8 @@ sub packageSetFlagBase { $_[0] or die "invalid package from\n" . backtrace( sub packageSetFlagUpgrade { $_[0] or die "invalid package from\n" . backtrace(); $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_UPGRADE) : ($_[0]->[$FLAGS] &= ~$PKGS_UPGRADE); } -sub packageMedium { $_[0] or die "invalid package from\n" . backtrace(); - $_[0]->[$MEDIUM] } +sub packageMedium { my ($packages, $p) = @_; $p or die "invalid package from\n" . backtrace(); + $packages->{mediums}{$p->[$MEDIUM]} } sub packageProvides { $_[1] or die "invalid package from\n" . backtrace(); map { $_[0]->{depslist}[$_] || die "unkown package id $_" } unpack "s*", $_[1]->[$PROVIDES] } @@ -194,13 +194,13 @@ sub packageById { $l && @$l && $l; } sub packagesOfMedium { - my ($packages, $mediumName) = @_; - my $medium = $packages->{mediums}{$mediumName}; + my ($packages, $medium) = @_; grep { $_ && $_->[$MEDIUM] == $medium } @{$packages->{depslist}}; } sub packagesToInstall { my ($packages) = @_; - grep { packageFlagSelected($_) && !packageFlagInstalled($_) && $_->[$MEDIUM]{selected} } values %{$packages->{names}}; + grep { packageFlagSelected($_) && !packageFlagInstalled($_) && + packageMedium($packages, $_)->{selected} } values %{$packages->{names}}; } sub allMediums { @@ -220,7 +220,7 @@ sub selectPackage { #($$;$$$) #- selected, the package cannot be selected. #- check if the same or better version is installed, #- do not select in such case. - $pkg && $pkg->[$MEDIUM]{selected} && !packageFlagInstalled($pkg) or return; + $pkg && packageMedium($packages, $pkg)->{selected} && !packageFlagInstalled($pkg) or return; #- avoid infinite recursion (mainly against badly generated depslist.ordered). $check_recursion ||= {}; exists $check_recursion->{$pkg->[$FILE]} and return; $check_recursion->{$pkg->[$FILE]} = undef; @@ -438,7 +438,7 @@ sub psUsingHdlist { foreach (@{$packer->{files}}) { $packer->{data}{$_}[0] eq 'f' or next; ++$packages->{count}; #- take care of this one, so that desplist will be clean with index of package. - my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $_; $pkg->[$MEDIUM] = $m; + my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $_; $pkg->[$MEDIUM] = $medium; my $specific_arch = packageArch($pkg); if (!$specific_arch || MDK::Common::System::compat_arch($specific_arch)) { my $old_pkg = $packages->{names}{packageName($pkg)}; @@ -485,7 +485,7 @@ sub getOtherDeps($$) { packageVersion($pkg), " or $release ne ", packageRelease($pkg), ")"), next; my $index = scalar @{$packages->{depslist}}; - $index >= $pkg->[$MEDIUM]{min} && $index <= $pkg->[$MEDIUM]{max} + $index >= packageMedium($packages, $pkg)->{min} && $index <= packageMedium($packages, $pkg)->{max} or log::l("ignoring package $name-$version-$release in depslist outside of hdlist indexation"); #- here we have to translate referenced deps by name to id. @@ -552,7 +552,7 @@ sub getDeps { #- above warning have chance to raise an exception here, but may help #- for debugging. my $i = scalar @{$packages->{depslist}}; - $i >= $pkg->[$MEDIUM]{min} && $i <= $pkg->[$MEDIUM]{max} or + $i >= packageMedium($packages, $pkg)->{min} && $i <= packageMedium($packages, $pkg)->{max} or log::l("inconsistency in position for $name-$version-$release.$arch in depslist and hdlist"), $mismatch = 1; } @@ -1271,8 +1271,8 @@ sub install($$$;$$) { my $callbackOpen = sub { my $p = $packages{$_[0]} or log::l("unable to retrieve package of $_[0]"), return -1; my $f = packageFile($p); - print LOG "$f $p->[$MEDIUM]{descr}\n"; - my $fd = install_any::getFile($f, $p->[$MEDIUM]{descr}); + print LOG "$f $media->{$p->[$MEDIUM]}{descr}\n"; + my $fd = install_any::getFile($f, $media->{$p->[$MEDIUM]}{descr}); $fd ? fileno $fd : -1; }; my $callbackClose = sub { packageSetFlagInstalled($packages{$_[0]}, 1) }; @@ -1304,7 +1304,7 @@ sub install($$$;$$) { while ($i <= $media->{$medium}{max} && ($i < $min || scalar @transToInstall < $limitMinTrans)) { my $pkg = $depOrder->[$i++] or next; my $dep = $packages{packageName($pkg)} or next; - if ($dep->[$MEDIUM]{selected}) { + if ($media->{$dep->[$MEDIUM]}{selected}) { push @transToInstall, $dep; foreach (map { split '\|' } packageDepsId($dep)) { $min < $_ and $min = $_; @@ -1332,7 +1332,7 @@ sub install($$$;$$) { #- reset file descriptor open for main process but #- make sure error trying to change from hdlist are #- trown from main process too. - install_any::getFile(packageFile($transToInstall[0]), $transToInstall[0][$MEDIUM]{descr}); + install_any::getFile(packageFile($transToInstall[0]), $media->{$transToInstall[0][$MEDIUM]}{descr}); } #- and make sure there are no staling open file descriptor too (before forking)! install_any::getFile('XXX'); @@ -1392,7 +1392,7 @@ sub install($$$;$$) { my $check_installed; c::rpmdbNameTraverse($db, packageName($p), sub { my ($header) = @_; - $check_installed = c::headerGetEntry($header, 'version') eq packageVersion($p) && c::headerGetEntry($header, 'release') eq packageRelease($p); + $check_installed ||= c::headerGetEntry($header, 'version') eq packageVersion($p) && c::headerGetEntry($header, 'release') eq packageRelease($p); }); $check_installed and print OUTPUT "close:$_[0]\n"; }, sub { #- installCallback @@ -1459,7 +1459,7 @@ sub install($$$;$$) { unless ($retry_package) { my @badPackages; foreach (@transToInstall) { - if (!packageFlagInstalled($_) && $_->[$MEDIUM]{selected} && !exists($ignoreBadPkg{packageName($_)})) { + if (!packageFlagInstalled($_) && $media->{$_->[$MEDIUM]}{selected} && !exists($ignoreBadPkg{packageName($_)})) { push @badPackages, $_; log::l("bad package $_->[$FILE]"); } else { @@ -1471,7 +1471,7 @@ sub install($$$;$$) { $retry_package = shift @transToInstall; $retry_count = 3; } else { - if (!packageFlagInstalled($retry_package) && $retry_package->[$MEDIUM]{selected} && !exists($ignoreBadPkg{packageName($retry_package)})) { + if (!packageFlagInstalled($retry_package) && $media->{$retry_package->[$MEDIUM]}{selected} && !exists($ignoreBadPkg{packageName($retry_package)})) { if ($retry_count) { log::l("retrying installing package $retry_package->[$FILE] alone in a transaction"); --$retry_count; -- cgit v1.2.1