<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package URPM;

# $Id: Resolve.pm,v 1.107 2005/02/15 12:48:51 rgarciasuarez Exp $

use strict;

sub min { my $n = shift; $_ &lt; $n and $n = $_ foreach @_; $n }

#- $state fields :
#- * ask_remove: deprecated
#- * backtrack
#- * cached_installed
#- * oldpackage
#- * rejected
#- * selected
#- * transaction
#- * transaction_state
#- * unselected: deprecated
#- * whatrequires

#- Find candidates packages from a require string (or id).
#- Takes care of direct choices using the '|' separator.
sub find_candidate_packages {
    my ($urpm, $dep, %options) = @_;
    my %packages;

    foreach (split /\|/, $dep) {
	if (/^\d+$/) {
	    my $pkg = $urpm-&gt;{depslist}[$_];
	    $pkg-&gt;flag_skip and next;
	    $pkg-&gt;arch eq 'src' || $pkg-&gt;is_arch_compat or next;
	    $options{avoided} &amp;&amp; exists $options{avoided}{$pkg-&gt;fullname} and next;
	    push @{$packages{$pkg-&gt;name}}, $pkg;
	} elsif (my ($property, $name) = /^(([^\s\[]*).*)/) {
	    foreach (keys %{$urpm-&gt;{provides}{$name} || {}}) {
		my $pkg = $urpm-&gt;{depslist}[$_];
		$pkg-&gt;flag_skip and next;
		$pkg-&gt;is_arch_compat or next;
		$options{avoided} &amp;&amp; exists $options{avoided}{$pkg-&gt;fullname} and next;
		#- check if at least one provide of the package overlap the property.
		!$urpm-&gt;{provides}{$name}{$_} || $pkg-&gt;provides_overlap($property, $options{nopromoteepoch})
		    and push @{$packages{$pkg-&gt;name}}, $pkg;
	    }
	}
    }
    \%packages;
}

sub get_installed_arch {
    my ($db, $n) = @_;
    my $arch;
    $db-&gt;traverse_tag('name', [ $n ], sub { $arch = $_[0]-&gt;arch });
    $arch;
}

sub find_chosen_packages {
    my ($urpm, $db, $state, $dep) = @_;
    my %packages;
    my %installed_arch;
    my $strict_arch = $urpm-&gt;{options}{'strict-arch'};

    #- search for possible packages, try to be as fast as possible, backtrack can be longer.
    foreach (split /\|/, $dep) {
	if (/^\d+$/) {
	    my $pkg = $urpm-&gt;{depslist}[$_];
	    $pkg-&gt;arch eq 'src' || $pkg-&gt;is_arch_compat or next;
	    $pkg-&gt;flag_skip || $state-&gt;{rejected}{$pkg-&gt;fullname} and next;
	    #- determine if this package is better than a possibly previously chosen package.
	    $pkg-&gt;flag_selected || exists $state-&gt;{selected}{$pkg-&gt;id} and return $pkg;
	    if ($strict_arch) {
		my $n = $pkg-&gt;name;
		defined $installed_arch{$n} or $installed_arch{$n} = get_installed_arch($db, $n);
		$installed_arch{$n} &amp;&amp; $pkg-&gt;arch ne $installed_arch{$n} and next;
	    }
	    if (my $p = $packages{$pkg-&gt;name}) {
		$pkg-&gt;flag_requested &gt; $p-&gt;flag_requested ||
		  $pkg-&gt;flag_requested == $p-&gt;flag_requested &amp;&amp; $pkg-&gt;compare_pkg($p) &gt; 0 and $packages{$pkg-&gt;name} = $pkg;
	    } else {
		$packages{$pkg-&gt;name} = $pkg;
	    }
	} elsif (my ($property, $name) = /^(([^\s\[]*).*)/) {
	    foreach (keys %{$urpm-&gt;{provides}{$name} || {}}) {
		my $pkg = $urpm-&gt;{depslist}[$_];
		$pkg-&gt;is_arch_compat or next;
		$pkg-&gt;flag_skip || exists $state-&gt;{rejected}{$pkg-&gt;fullname} and next;
		#- check if at least one provide of the package overlaps the property
		if (!$urpm-&gt;{provides}{$name}{$_} || $pkg-&gt;provides_overlap($property)) {
		    #- determine if this package is better than a possibly previously chosen package.
		    $pkg-&gt;flag_selected || exists $state-&gt;{selected}{$pkg-&gt;id} and return $pkg;
		    if ($strict_arch) {
			my $n = $pkg-&gt;name;
			defined $installed_arch{$n} or $installed_arch{$n} = get_installed_arch($db, $n);
			$installed_arch{$n} &amp;&amp; $pkg-&gt;arch ne $installed_arch{$n} and next;
		    }
		    if (my $p = $packages{$pkg-&gt;name}) {
			$pkg-&gt;flag_requested &gt; $p-&gt;flag_requested ||
			  $pkg-&gt;flag_requested == $p-&gt;flag_requested &amp;&amp; $pkg-&gt;compare_pkg($p) &gt; 0 and $packages{$pkg-&gt;name} = $pkg;
		    } else {
			$packages{$pkg-&gt;name} = $pkg;
		    }
		}
	    }
	}
    }

    if (keys(%packages) &gt; 1) {
	my ($mode, @chosen, @chosen_good_locales, @chosen_bad_locales, @chosen_other, $install);

	#- 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.
	#- Takes better architectures into account.
	foreach my $p (values(%packages)) {
	    unless ($p-&gt;flag_upgrade || $p-&gt;flag_installed) {
		#- assume for this small algorithm package to be upgradable.
		$p-&gt;set_flag_upgrade;
		$db-&gt;traverse_tag('name', [ $p-&gt;name ], sub {
		    my ($pp) = @_;
		    $p-&gt;set_flag_installed;
		    $p-&gt;flag_upgrade and $p-&gt;set_flag_upgrade($p-&gt;compare_pkg($pp) &gt; 0);
		});
	    }
	    my $arch_score = ($p-&gt;is_arch_compat &lt; min map { $_-&gt;is_arch_compat } @chosen) ? 10 : 0;
	    if ($p-&gt;flag_requested &amp;&amp; $p-&gt;flag_installed) {
		$mode &lt; 3 + $arch_score and @chosen = ();
		$mode = 3 + $arch_score;
		$install = 1;
	    } elsif ($p-&gt;flag_requested) {
		$mode &lt; 2 + $arch_score and @chosen = ();
		$mode &gt; 2 + $arch_score and next;
		$mode = 2 + $arch_score;
	    } elsif ($p-&gt;flag_installed) {
		$mode &lt; 1 + $arch_score and @chosen = ();
		$mode &gt; 1 + $arch_score and next;
		$mode = 1 + $arch_score;
	    } else {
		$mode &lt; $arch_score and @chosen = ();
		$mode &gt; $arch_score and next;
		$mode = $arch_score;
	    }
	    push @chosen, $p;
	}

	#- if several packages are installed, trim the choices.
	if (!$urpm-&gt;{options}{morechoices} &amp;&amp; $install &amp;&amp; @chosen &gt; 1) { @chosen = ($chosen[0]) }

	#- 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-/ &amp;&amp; ! /locales-en/ } $_-&gt;requires_nosense) {
		if ((grep { $urpm-&gt;{depslist}[$_]-&gt;flag_available } keys %{$urpm-&gt;{provides}{$specific_locales}}) &gt; 0 ||
		    $db-&gt;traverse_tag('name', [ $specific_locales ], undef) &gt; 0) {
		    push @chosen_good_locales, $_;
		} else {
		    push @chosen_bad_locales, $_;
		}
	    } else {
		push @chosen_other, $_;
	    }
	}

	#- sort packages in order to have preferred ones first
	#- (this means good locales, no locales, bad locales).
	return (sort sort_package_result @chosen_good_locales),
	       (sort sort_package_result @chosen_other),
	       (sort sort_package_result @chosen_bad_locales);
    }

    return values(%packages);
}

sub sort_package_result { $b-&gt;compare_pkg($a) || $a-&gt;id &lt;=&gt; $b-&gt;id }

#- return unresolved requires of a package (a new one or an existing one).
sub unsatisfied_requires {
    my ($urpm, $db, $state, $pkg, %options) = @_;
    my %properties;

    #- all requires should be satisfied according to selected packages or installed packages,
    #- or the package itself.
  REQUIRES: foreach my $dep ($pkg-&gt;requires) {
	if (my ($n, $s) = $dep =~ /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
	    #- allow filtering on a given name (to speed up some search).
	    ! defined $options{name} || $n eq $options{name} or next REQUIRES;

	    #- avoid recomputing the same all the time.
	    exists $properties{$dep} and next REQUIRES;

	    #- check for installed packages in the installed cache.
	    foreach (keys %{$state-&gt;{cached_installed}{$n} || {}}) {
		exists $state-&gt;{rejected}{$_} and next;
		next REQUIRES;
	    }

	    #- check on the selected package if a provide is satisfying the resolution (need to do the ops).
	    foreach (keys %{$urpm-&gt;{provides}{$n} || {}}) {
		my $p = $urpm-&gt;{depslist}[$_];
		exists $state-&gt;{selected}{$_} or next;
		!$urpm-&gt;{provides}{$n}{$_} || $p-&gt;provides_overlap($dep, $options{nopromoteepoch}) and next REQUIRES;
	    }

	    #- check if the package itself provides what is necessary.
	    $pkg-&gt;provides_overlap($dep) and next REQUIRES;

	    #- check on installed system if a package which is not obsoleted is satisfying the require.
	    my $satisfied = 0;
	    if ($n =~ m!^/!) {
		$db-&gt;traverse_tag('path', [ $n ], sub {
		    my ($p) = @_;
		    exists $state-&gt;{rejected}{$p-&gt;fullname} and return;
		    $state-&gt;{cached_installed}{$n}{$p-&gt;fullname} = undef;
		    ++$satisfied;
		});
	    } else {
		$db-&gt;traverse_tag('whatprovides', [ $n ], sub {
		    my ($p) = @_;
		    exists $state-&gt;{rejected}{$p-&gt;fullname} and return;
		    foreach ($p-&gt;provides) {
			if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
			    $ps or $state-&gt;{cached_installed}{$pn}{$p-&gt;fullname} = undef;
			    $pn eq $n or next;
			    ranges_overlap($ps, $s, $options{nopromoteepoch}) and ++$satisfied;
			}
		    }
		});
	    }
	    #- if nothing can be done, the require should be resolved.
	    $satisfied or $properties{$dep} = undef;
	}
    }

    keys %properties;
}

sub backtrack_selected {
    my ($urpm, $db, $state, $dep, %options) = @_;
    my @properties;

    if (defined $dep-&gt;{required}) {
	#- avoid deadlock here...
	if (exists $state-&gt;{backtrack}{deadlock}{$dep-&gt;{required}}) {
	    $options{keep} = 1; #- force keeping package to that backtrakc is doing something.
	} else {
	    $state-&gt;{backtrack}{deadlock}{$dep-&gt;{required}} = undef;

	    #- search for all possible packages, first is to try the selection, then if it is
	    #- impossible, backtrack the origin.
	    my $packages = $urpm-&gt;find_candidate_packages($dep-&gt;{required});

	    foreach (values %$packages) {
		foreach (@$_) {
		    #- avoid dead loop.
		    exists $state-&gt;{backtrack}{selected}{$_-&gt;id} and next;
		    #- a package if found is problably rejected or there is a problem.
		    if ($state-&gt;{rejected}{$_-&gt;fullname}) {
			if (!$options{callback_backtrack} ||
			    $options{callback_backtrack}-&gt;($urpm, $db, $state, $_,
							   dep =&gt; $dep, alternatives =&gt; $packages, %options) &lt;= 0) {
			    #- keep in mind a backtrack has happening here...
			    $state-&gt;{rejected}{$_-&gt;fullname}{backtrack} ||=
			      { exists $dep-&gt;{promote} ? (promote =&gt; [ $dep-&gt;{promote} ]) : @{[]},
				exists $dep-&gt;{psel} ? (psel =&gt; $dep-&gt;{psel}) : @{[]},
			      };
			    #- backtrack callback should return a strictly positive value if the selection of the new
			    #- package is prefered over the currently selected package.
			    next;
			}
		    }
		    $state-&gt;{backtrack}{selected}{$_-&gt;id} = undef;

		    #- in such case, we need to drop the problem caused so that rejected condition is removed.
		    #- if this is not possible, the next backtrack on the same package will be refused above.
		    my @l = map { $urpm-&gt;search($_, strict_fullname =&gt; 1) }
		      keys %{($state-&gt;{rejected}{$_-&gt;fullname} || {})-&gt;{closure}};

		    $options{keep_unrequested_dependencies} ? $urpm-&gt;disable_selected($db, $state, @l) :
		      $urpm-&gt;disable_selected_unrequested_dependencies($db, $state, @l);

		    return { required =&gt; $_-&gt;id,
			     exists $dep-&gt;{from} ? (from =&gt; $dep-&gt;{from}) : @{[]},
			     exists $dep-&gt;{requested} ? (requested =&gt; $dep-&gt;{requested}) : @{[]},
			   };
		}
	    }
	}
    }

    if (defined $dep-&gt;{from}) {
	if ($options{nodeps}) {
	    #- try to keep unsatisfied dependencies in requested.
	    if ($dep-&gt;{required} &amp;&amp; exists $state-&gt;{selected}{$dep-&gt;{from}-&gt;id}) {
		push @{$state-&gt;{selected}{$dep-&gt;{from}-&gt;id}{unsatisfied}}, $dep-&gt;{required};
	    }
	} else {
	    #- at this point, dep cannot be resolved, this means we need to disable
	    #- all selection tree, re-enabling removed and obsoleted packages as well.
	    unless (exists $state-&gt;{rejected}{$dep-&gt;{from}-&gt;fullname}) {
		#- package is not currently rejected, compute the closure now.
		my @l = $options{keep_unrequested_dependencies} ? $urpm-&gt;disable_selected($db, $state, $dep-&gt;{from}) :
		  $urpm-&gt;disable_selected_unrequested_dependencies($db, $state, $dep-&gt;{from});
		foreach (@l) {
		    #- disable all these packages in order to avoid selecting them again.
		    $_-&gt;fullname eq $dep-&gt;{from}-&gt;fullname or
		      $state-&gt;{rejected}{$_-&gt;fullname}{backtrack}{closure}{$dep-&gt;{from}-&gt;fullname} = undef;
		}
	    }
	    #- the package is already rejected, we assume we can add another reason here!
	    push @{$state-&gt;{rejected}{$dep-&gt;{from}-&gt;fullname}{backtrack}{unsatisfied}}, $dep-&gt;{required};
	}
    }

    if (defined $dep-&gt;{psel}) {
	if ($options{keep}) {
	    #- we shouldn't try to remove packages, so psel which leads to this need to be unselected.
	    unless (exists $state-&gt;{rejected}{$dep-&gt;{psel}-&gt;fullname}) {
		#- package is not currently rejected, compute the closure now.
		my @l = $options{keep_unrequested_dependencies} ? $urpm-&gt;disable_selected($db, $state, $dep-&gt;{psel}) :
		  $urpm-&gt;disable_selected_unrequested_dependencies($db, $state, $dep-&gt;{psel});
		foreach (@l) {
		    #- disable all these packages in order to avoid selecting them again.
		    $_-&gt;fullname eq $dep-&gt;{psel}-&gt;fullname or
		      $state-&gt;{rejected}{$_-&gt;fullname}{backtrack}{closure}{$dep-&gt;{psel}-&gt;fullname} = undef;
		}
	    }
	    #- the package is already rejected, we assume we can add another reason here!
	    defined $dep-&gt;{promote} and push @{$state-&gt;{rejected}{$dep-&gt;{psel}-&gt;fullname}{backtrack}{promote}}, $dep-&gt;{promote};
	    #- to simplify, a reference to list or standalone elements may be set in keep.
	    defined $dep-&gt;{keep} and push @{$state-&gt;{rejected}{$dep-&gt;{psel}-&gt;fullname}{backtrack}{keep}}, @{$dep-&gt;{keep}};
	} else {
	    #- the backtrack need to examine diff_provides promotion on $n.
	    $db-&gt;traverse_tag('whatrequires', [ $dep-&gt;{promote} ], sub {
				  my ($p) = @_;
				  if (my @l = $urpm-&gt;unsatisfied_requires($db, $state, $p,
									  nopromoteepoch =&gt; 1, name =&gt; $dep-&gt;{promote})) {
				      #- typically a redo of the diff_provides code should be applied...
				      $urpm-&gt;resolve_rejected($db, $state, $p,
							      removed =&gt; 1,
							      unsatisfied =&gt; \@properties,
							      from =&gt; scalar $dep-&gt;{psel}-&gt;fullname,
							      why =&gt; { unsatisfied =&gt; \@l });
				  }
			      });
	}
    }

    #- some packages may have been removed because of selection of this one.
    #- the rejected flags should have been cleaned by disable_selected above.
    @properties;
}

#- close rejected (as urpme previously) for package to be removable without error.
sub resolve_rejected {
    my ($urpm, $db, $state, $pkg, %options) = @_;
    my @unsatisfied;

    #- check if the package has already been asked to be rejected (removed or obsoleted).
    #- this means only add the new reason and return.
    if (! $state-&gt;{rejected}{$pkg-&gt;fullname}) {
	my @closure = $pkg;

	#- keep track of size of package which are finally removed.
	$state-&gt;{rejected}{$pkg-&gt;fullname}{size} = $pkg-&gt;size;
	foreach (qw(removed obsoleted)) {
	    $options{$_} and $state-&gt;{rejected}{$pkg-&gt;fullname}{$_} = $options{$_};
	}
	$options{closure_as_removed} and $options{removed} ||= delete $options{obsoleted};

	while (my $cp = shift @closure) {
	    #- close what requires this property, but check with selected package requiring old properties.
	    foreach ($cp-&gt;provides) {
		if (my ($n) = /^([^\s\[]*)/) {
		    foreach (keys %{$state-&gt;{whatrequires}{$n} || {}}) {
			my $pkg = $urpm-&gt;{depslist}[$_] or next;
			if (my @l = $urpm-&gt;unsatisfied_requires($db, $state, $pkg, name =&gt; $n)) {
			    #- a selected package requires something that is no more available
			    #- and should be tried to be re-selected if possible.
			    push @unsatisfied, @l;
			}
		    }
		    $db-&gt;traverse_tag('whatrequires', [ $n ], sub {
			my ($p) = @_;
			if (my @l = $urpm-&gt;unsatisfied_requires($db, $state, $p, name =&gt; $n)) {
			    my $rv = $state-&gt;{rejected}{$p-&gt;fullname} ||= {};

			    #- keep track of what causes closure.
			    my %d; @d{@{$rv-&gt;{closure}{$pkg-&gt;fullname}{unsatisfied} ||= []}} = ();
			    push @{$rv-&gt;{closure}{$pkg-&gt;fullname}{unsatisfied}}, grep { ! exists $d{$_} } @l;

			    #- set removed and obsoleted level.
			    foreach (qw(removed obsoleted)) {
				$options{$_} &amp;&amp; (! exists $rv-&gt;{$_} || $options{$_} &lt;= $rv-&gt;{$_})
				    and $rv-&gt;{$_} = $options{$_};
			    }

			    #- continue the closure unless already examined.
			    exists $rv-&gt;{size} and return;
			    $rv-&gt;{size} = $p-&gt;size;

			    $p-&gt;pack_header; #- need to pack else package is no longer visible...
			    push @closure, $p;
			}
		    });
		}
	    }
	}
    } else {
	#- the package has already been rejected.
	foreach (qw(removed obsoleted)) {
	    $options{$_} &amp;&amp; (! exists $state-&gt;{rejected}{$pkg-&gt;fullname}{$_} ||
			     $options{$_} &lt;= $state-&gt;{rejected}{$pkg-&gt;fullname}{$_})
	      and $state-&gt;{rejected}{$pkg-&gt;fullname}{$_} = $options{$_};
	}
    }

    $options{from} and $state-&gt;{rejected}{$pkg-&gt;fullname}{closure}{$options{from}} = $options{why};
    $options{unsatisfied} and push @{$options{unsatisfied}}, map { { required =&gt; $_, rejected =&gt; $pkg-&gt;fullname, } } @unsatisfied;
}

#- 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);

    #- populate properties with backtrack informations.
    while (my ($r, $v) = each %$requested) {
	unless ($options{keep_requested_flag}) {
	    #- keep track of requested packages by propating the flag.
	    my $packages = $urpm-&gt;find_candidate_packages($r);
	    foreach (values %$packages) {
		foreach (@$_) {
		    $_-&gt;set_flag_requested;
		}
	    }
	}
	#- keep value to be available from selected hash.
	push @properties, { required =&gt; $r,
			    requested =&gt; $v,
			  };
    }

    #- for each dep property evaluated, examine which package will be obsoleted on $db,
    #- then examine provides that will be removed (which need to be satisfied by another
    #- package present or by a new package to upgrade), then requires not satisfied and
    #- finally conflicts that will force a new upgrade or a remove.
    do {
	while (defined ($dep = shift @properties)) {
	    #- in case of keep_unrequested_dependencies option is not set, we need to avoid
	    #- selecting packages if the source has been disabled.
	    if (exists $dep-&gt;{from} &amp;&amp; !$options{keep_unrequested_dependencies}) {
		exists $state-&gt;{selected}{$dep-&gt;{from}-&gt;id} or next;
	    }

	    #- take the best choice possible.
	    my @chosen = $urpm-&gt;find_chosen_packages($db, $state, $dep-&gt;{required});

	    #- 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-&gt;backtrack_selected($db, $state, $dep, %options);
		next; #- backtrack code choose to continue with same package or completely new strategy.
	    } elsif ($options{callback_choices} &amp;&amp; @chosen &gt; 1) {
		unshift @properties, map {
		    +{
			required =&gt; $_-&gt;id,
			choices =&gt; $dep-&gt;{required},
			exists $dep-&gt;{from} ? (from =&gt; $dep-&gt;{from}) : @{[]},
			exists $dep-&gt;{requested} ? (requested =&gt; $dep-&gt;{requested}) : @{[]},
		    }
		} grep { ref $_ } $options{callback_choices}-&gt;($urpm, $db, $state, \@chosen);
		next; #- always redo according to choices.
	    }

	    #- now do the real work, select the package.
	    my ($pkg) = @chosen;
	    #- cancel flag if this package should be cancelled but too late (typically keep options).
	    my @keep;

	    !$pkg || exists $state-&gt;{selected}{$pkg-&gt;id} and next;

	    if ($pkg-&gt;arch eq 'src') {
		$pkg-&gt;set_flag_upgrade;
	    } else {
		unless ($pkg-&gt;flag_upgrade || $pkg-&gt;flag_installed) {
		    #- assume for this small algorithm package to be upgradable.
		    $pkg-&gt;set_flag_upgrade;
		    $db-&gt;traverse_tag('name', [ $pkg-&gt;name ], sub {
					  my ($p) = @_;
					  #- there is at least one package installed (whatever its version).
					  $pkg-&gt;set_flag_installed;
					  $pkg-&gt;flag_upgrade and $pkg-&gt;set_flag_upgrade($pkg-&gt;compare_pkg($p) &gt; 0);
				      });
		}
		if ($pkg-&gt;flag_installed &amp;&amp; !$pkg-&gt;flag_upgrade) {
		    my $allow;
		    #- the same or a more recent package is installed,
		    $db-&gt;traverse_tag('name', [ $pkg-&gt;name ], sub {
					  my ($p) = @_;
					  $allow ||= $pkg-&gt;compare_pkg($p) &lt; 0;
				      });
		    #- if nothing has been found, just ignore it.
		    $allow or next;
		}
	    }

	    #- keep in mind the package has be selected, remove the entry in requested input hash,
	    #- this means required dependencies have undef value in selected hash.
	    #- requested flag is set only for requested package where value is not false.
	    push @selected, $pkg;
	    $state-&gt;{selected}{$pkg-&gt;id} = { exists $dep-&gt;{requested} ? (requested =&gt; $dep-&gt;{requested}) : @{[]},
					     exists $dep-&gt;{from} ? (from =&gt; $dep-&gt;{from}) : @{[]},
					     exists $dep-&gt;{promote} ? (promote =&gt; $dep-&gt;{promote}) : @{[]},
					     exists $dep-&gt;{psel} ? (psel =&gt; $dep-&gt;{psel}) : @{[]},
					     $pkg-&gt;flag_disable_obsolete ? (install =&gt; 1) : @{[]},
					   };

	    $pkg-&gt;set_flag_required;

	    #- check if the package is not already installed before trying to use it, compute
	    #- obsoleted packages too. This is valable only for non source packages.
	    if ($pkg-&gt;arch ne 'src' &amp;&amp; !$pkg-&gt;flag_disable_obsolete) {
		my (%diff_provides);

		foreach ($pkg-&gt;name . " &lt; " . $pkg-&gt;epoch . ":" . $pkg-&gt;version . "-" . $pkg-&gt;release, $pkg-&gt;obsoletes) {
		    if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?\s*\[?([^\s\]]*)\s*([^\s\]]*)/) {
			#- populate avoided entries according to what is selected.
			foreach (keys %{$urpm-&gt;{provides}{$n} || {}}) {
			    my $p = $urpm-&gt;{depslist}[$_];
			    if ($p-&gt;name eq $pkg-&gt;name) {
				#- all packages with the same name should now be avoided except when chosen.
				$p-&gt;fullname eq $pkg-&gt;fullname and next;
			    } else {
				#- in case of obsoletes, keep track of what should be avoided
				#- but only if package name equals the obsolete name.
				$p-&gt;name eq $n &amp;&amp; (!$o || eval($p-&gt;compare($v) . $o . 0)) or next;
			    }
			    #- these packages are not yet selected, if they happen to be selected,
			    #- they must first be unselected.
			    $state-&gt;{rejected}{$p-&gt;fullname}{closure}{$pkg-&gt;fullname} ||= undef;
			}
			#- examine rpm db too (but only according to package names as a fix in rpm itself)
			$db-&gt;traverse_tag('name', [ $n ], sub {
				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-&gt;compare($v);
				my $satisfied = !$o || eval($comparison . $o . 0);
				$p-&gt;name eq $pkg-&gt;name || $satisfied or return;

				#- do not propagate now the broken dependencies as they are
				#- computed later.
				my $rv = $state-&gt;{rejected}{$p-&gt;fullname} ||= {};
				$rv-&gt;{closure}{$pkg-&gt;fullname} = undef;
				$rv-&gt;{size} = $p-&gt;size;

				if ($p-&gt;name eq $pkg-&gt;name) {
				    #- all packages older than the current one are obsoleted,
				    #- the others are simply removed (the result is the same).
				    if ($o &amp;&amp; $comparison &gt; 0) {
					#- installed package is newer
					#- remove this package from the list of packages to install,
					#- unless urpmi was invoked with --allow-force (in which
					#- case rpm could be invoked with --oldpackage)
					if (!$urpm-&gt;{options}{'allow-force'}) {
					    #- since the originally requested packages (or other
					    #- non-installed ones) could be unselected by the following
					    #- operation, remember them, to warn the user
					    my @unselected_uninstalled = grep {
						!$_-&gt;flag_installed
					    } $urpm-&gt;disable_selected($db, $state, $pkg);
					    $state-&gt;{unselected_uninstalled} = \@unselected_uninstalled;
					}
				    } elsif ($satisfied) {
					$rv-&gt;{obsoleted} = 1;
				    } else {
					$rv-&gt;{closure}{$pkg-&gt;fullname} = { old_requested =&gt; 1 };
					$rv-&gt;{removed} = 1;
					++$state-&gt;{oldpackage};
				    }
				} else {
				    $rv-&gt;{obsoleted} = 1;
				}

				#- diff_provides on obsoleted provides are needed.
				foreach ($p-&gt;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-&gt;{selected}{$_} }
					    keys %{$urpm-&gt;{provides}{$pn} || {}})
					{
					    my $pp = $urpm-&gt;{depslist}[$_];
					    foreach ($pp-&gt;provides) {
						/^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/ &amp;&amp; $1 eq $pn
						    or next;
						$2 eq $ps
						    and delete $diff_provides{$pn};
					    }
					}
				    }
				}
			    });
		    }
		}

		push @diff_provides, map { +{ name =&gt; $_, pkg =&gt; $pkg } } keys %diff_provides;
	    }

	    #- all requires should be satisfied according to selected package, or installed packages.
	    unshift @properties, map { +{ required =&gt; $_, from =&gt; $pkg,
					  exists $dep-&gt;{promote} ? (promote =&gt; $dep-&gt;{promote}) : @{[]},
					  exists $dep-&gt;{psel} ? (psel =&gt; $dep-&gt;{psel}) : @{[]},
					} } $urpm-&gt;unsatisfied_requires($db, $state, $pkg);

	    #- keep in mind what is requiring each item (for unselect to work).
	    foreach ($pkg-&gt;requires_nosense) {
		$state-&gt;{whatrequires}{$_}{$pkg-&gt;id} = undef;
	    }

	    #- examine conflicts, an existing package conflicting with this selection should
	    #- be upgraded to a new version which will be safe, else it should be removed.
	    foreach ($pkg-&gt;conflicts) {
		@keep and last;
		#- propagate conflicts to avoided.
		if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?\s*\[?([^\s\]]*)\s*([^\s\]]*)/) {
		    foreach (keys %{$urpm-&gt;{provides}{$n} || {}}) {
			my $p = $urpm-&gt;{depslist}[$_];
			$pkg == $p and next;
			$p-&gt;name eq $n &amp;&amp; (!$o || eval($p-&gt;compare($v) . $o . 0)) or next;
			$state-&gt;{rejected}{$p-&gt;fullname}{closure}{$pkg-&gt;fullname} = undef;
		    }
		}
		if (my ($file) = m!^(/[^\s\[]*)!) {
		    $db-&gt;traverse_tag('path', [ $file ], sub {
			@keep and return;
			my ($p) = @_;
			if ($options{keep}) {
			    push @keep, scalar $p-&gt;fullname;
			} else {
			    #- all these package should be removed.
			    $urpm-&gt;resolve_rejected(
				$db, $state, $p,
				removed =&gt; 1, unsatisfied =&gt; \@properties,
				from =&gt; scalar $pkg-&gt;fullname,
				why =&gt; { conflicts =&gt; $file },
			    );
			}
		    });
		} elsif (my ($property, $name) = /^(([^\s\[]*).*)/) {
		    $db-&gt;traverse_tag('whatprovides', [ $name ], sub {
			@keep and return;
			my ($p) = @_;
			if ($p-&gt;provides_overlap($property)) {
			    #- the existing package will conflict with the selection; check
			    #- whether a newer version will be ok, else ask to remove the old.
			    my $need_deps = $p-&gt;name . " &gt; " . ($p-&gt;epoch ? $p-&gt;epoch.":" : "") .
			    $p-&gt;version . "-" . $p-&gt;release;
			    my $packages = $urpm-&gt;find_candidate_packages($need_deps, avoided =&gt; $state-&gt;{rejected});
			    my $best = join '|', map { $_-&gt;id }
			    grep { ! $_-&gt;provides_overlap($property) }
			    @{$packages-&gt;{$p-&gt;name}};

			    if (length $best) {
				unshift @properties, { required =&gt; $best, promote_conflicts =&gt; $name,  };
			    } else {
				if ($options{keep}) {
				    push @keep, scalar $p-&gt;fullname;
				} else {
				    #- no package has been found, we need to remove the package examined.
				    delete $state-&gt;{rejected}{$p-&gt;fullname}; #- force resolution
				    $urpm-&gt;resolve_rejected($db, $state, $p,
				    removed =&gt; 1, unsatisfied =&gt; \@properties,
				    from =&gt; scalar $pkg-&gt;fullname,
				    why =&gt; { conflicts =&gt; scalar $pkg-&gt;fullname });
				}
			    }
			}
		    });
		}
	    }

	    #- examine if an existing package does not conflict with this one.
	    $db-&gt;traverse_tag('whatconflicts', [ $pkg-&gt;name ], sub {
		@keep and return;
		my ($p) = @_;
		foreach my $property ($p-&gt;conflicts) {
		    if ($pkg-&gt;provides_overlap($property)) {
			if ($options{keep}) {
			    push @keep, scalar $p-&gt;fullname;
			} else {
			    #- all these packages should be removed.
			    $urpm-&gt;resolve_rejected($db, $state, $p,
			    removed =&gt; 1, unsatisfied =&gt; \@properties,
			    from =&gt; scalar $pkg-&gt;fullname,
			    why =&gt; { conflicts =&gt; $property });
			}
		    }
		}
	    });

	    #- keep existing package and therefore cancel current one.
	    if (@keep) {
		unshift @properties, $urpm-&gt;backtrack_selected($db, $state, +{ keep =&gt; \@keep, psel =&gt; $pkg }, %options);
	    }
	}
	if (defined ($dep = shift @diff_provides)) {
	    my ($n, $pkg) = ($dep-&gt;{name}, $dep-&gt;{pkg});
	    $db-&gt;traverse_tag('whatrequires', [ $n ], sub {
				  my ($p) = @_;
				  if (my @l = $urpm-&gt;unsatisfied_requires($db, $state, $p, nopromoteepoch =&gt; 1, name =&gt; $n)) {
				      #- try if upgrading the package will be satisfying all the requires...
				      #- there is no need to avoid promoting epoch as the package examined is not
				      #- already installed.
				      my $packages = $urpm-&gt;find_candidate_packages($p-&gt;name, avoided =&gt; $state-&gt;{rejected});
				      my $best = join '|', map { $_-&gt;id }
					grep { ($_-&gt;name eq $p-&gt;name ||
						$_-&gt;obsoletes_overlap($p-&gt;name . " == " . $p-&gt;epoch . ":" . $p-&gt;version . "-" . $p-&gt;release))
						 &amp;&amp; $_-&gt;fullname ne $p-&gt;fullname &amp;&amp;
						   $urpm-&gt;unsatisfied_requires($db, $state, $_, name =&gt; $n) == 0 }
					  map { @{$_ || []} } values %$packages;

				      if (length $best) {
					  push @properties, { required =&gt; $best, promote =&gt; $n, psel =&gt; $pkg };
				      } else {
					  #- no package have been found, we may need to remove the package examined unless
					  #- there exists enough packages that provided the unsatisfied requires.
					  my @best;
					  foreach (@l) {
					      $packages = $urpm-&gt;find_candidate_packages($_,
											 nopromoteepoch =&gt; 1,
											 avoided =&gt; $state-&gt;{rejected});
					      $best = join('|',
							   map { $_-&gt;id }
							   grep { $_-&gt;fullname ne $p-&gt;fullname }
							   map { @{$_ || []} } values %$packages);
					      $best and push @best, $best;
					  }

					  if (@best == @l) {
					      push @properties, map { +{ required =&gt; $_, promote =&gt; $n, psel =&gt; $pkg } } @best;
					  } else {
					      if ($options{keep}) {
						  unshift @properties, $urpm-&gt;backtrack_selected($db, $state,
												 { keep =&gt; [ scalar $p-&gt;fullname ],
												   psel =&gt; $pkg,
												 },
												 %options);
					      } else {
						  $urpm-&gt;resolve_rejected($db, $state, $p,
									  removed =&gt; 1,
									  unsatisfied =&gt; \@properties,
									  from =&gt; scalar $pkg-&gt;fullname,
									  why =&gt; { unsatisfied =&gt; \@l });
					      }
					  }
				      }
				  }
			      });
	}
    } while (@diff_provides || @properties);

    #- return what has been selected by this call (not all selected hash which may be not empty
    #- previously. avoid returning rejected packages which weren't selectable.
    grep { exists $state-&gt;{selected}{$_-&gt;id} } @selected;
}

#- do the opposite of the above, unselect a package and extend
#- to any package not requested that is no longer needed by
#- any other package.
#- return the packages that have been deselected.
sub disable_selected {
    my ($urpm, $db, $state, @closure) = @_;
    my @unselected;

    #- iterate over package needing unrequested one.
    while (my $pkg = shift @closure) {
	exists $state-&gt;{selected}{$pkg-&gt;id} or next;

	#- keep a trace of what is deselected.
	push @unselected, $pkg;

	#- do a closure on rejected packages (removed, obsoleted or avoided).
	my @closure_rejected = scalar $pkg-&gt;fullname;
	while (my $fullname = shift @closure_rejected) {
	    my @rejecteds = keys %{$state-&gt;{rejected}};
	    foreach (@rejecteds) {
		exists $state-&gt;{rejected}{$_} &amp;&amp; exists $state-&gt;{rejected}{$_}{closure}{$fullname} or next;
		delete $state-&gt;{rejected}{$_}{closure}{$fullname};
		unless (%{$state-&gt;{rejected}{$_}{closure}}) {
		    delete $state-&gt;{rejected}{$_};
		    push @closure_rejected, $_;
		}
	    }
	}

	#- the package being examined has to be unselected.
	$pkg-&gt;set_flag_requested(0);
	$pkg-&gt;set_flag_required(0);
	delete $state-&gt;{selected}{$pkg-&gt;id};

	#- determine package that requires properties no longer available, so that they need to be
	#- unselected too.
	foreach my $n ($pkg-&gt;provides_nosense) {
	    foreach (keys %{$state-&gt;{whatrequires}{$n} || {}}) {
		my $p = $urpm-&gt;{depslist}[$_];
		exists $state-&gt;{selected}{$p-&gt;id} or next;
		if ($urpm-&gt;unsatisfied_requires($db, $state, $p, name =&gt; $n)) {
		    #- this package has broken dependencies and is selected.
		    push @closure, $p;
		}
	    }
	}

	#- clean whatrequires hash.
	foreach ($pkg-&gt;requires_nosense) {
	    delete $state-&gt;{whatrequires}{$_}{$pkg-&gt;id};
	    %{$state-&gt;{whatrequires}{$_}} or delete $state-&gt;{whatrequires}{$_};
	}
    }

    #- return all unselected packages.
    @unselected;
}

#- determine dependencies that can safely been removed and are not requested
sub disable_selected_unrequested_dependencies {
    my ($urpm, $db, $state, @closure) = @_;
    my @unselected_closure;

    #- disable selected packages, then extend unselection to all required packages
    #- no longer needed and not requested.
    while (my @unselected = $urpm-&gt;disable_selected($db, $state, @closure)) {
	my %required;

	#- keep in the packages that had to be unselected.
	@unselected_closure or push @unselected_closure, @unselected;

	#- search for unrequested required packages.
	foreach (@unselected) {
	    foreach ($_-&gt;requires_nosense) {
		foreach (keys %{$urpm-&gt;{provides}{$_} || {}}) {
		    my $pkg = $urpm-&gt;{depslist}[$_] or next;
		    $state-&gt;{selected}{$pkg-&gt;id} or next;
		    $state-&gt;{selected}{$pkg-&gt;id}{psel} &amp;&amp; $state-&gt;{selected}{$state-&gt;{selected}{$pkg-&gt;id}{psel}-&gt;id} and next;
		    $pkg-&gt;flag_requested and next;
		    $required{$pkg-&gt;id} = undef;
		}
	    }
	}

	#- check required packages are not needed by another selected package.
	foreach (keys %required) {
	    my $pkg = $urpm-&gt;{depslist}[$_] or next;
	    foreach ($pkg-&gt;provides_nosense) {
		foreach (keys %{$state-&gt;{whatrequires}{$_} || {}}) {
		    my $p = $urpm-&gt;{depslist}[$_] or next;
		    exists $required{$p-&gt;id} and next;
		    $state-&gt;{selected}{$p-&gt;id} and $required{$pkg-&gt;id} = 1;
		}
	    }
	}

	#- now required values still undefined indicates packages than can be removed.
	@closure = map { $urpm-&gt;{depslist}[$_] } grep { !$required{$_} } keys %required;
    }

    @unselected_closure;
}

#- compute selected size by removing any removed or obsoleted package.
sub selected_size {
    my ($urpm, $state) = @_;
    my $size;

    foreach (keys %{$state-&gt;{selected} || {}}) {
	my $pkg = $urpm-&gt;{depslist}[$_];
	$size += $pkg-&gt;size;
    }

    foreach (values %{$state-&gt;{rejected} || {}}) {
	$_-&gt;{removed} || $_-&gt;{obsoleted} or next;
	$size -= $_-&gt;{size};
    }

    $size;
}

#- compute installed flags for all packages in depslist.
sub compute_installed_flags {
    my ($urpm, $db) = @_;
    my %sizes;

    #- first pass to initialize flags installed and upgrade for all packages.
    foreach (@{$urpm-&gt;{depslist}}) {
	$_-&gt;is_arch_compat or next;
	$_-&gt;flag_upgrade || $_-&gt;flag_installed or $_-&gt;set_flag_upgrade;
    }

    #- second pass to set installed flag and clean upgrade flag according to installed packages.
    $db-&gt;traverse(sub {
	my ($p) = @_;
	#- remember sizes of each package.
	$sizes{$p-&gt;name} += $p-&gt;size;
	#- compute flags.
	foreach (keys %{$urpm-&gt;{provides}{$p-&gt;name} || {}}) {
	    my $pkg = $urpm-&gt;{depslist}[$_];
	    $pkg-&gt;is_arch_compat &amp;&amp; $pkg-&gt;name eq $p-&gt;name or next;
	    #- compute only installed and upgrade flags.
	    $pkg-&gt;set_flag_installed; #- there is at least one package installed (whatever its version).
	    $pkg-&gt;flag_upgrade and $pkg-&gt;set_flag_upgrade($pkg-&gt;compare_pkg($p) &gt; 0);
	}
    });

    \%sizes;
}

sub compute_flag {
    my ($urpm, $pkg, %options) = @_;
    foreach (qw(skip disable_obsolete)) {
	if ($options{$_} &amp;&amp; !$pkg-&gt;flag($_)) {
	    $pkg-&gt;set_flag($_, 1);
	    $options{callback} and $options{callback}-&gt;($urpm, $pkg, %options);
	}
    }
}

#- Adds packages flags according to an array containing packages names.
#- $val is an array reference (as returned by get_packages_list) containing
#- package names, or a regular expression matching against the fullname, if
#- enclosed in slashes.
#- %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) = @_;
    if (ref $val eq 'HASH') { $val = [ keys %$val ] }; #- compatibility with urpmi &lt;= 4.5-13mdk
    my @regex;

    #- unless a regular expression is given, search in provides
    foreach my $name (@$val) {
	if ($name =~ m,^/(.*)/$,) {
	    push @regex, $1;
	} else {
	    foreach (keys %{$urpm-&gt;{provides}{$name} || {}}) {
		my $pkg = $urpm-&gt;{depslist}[$_];
		$urpm-&gt;compute_flag($pkg, %options);
	    }
	}
    }

    #- now search packages which fullname match given regexps
    if (@regex) {
	foreach my $pkg (@{$urpm-&gt;{depslist}}) {
	    if (grep { $pkg-&gt;fullname =~ /$_/ } @regex) {
		$urpm-&gt;compute_flag($pkg, %options);
	    }
	}
    }
}

#- 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.
sub request_packages_to_upgrade {
    my ($urpm, $db, $_state, $requested, %options) = @_;
    my (%provides, %names, %skip, %requested, %obsoletes, @obsoleters);

    my @idlist = $urpm-&gt;build_listid($options{start}, $options{end}, $options{idlist}) or return;
    
    #- build direct access to best package per name.
    foreach my $pkg (@{$urpm-&gt;{depslist}}[@idlist]) {

	if ($pkg-&gt;is_arch_compat) {
	    foreach ($pkg-&gt;provides) {
		if (my ($n, $evr) = /^([^\s\[]*)(?:\[\*\])?\[?=+\s*([^\s\]]*)/) {
		    if ($provides{$n}) {
			foreach ($provides{$n}-&gt;provides) {
			    if (my ($pn, $pevr) = /^([^\s\[]*)(?:\[\*\])?\[?=+\s*([^\s\]]*)/) {
				$pn eq $n or next;
				if (ranges_overlap("&lt; $evr", "== $pevr")) {
				    #- this package looks like too old ?
				    $provides{$n}-&gt;name ne $pkg-&gt;name and $skip{$provides{$n}-&gt;name} = undef;
				    $provides{$n} = $pkg;
				}
				last;
			    }
			}
		    } else {
			$provides{$n} = $pkg;
		    }
		}
	    }

	    my $p = $names{$pkg-&gt;name};
	    !$p || $pkg-&gt;compare_pkg($p) &gt; 0 and $names{$pkg-&gt;name} = $pkg;
	}
    }

    #- 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.
    foreach my $pkg (values %names) {
	foreach ($pkg-&gt;obsoletes) {
	    if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*)\s*([^\s\]]*)/) {
		if ($n ne $pkg-&gt;name &amp;&amp; $names{$n} &amp;&amp; (!$o || eval($names{$n}-&gt;compare($v) . $o . 0))) {
		    #- an existing best package is obsoleted by another one.
		    $skip{$n} = undef;
		}
		push @{$obsoletes{$n}}, $pkg;
	    }
	}
    }

    #- ignore skipped packages.
    delete @names{keys %skip};

    #- now we can examine all existing packages to find packages to upgrade.
    $db-&gt;traverse(sub {
	my ($p) = @_;
	#- first try with package using the same name.
	#- this will avoid selecting all packages obsoleting an old one.
	if (my $pkg = $names{$p-&gt;name}) {
	    unless ($pkg-&gt;flag_upgrade || $pkg-&gt;flag_installed) {
		$pkg-&gt;set_flag_installed; #- there is at least one package installed (whatever its version).
		$pkg-&gt;set_flag_upgrade;
	    }
	    $pkg-&gt;flag_upgrade and $pkg-&gt;set_flag_upgrade($pkg-&gt;compare_pkg($p) &gt; 0);
	    #- keep in mind the package is requested.
	    if ($pkg-&gt;flag_upgrade) {
		$requested{$p-&gt;name} = undef;
	    } else {
		delete $names{$p-&gt;name};
	    }
	}

	#- check provides of existing package to see if an obsolete
	#- may allow selecting it.
	foreach my $property ($p-&gt;provides) {
	    #- only real provides should be taken into account, this means internal obsoletes
	    #- should be avoided.
	    unless ($p-&gt;obsoletes_overlap($property)) {
		if (my ($n) = $property =~ /^([^\s\[]*)/) {
		    foreach my $pkg (@{$obsoletes{$n} || []}) {
			next if $pkg-&gt;name eq $p-&gt;name || $p-&gt;name ne $n || !$names{$pkg-&gt;name};
			if ($pkg-&gt;obsoletes_overlap($property)) {
			    #- the package being examined can be obsoleted.
			    #- do not set installed and provides flags.
			    push @obsoleters, $pkg;
			    return;
			}
		    }
		}
	    }
	}
    });

    #- examine all obsoleter packages, compute installer and upgrade flag if needed.
    foreach my $pkg (@obsoleters) {
	next if !$names{$pkg-&gt;name};
	unless ($pkg-&gt;flag_upgrade || $pkg-&gt;flag_installed) {
	    #- assume for this small algorithm package to be upgradable.
	    $pkg-&gt;set_flag_upgrade;
	    $db-&gt;traverse_tag(
		'name', [ $pkg-&gt;name ], sub {
		    my ($p) = @_;
		    $pkg-&gt;set_flag_installed; #- there is at least one package installed (whatever its version).
		    $pkg-&gt;flag_upgrade and $pkg-&gt;set_flag_upgrade($pkg-&gt;compare_pkg($p) &gt; 0);
		},
	    );
	}
	if ($pkg-&gt;flag_installed &amp;&amp; !$pkg-&gt;flag_upgrade) {
	    delete $names{$pkg-&gt;name};
	} else {
	    $requested{$pkg-&gt;name} = undef;
	}
    }

    #- examine all packages which may be conflicting. If a package conflicts, it should not be requested.
    my @names = map { $_-&gt;name . " == " . $_-&gt;epoch . ":" . $_-&gt;version . "-" . $_-&gt;release } values %names;
    my @pkgs = values %names;
    foreach my $pkg (@pkgs) {
	exists $requested{$pkg-&gt;name} or next;
	foreach my $conflict ($pkg-&gt;conflicts) {
	    delete @names{map { /(\S*)/ &amp;&amp; $1 } grep { ranges_overlap($conflict, $_) } @names};
	}
    }

    #- examine all packages potentially selectable.
    foreach my $pkg (values %names) {
	exists $requested{$pkg-&gt;name} and $requested-&gt;{$pkg-&gt;id} = $options{requested};
    }

    $requested;
}

#- detect a dependency relation.
sub has_dependence {
    my ($urpm, $state, $a, $b) = @_;
    my %examined; $examined{$a} = undef;
    my @closure = $urpm-&gt;{depslist}[$a];

    while (my $pkg = shift @closure) {
	$pkg-&gt;id eq $b and return 1;
	if (my $from = $state-&gt;{selected}{$pkg-&gt;id}{from}) {
	    unless (exists $examined{$from-&gt;id}) {
		$examined{$from-&gt;id} = undef;
		push @closure, $from;
	    }
	}
	foreach ($pkg-&gt;provides_nosense) {
	    foreach (keys %{$state-&gt;{whatrequires}{$_} || {}}) {
		my $p = $urpm-&gt;{depslist}[$_] or next;
		$state-&gt;{selected}{$p-&gt;id} or next;
		exists $examined{$p-&gt;id} and next;
		$examined{$p-&gt;id} = undef;
		push @closure, $p;
	    }
	}
    }

    return 0;
}

#- build transaction set for given selection
sub build_transaction_set {
    my ($urpm, $db, $state, %options) = @_;

    #- clean transaction set.
    $state-&gt;{transaction} = [];

    my %selected_id;
    @selected_id{$urpm-&gt;build_listid($options{start}, $options{end}, $options{idlist})} = ();
    
    if ($options{split_length}) {
	#- first step consists of sorting packages according to dependencies.
	my @sorted = sort { ($a &lt;=&gt; $b, -1, 1, 0)[($urpm-&gt;has_dependence($state, $a, $b) &amp;&amp; 1) +
						  ($urpm-&gt;has_dependence($state, $b, $a) &amp;&amp; 2)] }
	  (keys(%selected_id) &gt; 0 ? 
	      (grep { exists($selected_id{$_}) } keys %{$state-&gt;{selected}}) : 
	      keys %{$state-&gt;{selected}});

	#- second step consists of re-applying resolve_requested in the same
	#- order computed in first step and to update a list of packages to
	#- install, to upgrade and to remove.
	my (%requested, %examined);
	foreach (@sorted) {
	    $requested{$_} = undef;
	    if (keys(%requested) &gt;= $options{split_length}) {
		my %set;

		$urpm-&gt;resolve_requested(
		    $db, $state-&gt;{transaction_state} ||= {},
		    \%requested,
		    keep_requested_flag =&gt; 1,
		    defined $options{start} ? (start =&gt; $options{start}) : @{[]},
		    defined $options{end}   ? (end   =&gt; $options{end}) : @{[]},
		);
		%requested = ();

		foreach (keys %{$state-&gt;{transaction_state}{selected}}) {
		    exists $examined{$_} and next;
		    $examined{$_} = undef;
		    push @{$set{upgrade}}, $_;
		}
		foreach (keys %{$state-&gt;{transaction_state}{rejected}}) {
		    exists $examined{$_} and next;
		    $examined{$_} = undef;
		    $state-&gt;{transaction_state}{rejected}{$_}{removed} &amp;&amp;
		      !$state-&gt;{transaction_state}{rejected}{$_}{obsoleted} or next;
		    push @{$set{remove}}, $_;
		}
		%set and push @{$state-&gt;{transaction}}, \%set;
	    }
	}

	#- check that the transaction set has been correctly created.
	#- (ie that no other package was removed)
	if (keys(%{$state-&gt;{selected}}) == keys(%{$state-&gt;{transaction_state}{selected}}) &amp;&amp;
	    (grep { $state-&gt;{rejected}{$_}{removed} &amp;&amp; !$state-&gt;{rejected}{$_}{obsoleted} } keys %{$state-&gt;{rejected}}) ==
	    (grep { $state-&gt;{transaction_state}{rejected}{$_}{removed} &amp;&amp; !$state-&gt;{transaction_state}{rejected}{$_}{obsoleted} }
	     keys %{$state-&gt;{transaction_state}{rejected}})
	   ) {
	    foreach (keys(%{$state-&gt;{selected}})) {
		exists $state-&gt;{transaction_state}{selected}{$_} and next;
		$state-&gt;{transaction} = []; last;
	    }
	    foreach (grep { $state-&gt;{rejected}{$_}{removed} &amp;&amp; !$state-&gt;{rejected}{$_}{obsoleted} } keys %{$state-&gt;{rejected}}) {
		$state-&gt;{transaction_state}{rejected}{$_}{removed} &amp;&amp;
		  !$state-&gt;{transaction_state}{rejected}{$_}{obsoleted} and next;
		$state-&gt;{transaction} = []; last;
	    }
	}
    }

    #- fallback if something can be selected but nothing has been allowed in transaction list.
    if (%{$state-&gt;{selected} || {}} &amp;&amp; !@{$state-&gt;{transaction}}) {
	push @{$state-&gt;{transaction}}, {
					upgrade =&gt; [ keys %{$state-&gt;{selected}} ],
					remove  =&gt; [ grep { $state-&gt;{rejected}{$_}{removed} &amp;&amp; !$state-&gt;{rejected}{$_}{obsoleted} }
						     keys %{$state-&gt;{rejected}} ],
				       };
    }

    $state-&gt;{transaction};
}

#- compatiblity method which are going to be removed.
sub resolve_closure_ask_remove {
    my ($urpm, $db, $state, $pkg, $from, $why) = @_;

    print STDERR "calling obsoleted method URPM::resolve_closure_ask_remove\n";

    my @unsatisfied;
    $urpm-&gt;resolve_rejected($db, $state, $pkg, from =&gt; $from, why =&gt; $why, removed =&gt; 1, unsatisfied =&gt; \@unsatisfied);

    #- rebuild correctly ask_remove hash.
    delete $state-&gt;{ask_remove};
    foreach (keys %{$state-&gt;{rejected}}) {
	$state-&gt;{rejected}{$_}{obsoleted} and next;
	$state-&gt;{rejected}{$_}{removed} or next;

	$state-&gt;{ask_remove}{$_}{closure} = $state-&gt;{rejected}{$_}{closure}; #- fullnames are not converted back to id as expected.
	$state-&gt;{ask_remove}{$_}{size} = $state-&gt;{rejected}{$_}{size};
    }

    @unsatisfied;
}
sub resolve_unrequested {
    my ($urpm, $db, $state, $unrequested, %_options) = @_;

    print STDERR "calling obsoleted method URPM::resolve_unrequested\n";

    my @l = $urpm-&gt;disable_selected($db, $state, map { $urpm-&gt;{depslist}[$_] } keys %$unrequested);

    #- build unselected accordingly.
    delete $state-&gt;{unselected};
    foreach (@l) {
	delete $unrequested-&gt;{$_-&gt;id};
	$state-&gt;{unselected}{$_-&gt;id} = undef;
    }

    #- use return value of old method.
    %$unrequested &amp;&amp; $unrequested;
}

1;
</pre></body></html>