aboutsummaryrefslogtreecommitdiffstats
path: root/URPM/Resolve.pm
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2003-06-16 17:57:07 +0000
committerFrancois Pons <fpons@mandriva.com>2003-06-16 17:57:07 +0000
commitb3e34403f39ad7f2a870fd39f35092ac878efd20 (patch)
tree7b91ecb3e76c51d398f4c565053293bf4f5a44bf /URPM/Resolve.pm
parent66011a9963f689f72cfb95b3c46ae4d77bf709c1 (diff)
downloadperl-URPM-b3e34403f39ad7f2a870fd39f35092ac878efd20.tar
perl-URPM-b3e34403f39ad7f2a870fd39f35092ac878efd20.tar.gz
perl-URPM-b3e34403f39ad7f2a870fd39f35092ac878efd20.tar.bz2
perl-URPM-b3e34403f39ad7f2a870fd39f35092ac878efd20.tar.xz
perl-URPM-b3e34403f39ad7f2a870fd39f35092ac878efd20.zip
0.91-1mdk0.91
Diffstat (limited to 'URPM/Resolve.pm')
-rw-r--r--URPM/Resolve.pm162
1 files changed, 131 insertions, 31 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index c7e8451..7f1d74e 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -159,7 +159,7 @@ sub unsatisfied_requires {
#- check on selected package if a provide is satisfying the resolution (need to do the ops).
foreach (keys %{$urpm->{provides}{$n} || {}}) {
my $p = $urpm->{depslist}[$_];
- $p->flag_selected || exists $state->{selected}{$_} or next;
+ exists $state->{selected}{$_} or next;
if ($urpm->{provides}{$n}{$_}) {
#- sense information are used, this means we have to examine carrefully the provides.
foreach ($p->provides) {
@@ -202,7 +202,7 @@ sub unsatisfied_requires {
sub backtrack_selected {
my ($urpm, $db, $state, $dep, %options) = @_;
- if (defined $dep->{required} && $options{callback_backtrack}) {
+ if (defined $dep->{required}) {
#- search for all possible packages, first is to try the selection, then if it is
#- impossible, backtrack the origin.
my $packages = $urpm->find_candidate_packages($dep->{required});
@@ -213,8 +213,11 @@ sub backtrack_selected {
exists $state->{backtrack}{selected}{$_->id} and next;
#- a package if found is problably rejected or there is a problem.
if ($state->{rejected}{$_->fullname}) {
- if ($options{callback_backtrack}->($urpm, $db, $state, $_,
+ if (!$options{callback_backtrack} ||
+ $options{callback_backtrack}->($urpm, $db, $state, $_,
dep => $dep, alternatives => $packages, %options) <= 0) {
+ #- keep in mind a backtrack has happening here...
+ $state->{rejected}{$_->fullname}{backtrack} ||= {};
#- backtrack callback should return a strictly positive value if the selection of the new
#- package is prefered over the currently selected package.
next;
@@ -341,11 +344,13 @@ sub resolve_requested {
#- populate properties with backtrack informations.
while (my ($r, $v) = each %$requested) {
- #- keep track of requested packages by propating the flag.
- my $packages = $urpm->find_candidate_packages($r);
- foreach (values %$packages) {
- foreach (@$_) {
- $_->set_flag_requested;
+ unless ($options{keep_requested_flag}) {
+ #- keep track of requested packages by propating the flag.
+ my $packages = $urpm->find_candidate_packages($r);
+ foreach (values %$packages) {
+ foreach (@$_) {
+ $_->set_flag_requested;
+ }
}
}
#- keep value to be available from selected hash.
@@ -362,7 +367,7 @@ sub resolve_requested {
#- 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->{from} && !$options{keep_unrequested_dependencies}) {
- $dep->{from}->flag_selected || exists $state->{selected}{$dep->{from}->id} or next;
+ exists $state->{selected}{$dep->{from}->id} or next;
}
#- take the best choice possible.
@@ -389,7 +394,7 @@ sub resolve_requested {
#- now do the real work, select the package.
my ($pkg) = @chosen;
- !$pkg || $pkg->flag_selected || exists $state->{selected}{$pkg->id} and next;
+ !$pkg || exists $state->{selected}{$pkg->id} and next;
if ($pkg->arch eq 'src') {
$pkg->set_flag_upgrade;
@@ -430,13 +435,14 @@ sub resolve_requested {
push @selected, $pkg;
$state->{selected}{$pkg->id} = { exists $dep->{requested} ? (requested => $dep->{requested}) : @{[]},
exists $dep->{from} ? (from => $dep->{from}) : @{[]},
+ $pkg->flag_disable_obsolete ? (install => 1) : @{[]},
};
$pkg->set_flag_required;
#- 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') {
+ if ($pkg->arch ne 'src' && !$pkg->flag_disable_obsolete) {
my (%diff_provides);
foreach ($pkg->name." < ".$pkg->epoch.":".$pkg->version."-".$pkg->release, $pkg->obsoletes) {
@@ -498,7 +504,7 @@ sub resolve_requested {
@{$packages->{$p->name}};
if (length $best) {
- push @properties, { required => $best, promote => $n };
+ push @properties, { required => $best, from => $pkg, promote => $n };
} else {
#- no package have been found, we may need to remove the package examined unless
#- there exists a package that provided the unsatisfied requires.
@@ -510,7 +516,7 @@ sub resolve_requested {
}
if (@best == @l) {
- push @properties, map { +{ required => $_, promote => $n } } @best;
+ push @properties, map { +{ required => $_, from => $pkg, promote => $n } } @best;
} else {
$urpm->resolve_rejected($db, $state, $p,
removed => 1, unsatisfied => \@properties,
@@ -563,7 +569,7 @@ sub resolve_requested {
@{$packages->{$p->name}};
if (length $best) {
- push @properties, { required => $best, promote_conflicts => $name };
+ push @properties, { required => $best, from => $pkg, promote_conflicts => $name };
} else {
#- no package have been found, we need to remove the package examined.
$urpm->resolve_rejected($db, $state, $p,
@@ -604,7 +610,7 @@ sub disable_selected {
#- iterate over package needing unrequested one.
while (my $pkg = shift @closure) {
- $pkg->flag_selected || exists $state->{selected}{$pkg->id} or next;
+ exists $state->{selected}{$pkg->id} or next;
#- keep a trace of what is deselected.
push @unselected, $pkg;
@@ -633,7 +639,7 @@ sub disable_selected {
foreach my $n ($pkg->provides_nosense) {
foreach (keys %{$state->{whatrequires}{$n} || {}}) {
my $p = $urpm->{depslist}[$_];
- $p->flag_selected || exists $state->{selected}{$p->id} or next;
+ exists $state->{selected}{$p->id} or next;
if ($urpm->unsatisfied_requires($db, $state, $p, name => $n)) {
#- this package has broken dependencies and is selected.
push @closure, $p;
@@ -670,7 +676,7 @@ sub disable_selected_unrequested_dependencies {
foreach ($_->requires_nosense) {
foreach (keys %{$urpm->{provides}{$_} || {}}) {
my $pkg = $urpm->{depslist}[$_] or next;
- $pkg->flag_selected || exists $state->{selected}{$pkg->id} or next;
+ exists $state->{selected}{$pkg->id} or next;
$pkg->flag_requested and next;
$required{$pkg->id} = undef;
}
@@ -684,7 +690,7 @@ sub disable_selected_unrequested_dependencies {
foreach (keys %{$state->{whatrequires}{$_}}) {
my $p = $urpm->{depslist}[$_] or next;
exists $required{$p->id} and next;
- $p->flag_selected and $required{$pkg->id} = 1;
+ exists $state->{selected}{$p->id} and $required{$pkg->id} = 1;
}
}
}
@@ -725,35 +731,41 @@ sub compute_installed_flags {
\%sizes;
}
-#- compute skip flag according to hash describing package to remove
+#- compute flags according to hash describing package to remove
#- $skip 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,
-sub compute_skip_flags {
- my ($urpm, $skip, %options) = @_;
+sub compute_flags {
+ my ($urpm, $val, %options) = @_;
#- avoid losing our time.
- %$skip or return;
+ %$val or return;
foreach my $pkg (@{$urpm->{depslist}}) {
#- check if fullname is matching a regexp.
- if (grep { exists($skip->{$_}{''}) && /^\/(.*)\/$/ && $pkg->fullname =~ /$1/ } keys %$skip) {
+ if (grep { exists($val->{$_}{''}) && /^\/(.*)\/$/ && $pkg->fullname =~ /$1/ } keys %$val) {
#- a single selection on fullname using a regular expression.
- unless ($pkg->flag_skip) {
- $pkg->set_flag_skip(1);
- $options{callback} and $options{callback}->($urpm, $pkg, %options);
+ foreach (qw(skip disable_obsolete)) {
+ if ($options{$_} && !$pkg->flag($_)) {
+ $pkg->set_flag($_, 1);
+ $options{callback} and $options{callback}->($urpm, $pkg, %options);
+ }
}
} else {
#- check if a provides match at least one package.
foreach ($pkg->provides) {
if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
- foreach my $sn ($n, grep { /^\/(.*)\/$/ && $n =~ /$1/ } keys %$skip) {
- foreach (keys %{$skip->{$sn} || {}}) {
- if (URPM::ranges_overlap($_, $s) && !$pkg->flag_skip) {
- $pkg->set_flag_skip(1);
- $options{callback} and $options{callback}->($urpm, $pkg, %options);
+ foreach my $sn ($n, grep { /^\/(.*)\/$/ && $n =~ /$1/ } keys %$val) {
+ foreach (keys %{$val->{$sn} || {}}) {
+ if (URPM::ranges_overlap($_, $s)) {
+ foreach (qw(skip disable_obsolete)) {
+ if ($options{$_} && !$pkg->flag($_)) {
+ $pkg->set_flag($_, 1);
+ $options{callback} and $options{callback}->($urpm, $pkg, %options);
+ }
+ }
}
}
}
@@ -905,6 +917,87 @@ sub request_packages_to_upgrade {
$requested;
}
+#- detect a dependency relation.
+sub has_dependence {
+ my ($urpm, $state, $a, $b) = @_;
+ my %examined; $examined{$a} = undef;
+ my @closure = $urpm->{depslist}[$a];
+
+ while (my $pkg = shift @closure) {
+ $pkg->id eq $b and return 1;
+ if (my $from = $state->{selected}{$pkg->id}{from}) {
+ unless (exists $examined{$from->id}) {
+ $examined{$from->id} = undef;
+ push @closure, $from;
+ }
+ }
+ foreach ($pkg->provides_nosense) {
+ foreach (keys %{$state->{whatrequires}{$_} || {}}) {
+ my $p = $urpm->{depslist}[$_] or next;
+ $state->{selected}{$p->id} or next;
+ exists $examined{$p->id} and next;
+ $examined{$p->id} = undef;
+ push @closure, $p;
+ }
+ }
+ }
+
+ return 0;
+}
+
+#- build transaction set for given selection already done.
+sub build_transaction_set {
+ my ($urpm, $db, $state, %options) = @_;
+
+ if ($options{split_level}) {
+ #- first step consists of sorting packages according to dependencies.
+ my @sorted = sort { ($a <=> $b, -1, +1, 0)[($urpm->has_dependence($state, $a, $b) && 1) +
+ ($urpm->has_dependence($state, $b, $a) && 2)] }
+ grep { (! defined $options{start} || $_ >= $options{start}) &&
+ (! defined $options{end} || $_ <= $options{end})} keys %{$state->{selected}};
+
+ #- second step consists of re-applying resolve_requested in the same
+ #- order computed in first step and to update a list of package to
+ #- install, to upgrade and to remove.
+ my (%requested, %examined);
+ foreach (@sorted) {
+ $requested{$_} = undef;
+ if (keys(%requested) >= $options{split_level}) {
+ my %set;
+
+ $urpm->resolve_requested($db, $state->{transaction_state} ||= {}, \%requested,
+ keep_requested_flag => 1,
+ defined $options{start} ? (start => $options{start}) : @{[]},
+ defined $options{end} ? (end => $options{end}) : @{[]});
+ %requested = ();
+
+ foreach (keys %{$state->{transaction_state}{selected}}) {
+ exists $examined{$_} and next;
+ $examined{$_} = undef;
+ push @{$set{upgrade}}, $_;
+ }
+ foreach (keys %{$state->{transaction_state}{rejected}}) {
+ exists $examined{$_} and next;
+ $examined{$_} = undef;
+ $state->{transaction_state}{rejected}{$_}{removed} &&
+ !$state->{transaction_state}{rejected}{$_}{obsoleted} or next;
+ push @{$set{remove}}, $_;
+ }
+ %set and push @{$state->{transaction}}, \%set;
+ }
+ }
+ } else {
+ #- no split is necessary, simply extract from current selection.
+ $state->{transaction} = [ {
+ upgrade => [ keys %{$state->{selected}} ],
+ remove => [ grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} }
+ keys %{$state->{rejected}} ],
+ } ];
+ }
+
+ $state->{transaction};
+}
+
#- compatiblity method which are going to be removed.
sub resolve_closure_ask_remove {
my ($urpm, $db, $state, $pkg, $from, $why, $avoided) = @_;
@@ -943,5 +1036,12 @@ sub resolve_unrequested {
#- use return value of old method.
%$unrequested && $unrequested;
}
+sub compute_skip_flags {
+ my ($urpm, $skip, %options) = @_;
+
+ print STDERR "calling obsoleted method URPM::compute_skip_flags\n";
+
+ $urpm->compute_flags($skip, %options, skpip => 1);
+}
1;