aboutsummaryrefslogtreecommitdiffstats
path: root/URPM
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2003-05-16 15:11:26 +0000
committerFrancois Pons <fpons@mandriva.com>2003-05-16 15:11:26 +0000
commit89a57ce09d4a2af1ee997be0ac2d34b91044e356 (patch)
tree34ae7d98b4c35cefda981f0ac254afddb4a161ce /URPM
parent2110778bece2b7670ae2c0f02f3cb15abb89c5df (diff)
downloadperl-URPM-89a57ce09d4a2af1ee997be0ac2d34b91044e356.tar
perl-URPM-89a57ce09d4a2af1ee997be0ac2d34b91044e356.tar.gz
perl-URPM-89a57ce09d4a2af1ee997be0ac2d34b91044e356.tar.bz2
perl-URPM-89a57ce09d4a2af1ee997be0ac2d34b91044e356.tar.xz
perl-URPM-89a57ce09d4a2af1ee997be0ac2d34b91044e356.zip
0.84-1mdk
Diffstat (limited to 'URPM')
-rw-r--r--URPM/Resolve.pm150
1 files changed, 66 insertions, 84 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index 7624254..da26dda 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -35,50 +35,65 @@ sub find_candidate_packages {
#- return unresolved requires of a package (a new one or a existing one).
sub unsatisfied_requires {
- my ($_urpm, $db, $state, $pkg, %options) = @_;
+ my ($urpm, $db, $state, $pkg, %options) = @_;
my %properties;
#- all requires should be satisfied according to selected package, or installed packages.
- foreach ($pkg->requires) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
+ REQUIRES: foreach my $dep ($pkg->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;
+ ! defined $options{name} || $n eq $options{name} or next REQUIRES;
#- avoid recomputing the same all the time.
- exists $properties{$_} || $state->{installed}{$_} and next;
+ exists $properties{$dep} and next REQUIRES;
+
+ #- check for installed package in the cache (only without sense to speed up)
+ foreach (keys %{$state->{cached_installed}{$n} || {}}) {
+ exists $state->{obsoleted}{$_} and next;
+ exists $state->{ask_remove}{$_} and next;
+ next REQUIRES;
+ }
- #- keep track if satisfied.
- my $satisfied = 0;
#- check on selected package if a provide is satisfying the resolution (need to do the ops).
- foreach my $sense (keys %{$state->{provided}{$n} || {}}) {
- ranges_overlap($sense, $s) and ++$satisfied, last;
+ foreach (keys %{$urpm->{provides}{$n} || {}}) {
+ exists $state->{selected}{$_} or next;
+ my $p = $urpm->{depslist}[$_];
+ if ($urpm->{provides}{$n}{$_}) {
+ #- sense information are used, this means we have to examine carrefully the provides.
+ foreach ($p->provides) {
+ ranges_overlap($_, $dep) and next REQUIRES;
+ }
+ } else {
+ next REQUIRES;
+ }
}
+
#- check on installed system a package which is not obsoleted is satisfying the require.
- unless ($satisfied) {
- if ($n =~ /^\//) {
- $db->traverse_tag('path', [ $n ], sub {
- my ($p) = @_;
- exists $state->{obsoleted}{$p->fullname} and return;
- $state->{ask_remove}{join '-', ($p->fullname)[0..2]} and return;
- ++$satisfied;
- });
- } else {
- $db->traverse_tag('whatprovides', [ $n ], sub {
- my ($p) = @_;
- exists $state->{obsoleted}{$p->fullname} and return;
- $state->{ask_remove}{join '-', ($p->fullname)[0..2]} and return;
- foreach ($p->provides) {
- $options{keep_state} or $state->{installed}{$_}{$p->fullname} = undef;
- if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- $pn eq $n or next;
- ranges_overlap($ps, $s) and ++$satisfied;
- }
+ my $satisfied = 0;
+ if ($n =~ /^\//) {
+ $db->traverse_tag('path', [ $n ], sub {
+ my ($p) = @_;
+ exists $state->{obsoleted}{$p->fullname} and return;
+ exists $state->{ask_remove}{$p->fullname} and return;
+ $state->{cached_installed}{$n}{$p->fullname} = undef;
+ ++$satisfied;
+ });
+ } else {
+ $db->traverse_tag('whatprovides', [ $n ], sub {
+ my ($p) = @_;
+ exists $state->{obsoleted}{$p->fullname} and return;
+ exists $state->{ask_remove}{$p->fullname} and return;
+ foreach ($p->provides) {
+ if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
+ $ps or $state->{cached_installed}{$pn}{$p->fullname} = undef;
+ $pn eq $n or next;
+ ranges_overlap($ps, $s) and ++$satisfied;
}
- });
- }
+ }
+ });
}
#- if nothing can be done, the require should be resolved.
- $satisfied or $properties{$_} = undef;
+ $satisfied or $properties{$dep} = undef;
}
}
keys %properties;
@@ -87,30 +102,23 @@ sub unsatisfied_requires {
#- close ask_remove (as urpme previously) for package to be removable without error.
sub resolve_closure_ask_remove {
my ($urpm, $db, $state, $pkg, $from, $why, $avoided) = @_;
- my $name = join '-', ($pkg->fullname)[0..2]; #- specila name (without arch) to allow selection.
my @unsatisfied;
#- allow default value for 'from' to be taken.
- $from ||= $name;
+ $from ||= $pkg->fullname;
#- keep track to avoided removed package.
$avoided and $avoided->{$pkg->fullname} = undef;
#- check if the package has already been asked to be removed,
#- this means only add the new reason and return.
- unless ($state->{ask_remove}{$name}) {
- $state->{ask_remove}{$name} = { size => $pkg->size,
- closure => { $from => $why },
- };
+ unless ($state->{ask_remove}{$pkg->fullname}) {
+ $state->{ask_remove}{$pkg->fullname} = { size => $pkg->size,
+ closure => { $from => $why },
+ };
my @removes = $pkg;
while ($pkg = shift @removes) {
- #- clean state according to provided properties.
- foreach ($pkg->provides) {
- delete $state->{installed}{$_}{$pkg->fullname};
- %{$state->{installed}{$_} || {}} or delete $state->{installed}{$_};
- }
-
#- close what requires this property, but check with selected package requiring old properties.
foreach ($pkg->provides) {
if (my ($n) = /^([^\s\[]*)/) {
@@ -125,13 +133,13 @@ sub resolve_closure_ask_remove {
$db->traverse_tag('whatrequires', [ $n ], sub {
my ($p) = @_;
if (my @l = $urpm->unsatisfied_requires($db, $state, $p, name => $n, keep_state => 1)) {
- my $v = $state->{ask_remove}{join '-', ($p->fullname)[0..2]} ||= {};
+ my $v = $state->{ask_remove}{$p->fullname} ||= {};
#- keep track to avoided removed package.
$avoided and $avoided->{$p->fullname} = undef;
#- keep track of what cause closure.
- $v->{closure}{$name} = { unsatisfied => \@l };
+ $v->{closure}{$pkg->fullname} = { unsatisfied => \@l };
exists $v->{size} and return;
$v->{size} = $p->size;
@@ -143,7 +151,7 @@ sub resolve_closure_ask_remove {
}
}
} else {
- $state->{ask_remove}{$name}{closure}{$from} = $why;
+ $state->{ask_remove}{$pkg->fullname}{closure}{$from} = $why;
}
@unsatisfied;
@@ -158,16 +166,6 @@ sub resolve_closure_ask_remove {
#- the following options are recognized :
#- check : check requires of installed packages.
sub resolve_requested {
- #- internal method to simplify code.
- sub update_state_provides {
- my ($state, $pkg) = @_;
- foreach ($pkg->provides) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- $state->{provided}{$n}{$s}{$pkg->id} = undef;
- }
- }
- };
-
my ($urpm, $db, $state, $requested, %options) = @_;
my (@properties, @obsoleted, %requested, %avoided, $dep);
@@ -175,7 +173,9 @@ sub resolve_requested {
#- on choices instead of anything other one.
@properties = keys %$requested;
foreach my $dep (@properties) {
- @requested{split '\|', $dep} = ();
+ foreach (split '\|', $dep) {
+ $requested{$_} = $requested->{$dep};
+ }
}
#- for each dep property evaluated, examine which package will be obsoleted on $db,
@@ -294,7 +294,6 @@ sub resolve_requested {
$db->traverse_tag('name', [ $pkg->name ], sub {
my ($p) = @_;
if ($pkg->compare_pkg($p) < 0) {
- $allow or update_state_provides($state, $pkg);
$allow = ++$state->{oldpackage};
$options{keep_state} or
push @properties, $urpm->resolve_closure_ask_remove($db, $state, $p, $pkg->id,
@@ -318,10 +317,6 @@ sub resolve_requested {
#- check if package is not already installed before trying to use it, compute
#- obsoleted package too. this is valable only for non source package.
if ($pkg->arch ne 'src') {
- #- keep in mind the provides of this package, so that future requires can be satisfied
- #- with this package potentially.
- $allow or update_state_provides($state, $pkg);
-
foreach ($pkg->name." < ".$pkg->epoch.":".$pkg->version."-".$pkg->release, $pkg->obsoletes) {
if (my ($n, $o, $v) = /^([^\s\[]*)(?:\[\*\])?\s*\[?([^\s\]]*)\s*([^\s\]]*)/) {
#- populate avoided entries according to what is selected.
@@ -349,14 +344,17 @@ sub resolve_requested {
$state->{obsoleted}{$p->fullname}{$pkg->id} = undef;
foreach ($p->provides) {
- #- clean installed property.
- if (my ($ip) = $state->{installed}{$_}) {
- delete $ip->{$p->fullname};
- %$ip or delete $state->{installed}{$_};
- }
#- check differential provides between obsoleted package and newer one.
if (my ($pn, $ps) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- ($state->{provided}{$pn} || {})->{$ps} or $diff_provides{$pn} = undef;
+ $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};
+ }
+ }
}
}
});
@@ -481,18 +479,6 @@ sub resolve_requested {
}
if ($options{keep_state}) {
- #- clear state provided according to selection done.
- foreach (keys %{$state->{selected} || {}}) {
- my $pkg = $urpm->{depslist}[$_];
-
- foreach ($pkg->provides) {
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- delete $state->{provided}{$n}{$s}{$pkg->id};
- %{$state->{provided}{$n}{$s}} or delete $state->{provided}{$n}{$s};
- }
- }
- }
-
#- clear state obsoleted according to saved obsoleted.
foreach (@obsoleted) {
if (ref $_) {
@@ -537,10 +523,6 @@ sub resolve_unrequested {
#- state should be cleaned by any reference to it.
foreach ($pkg->provides) {
$diff_provides{$_} = undef;
- if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- delete $state->{provided}{$n}{$s}{$pkg->id};
- %{$state->{provided}{$n}{$s}} or delete $state->{provided}{$n}{$s};
- }
}
foreach ($pkg->name, $pkg->obsoletes_nosense) {
$db->traverse_tag('name', [ $_ ], sub {