diff options
author | Francois Pons <fpons@mandriva.com> | 2002-07-10 10:19:10 +0000 |
---|---|---|
committer | Francois Pons <fpons@mandriva.com> | 2002-07-10 10:19:10 +0000 |
commit | 907fd3eb24c1fc99c22946923081f34952a21b9e (patch) | |
tree | cbb1ea6fd0612b6d6072981ba83cd0d85575a1da /URPM | |
parent | 20b4b20c3df7fbede8ed99d6e13148c3f5719ec6 (diff) | |
download | perl-URPM-907fd3eb24c1fc99c22946923081f34952a21b9e.tar perl-URPM-907fd3eb24c1fc99c22946923081f34952a21b9e.tar.gz perl-URPM-907fd3eb24c1fc99c22946923081f34952a21b9e.tar.bz2 perl-URPM-907fd3eb24c1fc99c22946923081f34952a21b9e.tar.xz perl-URPM-907fd3eb24c1fc99c22946923081f34952a21b9e.zip |
0.09-1mdk
Diffstat (limited to 'URPM')
-rw-r--r-- | URPM/Resolve.pm | 103 |
1 files changed, 73 insertions, 30 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm index 1fd1b4d..a88b8c6 100644 --- a/URPM/Resolve.pm +++ b/URPM/Resolve.pm @@ -38,7 +38,7 @@ sub unsatisfied_requires { foreach ($pkg->requires) { if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) { #- allow filtering on a given name (to speed up some search). - ! defined $name || $n eq $s or next; + ! defined $name || $n eq $name or next; #- avoid recomputing the same all the time. exists $properties{$_} || $state->{installed}{$_} and next; @@ -78,6 +78,34 @@ sub unsatisfied_requires { keys %properties; } +#- close ask_remove (as urpme previously) for package to be removable without error. +sub resolve_closure_ask_remove { + my ($urpm, $db, $state, $pkg, $why) = @_; + my $name = join '-', ($pkg->fullname)[0..2]; #- specila name (without arch) to allow selection. + + #- check if the package has already been asked to removed, + #- this means only add the new reason and return. + unless ($state->{ask_remove}{$name}) { + my @removes = ($pkg); + + while ($pkg = shift @removes) { + foreach ($pkg->provides_nosense) { + $db->traverse_tag('whatrequires', [ $_ ], sub { + my ($p) = @_; + if (my @l = $urpm->unsatisfied_requires($db, $state, $p, $_)) { + push @{$state->{ask_remove}{join '-', ($p->fullname)[0..2]}}, + { unsatisfied => \@l, closure => $name }; + + $p->pack_header; #- need to pack else package is no more visible... + push @removes, $p; + } + }); + } + } + } + push @{$state->{ask_remove}{$name}}, $why; +} + #- 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. @@ -137,30 +165,47 @@ sub resolve_requested { } else { @chosen = values %$packages; } + @chosen = sort { $a->id <=> $b->id } @chosen; #- sort package in order to have best ones first. if (!$pkg && $options{callback_choices} && @chosen > 1) { $pkg = $options{callback_choices}->($urpm, $db, $state, \@chosen); $pkg or next; #- callback may decide to not continue (or state is already updated). } $pkg ||= $chosen[0]; - $pkg && !$pkg->flag_requested && !$pkg->flag_required or next; + !$pkg || $pkg->flag_requested || $pkg->flag_required || exists $state->{selected}{$pkg->id} and next; + + if ($pkg->arch eq 'src') { + $pkg->set_flag_upgrade; + } else { + unless ($pkg->flag_upgrade || $pkg->flag_installed) { + #- assume for this small algorithm package to be upgradable. + $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). + $pkg->flag_upgrade and $pkg->set_flag_upgrade($pkg->compare_pkg($p) > 0); + }); + } + $pkg->flag_installed && !$pkg->flag_upgrade and next; + } #- keep in mind the package has be selected. - $pkg->set_flag_requested($state->{selected}{$pkg->id} = delete $requested{$dep}); - $pkg->set_flag_required(!$pkg->flag_requested); + $state->{selected}{$pkg->id} = delete $requested{$dep}; + $options{no_flag_update} or + $state->{selected}{$pkg->id} ? $pkg->set_flag_requested : $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') { - $pkg->flag_installed and delete $state->{selected}{$pkg->id}, next; - unless ($pkg->flag_upgrade) { + unless ($pkg->flag_upgrade || $pkg->flag_installed) { + #- assume for this small algorithm package to be upgradable. + $pkg->set_flag_upgrade; $db->traverse_tag('name', [ $pkg->name ], sub { my ($p) = @_; - $pkg->flag_installed or - $pkg->set_flag_installed($pkg->compare_pkg($p) <= 0); + $pkg->set_flag_installed; #- there is at least one package installed (whatever its version). + $pkg->flag_upgrade and $pkg->set_flag_upgrade($pkg->compare_pkg($p) > 0); }); - $pkg->set_flag_upgrade(!$pkg->flag_installed); } - $pkg->flag_installed and delete $state->{selected}{$pkg->id}, next; + $pkg->flag_installed && !$pkg->flag_upgrade and next; #- keep in mind the provides of this package, so that future requires can be satisfied #- with this package potentially. @@ -213,8 +258,8 @@ sub resolve_requested { push @properties, $best->id; } else { #- no package have been found, we need to remove the package examined. - push @{$state->{ask_remove}{join '-', ($p->fullname)[0..2]}}, - { unsatisfied => \@l, pkg => $pkg }; + $urpm->resolve_closure_ask_remove($db, $state, $p, + { unsatisfied => \@l, pkg => $pkg }); } } }); @@ -232,8 +277,8 @@ sub resolve_requested { my ($p) = @_; $state->{conflicts}{$p->fullname}{$pkg->id} = undef; #- all these packages should be removed. - push @{$state->{ask_remove}{join '-', ($p->fullname)[0..2]}}, - { conflicts => $file, pkg => $pkg }; + $urpm->resolve_closure_ask_remove($db, $state, $p, + { conflicts => $file, pkg => $pkg }); }); } elsif (my ($property, $name) = /^(([^\s\[]*).*)/) { $db->traverse_tag('whatprovides', [ $name ], sub { @@ -256,8 +301,8 @@ sub resolve_requested { push @properties, $best->id; } else { #- no package have been found, we need to remove the package examined. - push @{$state->{ask_remove}{join '-', ($p->fullname)[0..2]}}, - { conflicts => $property, pkg => $pkg }; + $urpm->resolve_closure_ask_remove($db, $state, $p, + { conflicts => $property, pkg => $pkg }); } } }); @@ -281,23 +326,22 @@ sub resolve_requested { sub compute_installed_flags { my ($urpm, $db) = @_; - #- first pass check according existing package. + #- first pass to initialize flags installed and upgrade for all package. + foreach (@{$urpm->{depslist}}) { + $_->flag_upgrade || $_->flag_installed or $_->set_flag_upgrade; + } + + #- second pass to set installed flag and clean upgrade flag according to installed packages. $db->traverse(sub { my ($p) = @_; foreach (keys %{$urpm->{provides}{$p->name} || {}}) { my $pkg = $urpm->{depslist}[$_]; $pkg->name eq $p->name or next; #- compute only installed and upgrade flags. - $pkg->set_flag_installed($pkg->compare_pkg($p) <= 0); - $pkg->set_flag_upgrade(!$pkg->flag_installed); + $pkg->set_flag_installed; #- there is at least one package installed (whatever its version). + $pkg->flag_upgrade and $pkg->set_flag_upgrade($pkg->compare_pkg($p) > 0); } }); - - #- second pass allow not installed package to be seen as upgrade. - foreach (@{$urpm->{depslist}}) { - $_->flag_upgrade || $_->flag_installed and next; - $_->set_flag_upgrade(1); - } } #- select packages to upgrade, according to package already registered. @@ -342,15 +386,14 @@ sub resolve_packages_to_upgrade { #- first try with package using the same name. #- this will avoid selecting all packages obsoleting an old one. if (my $pkg = $names{$p->name}) { + $pkg->flag_upgrade || $pkg->flag_installed or $pkg->set_flag_upgrade; + $pkg->set_flag_installed; if ($pkg->compare_pkg($p) <= 0) { #- this means the package is already installed (or there #- is a old version in depslist). - $pkg->set_flag_installed(1); $pkg->set_flag_upgrade(0); - } else { - #- the depslist version is better than existing one. - $pkg->set_flag_installed(0); - $pkg->set_flag_upgrade(1); + } elsif ($pkg->flag_upgrade) { + #- the depslist version is better than existing one and no existing package is still better. $state->{requested}{$pkg->id} = $options{requested}; return; } |