- much simpler --auto-select algorithm

  (fixes #35718, ie auto-selecting with strict-arch)
  (!! DANGEROUS CHANGE !!)

1 files changed, 67 insertions, 107 deletions

diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index eb9bfef..b7c07cd 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -1430,133 +1430,93 @@ sub compute_flags {
     }
 }
 
-#- select packages to upgrade, according to package already registered.
-#- by default, only takes best package and its obsoleted and compute
-#- all installed or upgrade flag.
-#- (used for --auto-select)
-#-
-#- side-effects: 
-#-   + those of _request_packages_to_upgrade_2 (flag_install, flag_upgrade)
-sub request_packages_to_upgrade {
-    my ($urpm, $db, $_state, $requested, %options) = @_;
+#- side-effects: none
+sub _choose_best_pkg {
+    my ($urpm, $pkg_installed, @pkgs) = @_;
 
-    my ($names, $obsoletes) = _request_packages_to_upgrade_1($urpm, %options) or return;
-    _request_packages_to_upgrade_2($urpm, $db, $requested, $names, $obsoletes, %options);
+    _choose_best_pkg_($urpm, $pkg_installed, grep {
+	$_->compare_pkg($pkg_installed) > 0;
+    } @pkgs);
 }
 
 #- side-effects: none
-sub _request_packages_to_upgrade_1 {
-    my ($urpm, %options) = @_;
-    my (%names, %skip);
-
-    my @idlist = $urpm->build_listid($options{start}, $options{end}, $options{idlist}) or return;
-    
-    #- build direct access to best package per name.
-    foreach my $pkg (@{$urpm->{depslist}}[@idlist]) {
-
-	if ($pkg->is_arch_compat) {
-	    my $p = $names{$pkg->name};
-	    !$p || $pkg->compare_pkg($p) > 0 and $names{$pkg->name} = $pkg;
+sub _choose_best_pkg_ {
+    my ($urpm, $pkg_installed, @pkgs) = @_;
+
+    my $best;
+    foreach my $pkg (grep {
+	!strict_arch($urpm) || strict_arch_check($pkg_installed, $_);
+    } @pkgs) {
+	if (!$best || ($pkg->compare_pkg($best) || $pkg->id < $best->id) > 0) {
+	    $best = $pkg;
 	}
     }
+    $best;
+}
 
-    #- cleans up direct access, a package in %names should have
-    #- checked consistency with obsoletes of eligible packages.
-    #- It is important to avoid selecting a package that obsoletes
-    #- an old one.
-    my %obsoletes;
-    foreach my $pkg (values %names) {
-	foreach ($pkg->obsoletes) {
-	    if (my ($n, $o, $v) = property2name_op_version($_)) {
-		if ($n ne $pkg->name && $names{$n} && (!$o || eval($names{$n}->compare($v) . $o . 0))) {
-		    #- an existing best package is obsoleted by another one.
-		    $skip{$n} = undef;
-		}
-		push @{$obsoletes{$n}}, $pkg;
-	    }
-	}
-    }
+#- side-effects: none
+sub _choose_bests_obsolete {
+    my ($urpm, $db, $pkg_installed, @pkgs) = @_;
+
+    _set_flag_installed_and_upgrade_if_no_newer($db, $_) foreach @pkgs;
 
-    #- ignore skipped packages.
-    delete @names{keys %skip};
+    my %by_name;
+    push @{$by_name{$_->name}}, $_ foreach grep { $_->flag_upgrade } @pkgs;
 
-    \%names, \%obsoletes;
+    map { _choose_best_pkg_($urpm, $pkg_installed, @$_) } values %by_name;
 }
 
-#- side-effects: flag_installed, flag_upgrade
-sub _request_packages_to_upgrade_2 {
-    my ($_urpm, $db, $requested, $names, $obsoletes, %options) = @_;
-    my %names = %$names;
-    my (%requested, @obsoleters);
+#- select packages to upgrade, according to package already registered.
+#- by default, only takes best package and its obsoleted and compute
+#- all installed or upgrade flag.
+#- (used for --auto-select)
+#-
+#- side-effects: $requisted, flag_installed, flag_upgrade
+sub request_packages_to_upgrade {
+    my ($urpm, $db, $state, $requested, %options) = @_;
+
+    my %by_name;
 
     #- now we can examine all existing packages to find packages to upgrade.
     $db->traverse(sub {
-	my ($p) = @_;
-	my $pn = $p->name;
-	#- first try with package using the same name.
-	#- this will avoid selecting all packages obsoleting an old one.
-	if (my $pkg = $names{$pn}) {
-	    my $may_upgrade = $pkg->flag_upgrade || #- it is has already been flagged upgradable
-	         !$pkg->flag_installed && do {
-		     $pkg->set_flag_installed; #- there is at least one package installed (whatever its version).
-		     1;
-		 };
-	    if ($may_upgrade && $pkg->compare_pkg($p) > 0) {
-		#- keep in mind the package is requested.
-		$pkg->set_flag_upgrade;
-		$requested{$pn} = undef;
-	    } else {
-		delete $names{$pn};
-	    }
-	}
-
-	#- check provides of existing package to see if an obsolete
-	#- may allow selecting it.
-	foreach my $property ($p->provides) {
-	    #- only real provides should be taken into account, this means internal obsoletes
-	    #- should be avoided.
-	    unless ($p->obsoletes_overlap($property)) {
-		if (my $n = property2name($property)) {
-		    foreach my $pkg (@{$obsoletes->{$n} || []}) {
-			next if $pkg->name eq $pn || $pn ne $n || !$names{$pkg->name};
-			if ($pkg->obsoletes_overlap($property)) {
-			    #- the package being examined can be obsoleted.
-			    #- do not set installed and provides flags.
-			    push @obsoleters, $pkg;
-			    return;
-			}
-		    }
+	my ($pkg_installed) = @_;
+	my $name = $pkg_installed->name;
+
+	my $pkg;
+	if (exists $by_name{$name}) {
+	    if (my $p = $by_name{$name}) {
+		#- here a pkg with the same name is installed twice
+		if ($p->compare_pkg($pkg_installed) > 0) {
+		    #- we selected $p, and it is still a valid choice
+		    $pkg = $p;
+		} else {
+		    #- $p is no good since $pkg_installed is higher version,
 		}
 	    }
+	} elsif ($pkg = _choose_best_pkg($urpm, $pkg_installed, $urpm->packages_by_name($name))) {
+	    #- first try with package using the same name.
+	    $pkg->set_flag_installed;
+	    $pkg->set_flag_upgrade;
 	}
-    });
-
-    #- examine all obsoleter packages, compute installer and upgrade flag if needed.
-    foreach my $pkg (@obsoleters) {
-	next if !$names{$pkg->name};
-
-	_set_flag_installed_and_upgrade_if_no_newer($db, $pkg);
-
-	if ($pkg->flag_installed && !$pkg->flag_upgrade) {
-	    delete $names{$pkg->name};
-	} else {
-	    $requested{$pkg->name} = undef;
+	if (my @pkgs = _choose_bests_obsolete($urpm, $db, $pkg_installed, _find_packages_obsoleting($urpm, $state, $pkg_installed))) {
+	    if (@pkgs == 1) {
+		$pkg and $urpm->{debug_URPM}("auto-select: prefering " . $pkgs[0]->fullname . " obsoleting " .  $pkg_installed->fullname . " over " . $pkg->fullname) if $urpm->{debug_URPM};
+		$pkg = $pkgs[0];
+	    } elsif (@pkgs > 1) {
+		$urpm->{debug_URPM}("auto-select: multiple packages (" . join(' ', map { scalar $_->fullname } @pkgs) . ") obsoleting " . $pkg_installed->fullname) if $urpm->{debug_URPM};
+		$pkg = undef;
+	    }
 	}
-    }
 
-    #- examine all packages which may be conflicting. If a package conflicts, it should not be requested.
-    my @names = map { $_->name . " == " . $_->epoch . ":" . $_->version . "-" . $_->release } values %names;
-    my @pkgs = values %names;
-    foreach my $pkg (@pkgs) {
-	exists $requested{$pkg->name} or next;
-	foreach my $conflict ($pkg->conflicts) {
-	    delete @names{map { /(\S*)/ && $1 } grep { ranges_overlap($conflict, $_) } @names};
-	}
-    }
+	$pkg and $urpm->{debug_URPM}("auto-select: adding " . $pkg->fullname . " replacing " .  $pkg_installed->fullname) if $urpm->{debug_URPM};
+	    
+	$by_name{$name} = $pkg;		    
+    });
 
-    #- examine all packages potentially selectable.
-    foreach my $pkg (values %names) {
-	exists $requested{$pkg->name} and $requested->{$pkg->id} = $options{requested};
+    foreach my $pkg (values %by_name) {
+	$pkg or next;
+	$pkg->set_flag_upgrade;
+	$requested->{$pkg->id} = $options{requested};
     }
 
     $requested;