When an rpm installed locally had a version greater than the one found

in the update media, urpmi was trying to downgrade it.

1 files changed, 97 insertions, 77 deletions

diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index 3b0e5ad..cc82462 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -55,7 +55,7 @@ sub find_chosen_packages {
 		$pkg->flag_skip || exists $state->{rejected}{$pkg->fullname} and next;
 		#- check if at least one provide of the package overlap the property (if sense are needed).
 		if (!$urpm->{provides}{$name}{$_} || $pkg->provides_overlap($property)) {
-		    #- determine if this packages is better than a possibly previously chosen package.
+		    #- determine if this package is better than a possibly previously chosen package.
 		    $pkg->flag_selected || exists $state->{selected}{$pkg->id} and return $pkg;
 		    if (my $p = $packages{$pkg->name}) {
 			$pkg->flag_requested > $p->flag_requested ||
@@ -71,10 +71,11 @@ sub find_chosen_packages {
     if (keys(%packages) > 1) {
 	my ($mode, @chosen, @chosen_good_locales, @chosen_bad_locales, @chosen_other);
 
-	#- package should be prefered if one of their provides is referenced
-	#- in requested hash or package itself is requested (or required).
-	#- if there is no preference choose the first one (higher probability
-	#- of being chosen) by default and ask user.
+	#- packages should be preferred if one of their provides is referenced
+	#- in the "requested" hash, or if the package itself is requested (or
+	#- required).
+	#- If there is no preference, choose the first one by default (higher
+	#- probability of being chosen) and ask the user.
 	foreach my $p (values(%packages)) {
 	    unless ($p->flag_upgrade || $p->flag_installed) {
 		#- assume for this small algorithm package to be upgradable.
@@ -102,8 +103,9 @@ sub find_chosen_packages {
 	    push @chosen, $p;
 	}
 
-	#- packages that requires locales-xxx and the corresponding locales is already installed
-	#- should be prefered over packages that requires locales not installed.
+	#- packages that require locales-xxx when the corresponding locales are
+	#- already installed should be preferred over packages that require locales
+	#- which are not installed.
 	foreach (@chosen) {
 	    if (my ($specific_locales) = grep { /locales-/ && ! /locales-en/ } $_->requires_nosense) {
 		if ((grep { $urpm->{depslist}[$_]->flag_available } keys %{$urpm->{provides}{$specific_locales}}) > 0 ||
@@ -116,7 +118,8 @@ sub find_chosen_packages {
 		push @chosen_other, $_;
 	    }
 	}
-	#- sort package in order to have best ones first (this means good locales, no locales, bad locales).
+	#- sort packages in order to have preferred ones first
+	#- (this means good locales, no locales, bad locales).
 	return (sort { $a->id <=> $b->id } @chosen_good_locales),
 	       (sort { $a->id <=> $b->id } @chosen_other),
 	       (sort { $a->id <=> $b->id } @chosen_bad_locales);
@@ -370,14 +373,20 @@ sub resolve_rejected {
     $options{unsatisfied} and push @{$options{unsatisfied}}, map { { required => $_, rejected => $pkg->fullname, } } @unsatisfied;
 }
 
-#- resolve requested, keep resolution state to speed process.
-#- a requested package is marked to be installed, once done, a upgrade flag or
-#- installed flag is set according to needs of package.
-#- other required package will have required flag set along with upgrade flag or
-#- installed flag.
-#- base flag should always been installed or upgraded.
-#- the following options are recognized :
-#-   check : check requires of installed packages.
+#- Resolve dependencies of requested packages; keep resolution state to
+#- speed up process.
+#- A requested package is marked to be installed; once done, an upgrade flag or
+#- an installed flag is set according to the needs of the installation of this
+#- package.
+#- Other required packages will have a required flag set along with an upgrade
+#- flag or an installed flag.
+#- Base flag should always be "installed" or "upgraded".
+#- The following options are recognized :
+#-   callback_choices : subroutine to be called to ask the user to choose
+#-     between several possible packages.
+#-   keep_requested_flag :
+#-   keep_unrequested_dependencies :
+#-   keep :
 sub resolve_requested {
     my ($urpm, $db, $state, $requested, %options) = @_;
     my ($dep, @diff_provides, @properties, @selected);
@@ -414,22 +423,24 @@ sub resolve_requested {
 	    #- take the best choice possible.
 	    my @chosen = $urpm->find_chosen_packages($db, $state, $dep->{required});
 
-	    #- if no choice are given, this means that nothing possible can be selected
-	    #- according to $dep, we need to retry the selection allowing all packages that
-	    #- conflicts or anything similar to see which strategy can be tried.
-	    #- backtracked is used to avoid trying multiple times the same packages.
-	    #- if multiple packages are possible, simply ask the user which one to choose.
-	    #- else take the first one available.
+	    #- If no choice is found, this means that nothing can be possibly selected
+	    #- according to $dep, so we need to retry the selection, allowing all
+	    #- packages that conflict or anything similar to see which strategy can be
+	    #- tried. Backtracking is used to avoid trying multiple times the same
+	    #- packages. If multiple packages are possible, simply ask the user which
+	    #- one to choose; else take the first one available.
 	    if (!@chosen) {
 		unshift @properties, $urpm->backtrack_selected($db, $state, $dep, %options);
 		next; #- backtrack code choose to continue with same package or completely new strategy.
 	    } elsif ($options{callback_choices} && @chosen > 1) {
-		unshift @properties, map { +{ required => $_->id,
-					      choices => $dep->{required},
-					      exists $dep->{from} ? (from => $dep->{from}) : @{[]},
-					      exists $dep->{requested} ? (requested => $dep->{requested}) : @{[]},
-					    }
-				       } grep { ref $_ } $options{callback_choices}->($urpm, $db, $state, \@chosen);
+		unshift @properties, map {
+		    +{
+			required => $_->id,
+			choices => $dep->{required},
+			exists $dep->{from} ? (from => $dep->{from}) : @{[]},
+			exists $dep->{requested} ? (requested => $dep->{requested}) : @{[]},
+		    }
+		} grep { ref } $options{callback_choices}->($urpm, $db, $state, \@chosen);
 		next; #- always redo according to choices.
 	    }
 
@@ -448,7 +459,8 @@ sub resolve_requested {
 		    $pkg->set_flag_upgrade;
 		    $db->traverse_tag('name', [ $pkg->name ], sub {
 					  my ($p) = @_;
-					  $pkg->set_flag_installed; #- there is at least one package installed (whatever its version).
+					  #- there is at least one package installed (whatever its version).
+					  $pkg->set_flag_installed;
 					  $pkg->flag_upgrade and $pkg->set_flag_upgrade($pkg->compare_pkg($p) > 0);
 				      });
 		}
@@ -501,49 +513,54 @@ sub resolve_requested {
 			}
 			#- examine rpm db too (but only according to packages name as a fix in rpm itself)
 			$db->traverse_tag('name', [ $n ], sub {
-					      my ($p) = @_;
-
-					      #- without an operator, anything (with the same name) is matched.
-					      #- with an operator, check with package EVR with the obsoletes EVR.
-					      my $satisfied = !$o || eval($p->compare($v) . $o . 0);
-					      $p->name eq $pkg->name || $satisfied or return;
-
-					      #- do not propagate now the broken dependencies as they are
-					      #- computed later.
-					      my $rv = $state->{rejected}{$p->fullname} ||= {};
-					      $rv->{closure}{$pkg->fullname} = undef;
-					      $rv->{size} = $p->size;
-
-					      if ($p->name eq $pkg->name) {
-						  #- all packages older than the current one are obsoleted,
-						  #- the others are simply removed (the result is the same).
-						  if ($satisfied) {
-						      $rv->{obsoleted} = 1;
-						  } else {
-						      $rv->{closure}{$pkg->fullname} = { old_requested => 1 };
-						      $rv->{removed} = 1;
-						      ++$state->{oldpackage};
-						  }
-					      } else {
-						  $rv->{obsoleted} = 1;
-					      }
+				my ($p) = @_;
+
+				#- without an operator, anything (with the same name) is matched.
+				#- with an operator, check package EVR with the obsoletes EVR.
+				#- $satisfied is true if installed package has version newer or equal.
+				my $comparison = $p->compare($v);
+				my $satisfied = !$o || eval($comparison . $o . 0);
+				$p->name eq $pkg->name || $satisfied or return;
+
+				#- do not propagate now the broken dependencies as they are
+				#- computed later.
+				my $rv = $state->{rejected}{$p->fullname} ||= {};
+				$rv->{closure}{$pkg->fullname} = undef;
+				$rv->{size} = $p->size;
+
+				if ($p->name eq $pkg->name) {
+				    #- all packages older than the current one are obsoleted,
+				    #- the others are simply removed (the result is the same).
+				    if ($satisfied || $comparison > 0) {
+					$rv->{obsoleted} = 1;
+				    } else {
+					$rv->{closure}{$pkg->fullname} = { old_requested => 1 };
+					$rv->{removed} = 1;
+					++$state->{oldpackage};
+				    }
+				} else {
+				    $rv->{obsoleted} = 1;
+				}
 
-					      #- diff_provides on obsoleted provides are needed.
-					      foreach ($p->provides) {
-						  #- check differential provides between obsoleted package and newer one.
-						  if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
-						      $diff_provides{$pn} = undef;
-						      foreach (grep { exists $state->{selected}{$_} }
-							       keys %{$urpm->{provides}{$pn} || {}}) {
-							  my $pp = $urpm->{depslist}[$_];
-							  foreach ($pp->provides) {
-							      /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/ && $1 eq $pn or next;
-							      $2 eq $ps and delete $diff_provides{$pn};
-							  }
-						      }
-						  }
-					      }
-					  });
+				#- diff_provides on obsoleted provides are needed.
+				foreach ($p->provides) {
+				    #- check differential provides between obsoleted package and newer one.
+				    if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
+					$diff_provides{$pn} = undef;
+					foreach (grep { exists $state->{selected}{$_} }
+					    keys %{$urpm->{provides}{$pn} || {}})
+					{
+					    my $pp = $urpm->{depslist}[$_];
+					    foreach ($pp->provides) {
+						/^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/ && $1 eq $pn
+						    or next;
+						$2 eq $ps
+						    and delete $diff_provides{$pn};
+					    }
+					}
+				    }
+				}
+			    });
 		    }
 		}
 
@@ -855,12 +872,15 @@ sub compute_installed_flags {
     \%sizes;
 }
 
-#- compute flags according to hash describing packages to remove
-#- $val is a hash reference described as follow :
-#-   key is package name or regular expression on fullname if /.../
-#-   value is reference to hash indicating sense information ({ '' => undef } if none).
-#- options hash :
-#-   callback : sub to be called for each package with skip flag activated,
+#- compute flags according to a hash describing packages to skip
+#- $val is a hash reference (as returned by get_packages_list) described as follows :
+#-   key is a package name, or a regular expression matching against the
+#-      fullname, if enclosed in slashes
+#-   value is a hashref indicating sense information ({ '' => undef } if none).
+#- %options :
+#-   callback : sub to be called for each package where the flag is set
+#-   skip : if true, set the 'skip' flag
+#-   disable_obsolete : if true, set the 'disable_obsolete' flag
 sub compute_flags {
     my ($urpm, $val, %options) = @_;
     my %regex;