reworked medium management.

4 files changed, 23 insertions, 24 deletions

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;