diff options
Diffstat (limited to 'URPM/Resolve.pm')
-rw-r--r-- | URPM/Resolve.pm | 174 |
1 files changed, 67 insertions, 107 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm index eb9bfef..b7c07cd 100644 --- a/URPM/Resolve.pm +++ b/URPM/Resolve.pm @@ -1430,133 +1430,93 @@ sub compute_flags { } } -#- 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. -#- (used for --auto-select) -#- -#- side-effects: -#- + those of _request_packages_to_upgrade_2 (flag_install, flag_upgrade) -sub request_packages_to_upgrade { - my ($urpm, $db, $_state, $requested, %options) = @_; +#- side-effects: none +sub _choose_best_pkg { + my ($urpm, $pkg_installed, @pkgs) = @_; - my ($names, $obsoletes) = _request_packages_to_upgrade_1($urpm, %options) or return; - _request_packages_to_upgrade_2($urpm, $db, $requested, $names, $obsoletes, %options); + _choose_best_pkg_($urpm, $pkg_installed, grep { + $_->compare_pkg($pkg_installed) > 0; + } @pkgs); } #- side-effects: none -sub _request_packages_to_upgrade_1 { - my ($urpm, %options) = @_; - my (%names, %skip); - - my @idlist = $urpm->build_listid($options{start}, $options{end}, $options{idlist}) or return; - - #- build direct access to best package per name. - foreach my $pkg (@{$urpm->{depslist}}[@idlist]) { - - if ($pkg->is_arch_compat) { - my $p = $names{$pkg->name}; - !$p || $pkg->compare_pkg($p) > 0 and $names{$pkg->name} = $pkg; +sub _choose_best_pkg_ { + my ($urpm, $pkg_installed, @pkgs) = @_; + + my $best; + foreach my $pkg (grep { + !strict_arch($urpm) || strict_arch_check($pkg_installed, $_); + } @pkgs) { + if (!$best || ($pkg->compare_pkg($best) || $pkg->id < $best->id) > 0) { + $best = $pkg; } } + $best; +} - #- 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. - my %obsoletes; - foreach my $pkg (values %names) { - foreach ($pkg->obsoletes) { - if (my ($n, $o, $v) = property2name_op_version($_)) { - if ($n ne $pkg->name && $names{$n} && (!$o || eval($names{$n}->compare($v) . $o . 0))) { - #- an existing best package is obsoleted by another one. - $skip{$n} = undef; - } - push @{$obsoletes{$n}}, $pkg; - } - } - } +#- side-effects: none +sub _choose_bests_obsolete { + my ($urpm, $db, $pkg_installed, @pkgs) = @_; + + _set_flag_installed_and_upgrade_if_no_newer($db, $_) foreach @pkgs; - #- ignore skipped packages. - delete @names{keys %skip}; + my %by_name; + push @{$by_name{$_->name}}, $_ foreach grep { $_->flag_upgrade } @pkgs; - \%names, \%obsoletes; + map { _choose_best_pkg_($urpm, $pkg_installed, @$_) } values %by_name; } -#- side-effects: flag_installed, flag_upgrade -sub _request_packages_to_upgrade_2 { - my ($_urpm, $db, $requested, $names, $obsoletes, %options) = @_; - my %names = %$names; - my (%requested, @obsoleters); +#- 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. +#- (used for --auto-select) +#- +#- side-effects: $requisted, flag_installed, flag_upgrade +sub request_packages_to_upgrade { + my ($urpm, $db, $state, $requested, %options) = @_; + + my %by_name; #- now we can examine all existing packages to find packages to upgrade. $db->traverse(sub { - my ($p) = @_; - my $pn = $p->name; - #- first try with package using the same name. - #- this will avoid selecting all packages obsoleting an old one. - if (my $pkg = $names{$pn}) { - my $may_upgrade = $pkg->flag_upgrade || #- it is has already been flagged upgradable - !$pkg->flag_installed && do { - $pkg->set_flag_installed; #- there is at least one package installed (whatever its version). - 1; - }; - if ($may_upgrade && $pkg->compare_pkg($p) > 0) { - #- keep in mind the package is requested. - $pkg->set_flag_upgrade; - $requested{$pn} = undef; - } else { - delete $names{$pn}; - } - } - - #- check provides of existing package to see if an obsolete - #- may allow selecting it. - foreach my $property ($p->provides) { - #- only real provides should be taken into account, this means internal obsoletes - #- should be avoided. - unless ($p->obsoletes_overlap($property)) { - if (my $n = property2name($property)) { - foreach my $pkg (@{$obsoletes->{$n} || []}) { - next if $pkg->name eq $pn || $pn ne $n || !$names{$pkg->name}; - if ($pkg->obsoletes_overlap($property)) { - #- the package being examined can be obsoleted. - #- do not set installed and provides flags. - push @obsoleters, $pkg; - return; - } - } + my ($pkg_installed) = @_; + my $name = $pkg_installed->name; + + my $pkg; + if (exists $by_name{$name}) { + if (my $p = $by_name{$name}) { + #- here a pkg with the same name is installed twice + if ($p->compare_pkg($pkg_installed) > 0) { + #- we selected $p, and it is still a valid choice + $pkg = $p; + } else { + #- $p is no good since $pkg_installed is higher version, } } + } elsif ($pkg = _choose_best_pkg($urpm, $pkg_installed, $urpm->packages_by_name($name))) { + #- first try with package using the same name. + $pkg->set_flag_installed; + $pkg->set_flag_upgrade; } - }); - - #- examine all obsoleter packages, compute installer and upgrade flag if needed. - foreach my $pkg (@obsoleters) { - next if !$names{$pkg->name}; - - _set_flag_installed_and_upgrade_if_no_newer($db, $pkg); - - if ($pkg->flag_installed && !$pkg->flag_upgrade) { - delete $names{$pkg->name}; - } else { - $requested{$pkg->name} = undef; + if (my @pkgs = _choose_bests_obsolete($urpm, $db, $pkg_installed, _find_packages_obsoleting($urpm, $state, $pkg_installed))) { + if (@pkgs == 1) { + $pkg and $urpm->{debug_URPM}("auto-select: prefering " . $pkgs[0]->fullname . " obsoleting " . $pkg_installed->fullname . " over " . $pkg->fullname) if $urpm->{debug_URPM}; + $pkg = $pkgs[0]; + } elsif (@pkgs > 1) { + $urpm->{debug_URPM}("auto-select: multiple packages (" . join(' ', map { scalar $_->fullname } @pkgs) . ") obsoleting " . $pkg_installed->fullname) if $urpm->{debug_URPM}; + $pkg = undef; + } } - } - #- examine all packages which may be conflicting. If a package conflicts, it should not be requested. - my @names = map { $_->name . " == " . $_->epoch . ":" . $_->version . "-" . $_->release } values %names; - my @pkgs = values %names; - foreach my $pkg (@pkgs) { - exists $requested{$pkg->name} or next; - foreach my $conflict ($pkg->conflicts) { - delete @names{map { /(\S*)/ && $1 } grep { ranges_overlap($conflict, $_) } @names}; - } - } + $pkg and $urpm->{debug_URPM}("auto-select: adding " . $pkg->fullname . " replacing " . $pkg_installed->fullname) if $urpm->{debug_URPM}; + + $by_name{$name} = $pkg; + }); - #- examine all packages potentially selectable. - foreach my $pkg (values %names) { - exists $requested{$pkg->name} and $requested->{$pkg->id} = $options{requested}; + foreach my $pkg (values %by_name) { + $pkg or next; + $pkg->set_flag_upgrade; + $requested->{$pkg->id} = $options{requested}; } $requested; |