aboutsummaryrefslogtreecommitdiffstats
path: root/URPM/Resolve.pm
diff options
context:
space:
mode:
authorThierry Vignaud <thierry.vignaud@gmail.com>2013-02-15 01:30:34 +0100
committerThierry Vignaud <thierry.vignaud@gmail.com>2013-11-05 16:54:48 +0100
commit92dd30cc83b734128fbdd904ece908799c49b283 (patch)
tree5b334791512880cc03dadb846649c800413bb393 /URPM/Resolve.pm
parent65d0779a978accb7764119cb41faf4485df8bf5d (diff)
downloadperl-URPM-92dd30cc83b734128fbdd904ece908799c49b283.tar
perl-URPM-92dd30cc83b734128fbdd904ece908799c49b283.tar.gz
perl-URPM-92dd30cc83b734128fbdd904ece908799c49b283.tar.bz2
perl-URPM-92dd30cc83b734128fbdd904ece908799c49b283.tar.xz
perl-URPM-92dd30cc83b734128fbdd904ece908799c49b283.zip
enhance POD documentation
Diffstat (limited to 'URPM/Resolve.pm')
-rw-r--r--URPM/Resolve.pm727
1 files changed, 548 insertions, 179 deletions
diff --git a/URPM/Resolve.pm b/URPM/Resolve.pm
index ab07ebe..3a0a375 100644
--- a/URPM/Resolve.pm
+++ b/URPM/Resolve.pm
@@ -10,6 +10,20 @@ use Config;
# perl_checker: require URPM
+
+=head1 NAME
+
+URPM::Resolve - Resolve routines for URPM/urpmi
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=over
+
+=cut
+
+
#- a few functions from MDK::Common copied here:
sub any(&@) {
my $f = shift;
@@ -28,30 +42,78 @@ sub find(&@) {
undef;
}
-#- property2name* functions below parse things like "mageia-release[>= 1]"
-#- which is the format returned by URPM.xs for ->requires, ->provides, ->conflicts...
+=back
+
+=head2 The property functions
+
+The property2name* functions parse things like "mageia-release[>= 1]"
+which is the format returned by URPM.xs for ->requires, ->provides, ->conflicts...
+
+=over 4
+
+=item property2name($property)
+
+Returns the property name (eg: "mageia-release" in above example)
+
+=cut
+
sub property2name {
my ($property) = @_;
$property =~ /^([^\s\[]*)/ && $1;
}
+=item property2name_range($property)
+
+Returns the property name & range (eg: "mageia-release" & ">= 1" in above example)
+
+=cut
+
sub property2name_range {
my ($property) = @_;
$property =~ /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/;
}
+=item property2name_op_version($property)
+
+Returns the property name, operator & range (eg: "mageia-release", ">=", & "1" in above example)
+
+=cut
+
+
sub property2name_op_version {
my ($property) = @_;
$property =~ /^([^\s\[]*)(?:\[\*\])?\s*\[?([^\s\]]*)\s*([^\s\]]*)/;
}
-#- wrappers around $state (cf "The $state object" in "perldoc URPM")
+
+=back
+
+=head2 The state functions
+
+Those are wrappers around $state (cf "The $state object" in L<URPM>).
+
+=over 4
+
+=item packages_to_remove($state)
+
+Returns the ids of the packages to remove
+
+=cut
+
+
sub packages_to_remove {
my ($state) = @_;
grep {
$state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted};
} keys %{$state->{rejected} || {}};
}
+
+=item removed_or_obsoleted_packages($state)
+
+Returns the ids of the packages that are either to remove or are obsoleted
+
+=cut
+
sub removed_or_obsoleted_packages {
my ($state) = @_;
grep {
@@ -59,57 +121,32 @@ sub removed_or_obsoleted_packages {
} keys %{$state->{rejected} || {}};
}
-#- Find candidates packages from a require string (or id).
-#- Takes care of choices using the '|' separator.
-#- (nb: see also find_required_package())
-#-
-#- side-effects: none
-sub find_candidate_packages {
- my ($urpm, $id_prop, $o_rejected) = @_;
- my @packages;
+=back
- foreach (split /\|/, $id_prop) {
- if (/^\d+$/) {
- my $pkg = $urpm->{depslist}[$_];
- $pkg->flag_skip and next;
- $pkg->arch eq 'src' || $pkg->is_arch_compat or next;
- $o_rejected && exists $o_rejected->{$pkg->fullname} and next;
- push @packages, $pkg;
- } elsif (my $name = property2name($_)) {
- my $property = $_;
- foreach (sort keys %{$urpm->{provides}{$name} || {}}) {
- my $pkg = $urpm->{depslist}[$_];
- $pkg->flag_skip and next;
- $pkg->is_arch_compat or next;
- $o_rejected && exists $o_rejected->{$pkg->fullname} and next;
- #- check if at least one provide of the package overlap the property.
- !$urpm->{provides}{$name}{$_} || $pkg->provides_overlap($property)
- and push @packages, $pkg;
- }
- }
- }
- @packages;
-}
+=head2 Strict arch related functions
-#- returns the "arch" of package $n in rpm db
-sub get_installed_arch {
- my ($db, $n) = @_;
- my $arch;
- $db->traverse_tag_find('name', $n, sub { $arch = $_[0]->arch; 1 });
- $arch;
-}
+=over 4
+
+=item strict_arch($urpm)
+
+Is "strict-arch" wanted? (cf "man urpmi")
+Since it's slower we only force it on bi-arch
+
+=cut
-#- is "strict-arch" wanted? (cf "man urpmi")
-#- since it's slower we only force it on bi-arch
sub strict_arch {
my ($urpm) = @_;
defined $urpm->{options}{'strict-arch'} ? $urpm->{options}{'strict-arch'} : $Config{archname} =~ /x86_64|sparc64|ppc64/;
}
my %installed_arch;
-#- checks wether $pkg could be installed under strict-arch policy
-#- (ie check wether $pkg->name with different arch is not installed)
-#-
+=item strict_arch_check_installed($db, $pkg)
+
+Checks whether $pkg could be installed under strict-arch policy
+(ie check whether $pkg->name with different arch is not installed)
+
+=cut
+
#- side-effects: none (but uses a cache)
sub strict_arch_check_installed {
my ($db, $pkg) = @_;
@@ -124,9 +161,13 @@ sub strict_arch_check_installed {
1;
}
-#- check wether $installed_pkg and $pkg have same arch
-#- (except for src/noarch of course)
-#-
+=item strict_arch_check($installed_pkg, $pkg) = @_;
+
+Check whether $installed_pkg and $pkg have same arch
+(except for src/noarch of course)
+
+=cut
+
#- side-effects: none
sub strict_arch_check {
my ($installed_pkg, $pkg) = @_;
@@ -140,8 +181,31 @@ sub strict_arch_check {
1;
}
-#- is $pkg->name installed?
-#-
+=back
+
+=head2 Installed packages related functions
+
+=over 4
+
+=item get_installed_arch($db, $n)
+
+Returns the architecture of package $n in rpm DB
+
+=cut
+
+sub get_installed_arch {
+ my ($db, $n) = @_;
+ my $arch;
+ $db->traverse_tag_find('name', $n, sub { $arch = $_[0]->arch; 1 });
+ $arch;
+}
+
+=item is_package_installed($db, $n)
+
+Is $pkg->name installed?
+
+=cut
+
#- side-effects: none
sub is_package_installed {
my ($db, $pkg) = @_;
@@ -161,8 +225,13 @@ sub _is_selected_or_installed {
$db->traverse_tag('name', [ $name ], undef) > 0;
}
-#- finds $pkg "provides" that matches $provide_name, and returns the version provided
-#- eg: $pkg provides "a = 3", $provide_name is "a > 1", returns "3"
+=item provided_version_that_overlaps($pkg, $provide_name)
+
+Finds $pkg "provides" that matches $provide_name, and returns the version provided.
+eg: $pkg provides "a = 3", $provide_name is "a > 1", returns "3"
+
+=cut
+
sub provided_version_that_overlaps {
my ($pkg, $provide_name) = @_;
@@ -180,10 +249,15 @@ sub provided_version_that_overlaps {
$version;
}
-#- find the package (or packages) to install matching $id_prop
-#- returns (list ref of matches, list ref of preferred matches)
-#- (see also find_candidate_packages())
-#-
+
+=item find_required_package($urpm, $db, $state, $id_prop)
+
+Find the package (or packages) to install matching $id_prop.
+Returns (list ref of matches, list ref of preferred matches)
+(see also find_candidate_packages())
+
+=cut
+
#- side-effects: flag_install, flag_upgrade (and strict_arch_check_installed cache)
sub find_required_package {
my ($urpm, $db, $state, $id_prop) = @_;
@@ -315,7 +389,18 @@ sub _find_required_package__sort {
\@chosen, [ map { $_->[0] } @prefered ];
}
-#- prefer the pkgs corresponding to installed/selected kernels
+=back
+
+=head2 Choosing packages helpers
+
+=over 4
+
+=item _find_required_package__kernel_source($urpm, $db, $choices)
+
+Prefer the pkgs corresponding to installed/selected kernels
+
+=cut
+
sub _find_required_package__kernel_source {
my ($urpm, $db, $choices) = @_;
@@ -340,7 +425,12 @@ sub _find_required_package__kernel_source {
} @$choices;
}
-#- prefer the pkgs corresponding to installed/selected kernels
+=item _find_required_package__kmod($urpm, $db, $choices)
+
+Prefer the pkgs corresponding to installed/selected kernels
+
+=cut
+
sub _find_required_package__kmod {
my ($urpm, $db, $choices) = @_;
@@ -359,12 +449,17 @@ sub _find_required_package__kmod {
} @$choices;
}
-#- Packages that require locales-xxx when the corresponding locales are
-#- already installed should be preferred over packages that require locales
-#- which are not installed.
-#-
-#- eg: locales-fr & locales-de are installed,
-#- prefer firefox-fr & firefox-de which respectively require locales-fr & locales-de
+=item _score_for_locales($urpm, $db, $pkg)
+
+Packages that require locales-xxx when the corresponding locales are
+already installed should be preferred over packages that require locales
+which are not installed.
+
+eg: locales-fr & locales-de are installed,
+ prefer firefox-fr & firefox-de which respectively require locales-fr & locales-de
+
+=cut
+
sub _score_for_locales {
my ($urpm, $db, $pkg) = @_;
@@ -434,6 +529,18 @@ sub _choose_required {
$pkg;
}
+=back
+
+=head2 Misc helpers
+
+=over 4
+
+=item pkg2media($mediums, $pkg)
+
+Return the medium that contains the URPM::Package $pkg
+
+=cut
+
sub pkg2media {
my ($mediums, $p) = @_;
my $id = $p->id;
@@ -441,19 +548,80 @@ sub pkg2media {
find { $id >= ($_->{start} || 0) && $id <= ($_->{end} || 0) } @$mediums;
}
+
+=back
+
+=head2 Dependancy resolver related functions
+
+=over 4
+
+=item find_candidate_packages($urpm, $id_prop, $o_rejected)
+
+Find candidates packages from a require string (or id).
+Takes care of choices using the '|' separator.
+(nb: see also find_required_package())
+
+=cut
+
+#- side-effects: none
+sub find_candidate_packages {
+ my ($urpm, $id_prop, $o_rejected) = @_;
+ my @packages;
+
+ foreach (split /\|/, $id_prop) {
+ if (/^\d+$/) {
+ my $pkg = $urpm->{depslist}[$_];
+ $pkg->flag_skip and next;
+ $pkg->arch eq 'src' || $pkg->is_arch_compat or next;
+ $o_rejected && exists $o_rejected->{$pkg->fullname} and next;
+ push @packages, $pkg;
+ } elsif (my $name = property2name($_)) {
+ my $property = $_;
+ foreach (sort keys %{$urpm->{provides}{$name} || {}}) {
+ my $pkg = $urpm->{depslist}[$_];
+ $pkg->flag_skip and next;
+ $pkg->is_arch_compat or next;
+ $o_rejected && exists $o_rejected->{$pkg->fullname} and next;
+ #- check if at least one provide of the package overlap the property.
+ !$urpm->{provides}{$name}{$_} || $pkg->provides_overlap($property)
+ and push @packages, $pkg;
+ }
+ }
+ }
+ @packages;
+}
+
+
+=item whatrequires($urpm, $state, $property_name)
+
+Return packages requiring $property_name
+
+=cut
+
sub whatrequires {
my ($urpm, $state, $property_name) = @_;
map { $urpm->{depslist}[$_] } whatrequires_id($state, $property_name);
}
+
+=item whatrequires_id($state, $property_name)
+
+Return ids of packages requiring $property_name
+
+=cut
+
sub whatrequires_id {
my ($state, $property_name) = @_;
keys %{$state->{whatrequires}{$property_name} || {}};
}
-#- return unresolved requires of a package (a new one or an existing one).
-#-
+=item unsatisfied_requires($urpm, $db, $state, $pkg, %options)
+
+Return unresolved requires of a package (a new one or an existing one).
+
+=cut
+
#- side-effects: none (but uses a $state->{cached_installed})
sub unsatisfied_requires {
my ($urpm, $db, $state, $pkg, %options) = @_;
@@ -514,9 +682,13 @@ sub unsatisfied_requires {
keys %unsatisfied;
}
-#- this function is "suggests vs requires" safe:
-#- 'whatrequires' will give both requires & suggests, but unsatisfied_requires
-#- will check $p->requires and so filter out suggests
+=item with_db_unsatisfied_requires($urpm, $db, $state, $name, $do)
+
+This function is "suggests vs requires" safe:
+Traversing DB on 'whatrequires' will give both requires & suggests, but ->unsatisfied_requires()
+will check $p->requires and so filter out suggests
+
+=cut
#- side-effects: only those done by $do
sub with_db_unsatisfied_requires {
@@ -531,6 +703,14 @@ sub with_db_unsatisfied_requires {
});
}
+=item with_state_unsatisfied_requires($urpm, $db, $state, $name, $do)
+
+# LOG: do not ignore dropped provide from updated package (mdvbz#40842)
+# (http://svn.mandriva.com/viewvc/soft/rpm/perl-URPM/trunk/URPM/Resolve.pm?r1=242655&r2=242656&)
+# TV: was introduced in order to replace one with_db_unsatisfied_requires() call by with_any_unsatisfied_requires()
+
+=cut
+
#- side-effects: only those done by $do
sub with_state_unsatisfied_requires {
my ($urpm, $db, $state, $name, $do) = @_;
@@ -545,15 +725,25 @@ sub with_state_unsatisfied_requires {
}
}
+
+=item with_any_unsatisfied_requires($urpm, $db, $state, $name, $do)
+
+See above...
+
+=cut
+
sub with_any_unsatisfied_requires {
my ($urpm, $db, $state, $name, $do) = @_;
with_db_unsatisfied_requires($urpm, $db, $state, $name, sub { my ($p, @l) = @_; $do->($p, 0, @l) });
with_state_unsatisfied_requires($urpm, $db, $state, $name, sub { my ($p, @l) = @_; $do->($p, 1, @l) });
}
+=item backtrack_selected($urpm, $db, $state, $dep, $diff_provides, %options)
+
+Used when a require is not available
+
+=cut
-# used when a require is not available
-#
#- side-effects: $state->{backtrack}, $state->{selected}
#- + those of disable_selected_and_unrequested_dependencies ($state->{whatrequires}, flag_requested, flag_required)
#- + those of _set_rejected_from ($state->{rejected})
@@ -751,6 +941,13 @@ sub _set_rejected_old_package {
}
}
+=item set_rejected($urpm, $state, $rdep)
+
+Keep track of what causes closure.
+Set removed and obsoleted level.
+
+=cut
+
#- side-effects: $state->{rejected}
sub set_rejected {
my ($urpm, $state, $rdep) = @_;
@@ -804,6 +1001,12 @@ sub set_rejected_and_compute_diff_provides {
_compute_diff_provides_of_removed_pkg($urpm, $state, $diff_provides_h, $rdep->{rejected_pkg});
}
+=item resolve_rejected($urpm, $db, $state, $pkg, %rdep)
+
+Close rejected (as urpme previously) for package to be removable without error.
+
+=cut
+
#- see resolve_rejected_ below
sub resolve_rejected {
my ($urpm, $db, $state, $pkg, %rdep) = @_;
@@ -863,7 +1066,40 @@ sub resolve_rejected_ {
}
}
-# see resolve_requested__no_suggests below for information about usage
+=item resolve_requested($urpm, $db, $state, $requested, %options)
+
+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 :
+
+=over
+
+=item callback_choices : subroutine to be called to ask the user to choose
+ between several possible packages. Returns an array of URPM::Package
+ objects, or an empty list eventually.
+
+=item keep :
+
+=item nodeps :
+
+=item no_suggests: ignore suggests tags
+
+=back
+
+It actually calls resolve_requested__no_suggests() and resolve_requested_suggests().
+
+=cut
+
sub resolve_requested {
my ($urpm, $db, $state, $requested, %options) = @_;
@@ -875,6 +1111,12 @@ sub resolve_requested {
@selected;
}
+=item resolve_requested_suggests($urpm, $db, $state, $selected, %options)
+
+Select newly suggested package is installed as if (hard) required.
+
+=cut
+
sub resolve_requested_suggests {
my ($urpm, $db, $state, $selected, %options) = @_;
my @todo = @$selected;
@@ -910,21 +1152,13 @@ sub resolve_requested_suggests {
@$selected;
}
-#- 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. Returns an array of URPM::Package
-#- objects, or an empty list eventually.
-#- keep :
-#- nodeps :
-#-
+=item resolve_requested__no_suggests($urpm, $db, $state, $requested, %options)
+
+Like resolve_requested() but doesn't handle suggests
+
+=cut
+
+# see resolve_requested above for information about usage (modulo 'no_suggests' option)
#- side-effects: flag_requested
#- + those of resolve_requested__no_suggests_
sub resolve_requested__no_suggests {
@@ -1352,78 +1586,16 @@ sub _handle_conflict {
}
}
-#- side-effects: none
-sub _dep_to_name {
- my ($urpm, $dep) = @_;
- join('|', map { _id_to_name($urpm, $_) } split('\|', $dep->{required}));
-}
-#- side-effects: none
-sub _id_to_name {
- my ($urpm, $id_prop) = @_;
- if ($id_prop =~ /^\d+/) {
- my $pkg = $urpm->{depslist}[$id_prop];
- $pkg && $pkg->name;
- } else {
- $id_prop;
- }
-}
-#- side-effects: none
-sub _ids_to_names {
- my $urpm = shift;
+=item disable_selected ($urpm, $db, $state, @pkgs_todo)
- map { $urpm->{depslist}[$_]->name } @_;
-}
-#- side-effects: none
-sub _ids_to_fullnames {
- my $urpm = shift;
+Do the opposite of the resolve_requested: unselect a package and
+extend to any package not requested that is no longer needed by any
+other package.
- map { scalar $urpm->{depslist}[$_]->fullname } @_;
-}
+Return the packages that have been deselected.
-#- side-effects: flag_installed, flag_upgrade
-sub _set_flag_installed_and_upgrade_if_no_newer {
- my ($db, $pkg) = @_;
-
- !$pkg->flag_upgrade && !$pkg->flag_installed or return;
-
- my $upgrade = 1;
- $db->traverse_tag('name', [ $pkg->name ], sub {
- my ($p) = @_;
- $pkg->set_flag_installed;
- $upgrade &&= $pkg->compare_pkg($p) > 0;
- });
- $pkg->set_flag_upgrade($upgrade);
-}
-
-#- side-effects:
-#- + those of _set_rejected_old_package ($state->{rejected})
-sub _no_more_recent_installed_and_providing {
- my ($urpm, $db, $state, $pkg, $required) = @_;
+=cut
- my $allow = 1;
- $db->traverse_tag('name', [ $pkg->name ], sub {
- my ($p) = @_;
- #- allow if a less recent package is installed,
- if ($allow && $pkg->compare_pkg($p) <= 0) {
- if ($required =~ /^\d+/ || $p->provides_overlap($required)) {
- $urpm->{debug_URPM}("not selecting " . $pkg->fullname . " since the more recent " . $p->fullname . " is installed") if $urpm->{debug_URPM};
- _set_rejected_old_package($state, $pkg, $p);
- $allow = 0;
- } else {
- $urpm->{debug_URPM}("the more recent " . $p->fullname .
- " is installed, but does not provide $required whereas " .
- $pkg->fullname . " does") if $urpm->{debug_URPM};
- }
- }
- });
- $allow;
-}
-
-#- do the opposite of the resolve_requested:
-#- 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.
-#-
#- side-effects: flag_requested, flag_required, $state->{selected}, $state->{whatrequires}
#- + those of _remove_all_rejected_from ($state->{rejected})
sub disable_selected {
@@ -1472,9 +1644,13 @@ sub disable_selected {
@unselected;
}
-#- determine dependencies that can safely been removed and are not requested
-#- return the packages that have been deselected.
-#-
+=item disable_selected_and_unrequested_dependencies($urpm, $db, $state, @pkgs_todo)
+
+Determine dependencies that can safely been removed and are not requested.
+Return the packages that have been deselected.
+
+=cut
+
#- side-effects:
#- + those of disable_selected (flag_requested, flag_required, $state->{selected}, $state->{whatrequires}, $state->{rejected})
sub disable_selected_and_unrequested_dependencies {
@@ -1521,19 +1697,145 @@ sub disable_selected_and_unrequested_dependencies {
@all_unselected;
}
-#- compute selected size by removing any removed or obsoleted package.
-#-
+=back
+
+=head2 Dependancy related functions
+
+=over 4
+
+=item _dep_to_name($urpm, $dep)
+
+Take a string of package ids (eg: "4897|4564|454") that represent packages providing some dependancy.
+Return string of package names corresponding to package ids.
+eg: "libgtk1-devel|libgtk2-devel|libgtk3-devel" for ids corresponding to "gtk-devel"
+
+$dep is a hashref: { required => $ID, requested => $requested->{$ID} }
+# CHECK IT REALLY IS AN ID HERE => WE SHOULD REALLY DOCUMENT $requested
+
+=cut
+
+#- side-effects: none
+sub _dep_to_name {
+ my ($urpm, $dep) = @_;
+ join('|', map { _id_to_name($urpm, $_) } split('\|', $dep->{required}));
+}
+
+=item _id_to_name($urpm, $id_prop)
+
+Returns package name corresponding to package ID (or ID if not numerical)
+
+=cut
+
+#- side-effects: none
+sub _id_to_name {
+ my ($urpm, $id_prop) = @_;
+ if ($id_prop =~ /^\d+/) {
+ my $pkg = $urpm->{depslist}[$id_prop];
+ $pkg && $pkg->name;
+ } else {
+ $id_prop;
+ }
+}
+
+=item _ids_to_names($urpm, @ids)
+
+Return package names corresponding to package ids
+
+=cut
+
+#- side-effects: none
+sub _ids_to_names {
+ my $urpm = shift;
+
+ map { $urpm->{depslist}[$_]->name } @_;
+}
+
+=item _ids_to_fullnames($urpm, @ids)
+
+Return package fullnames corresponding to package ids.
+identical to _ids_to_names() modulo short name vs full name
+
+=cut
+
+#- side-effects: none
+sub _ids_to_fullnames {
+ my $urpm = shift;
+
+ map { scalar $urpm->{depslist}[$_]->fullname } @_;
+}
+
+#- side-effects: flag_installed, flag_upgrade
+sub _set_flag_installed_and_upgrade_if_no_newer {
+ my ($db, $pkg) = @_;
+
+ !$pkg->flag_upgrade && !$pkg->flag_installed or return;
+
+ my $upgrade = 1;
+ $db->traverse_tag('name', [ $pkg->name ], sub {
+ my ($p) = @_;
+ $pkg->set_flag_installed;
+ $upgrade &&= $pkg->compare_pkg($p) > 0;
+ });
+ $pkg->set_flag_upgrade($upgrade);
+}
+
+#- side-effects:
+#- + those of _set_rejected_old_package ($state->{rejected})
+sub _no_more_recent_installed_and_providing {
+ my ($urpm, $db, $state, $pkg, $required) = @_;
+
+ my $allow = 1;
+ $db->traverse_tag('name', [ $pkg->name ], sub {
+ my ($p) = @_;
+ #- allow if a less recent package is installed,
+ if ($allow && $pkg->compare_pkg($p) <= 0) {
+ if ($required =~ /^\d+/ || $p->provides_overlap($required)) {
+ $urpm->{debug_URPM}("not selecting " . $pkg->fullname . " since the more recent " . $p->fullname . " is installed") if $urpm->{debug_URPM};
+ _set_rejected_old_package($state, $pkg, $p);
+ $allow = 0;
+ } else {
+ $urpm->{debug_URPM}("the more recent " . $p->fullname .
+ " is installed, but does not provide $required whereas " .
+ $pkg->fullname . " does") if $urpm->{debug_URPM};
+ }
+ }
+ });
+ $allow;
+}
+
+=back
+
+=head2 Size related functions
+
+=over 4
+
+=item selected_size($urpm, $state)
+
+Compute selected size by removing any removed or obsoleted package.
+Returns total package size
+
+=cut
+
#- side-effects: none
sub selected_size {
my ($urpm, $state) = @_;
my ($size) = _selected_size_filesize($urpm, $state, 0);
$size;
}
+
+=item selected_size_filesize($urpm, $state)
+
+Compute selected size by removing any removed or obsoleted package.
+Returns both total package size & total filesize.
+
+=cut
+
#- side-effects: none
sub selected_size_filesize {
my ($urpm, $state) = @_;
_selected_size_filesize($urpm, $state, 1);
}
+
#- side-effects: none
sub _selected_size_filesize {
my ($urpm, $state, $compute_filesize) = @_;
@@ -1564,6 +1866,14 @@ sub _selected_size_filesize {
$size, $bad_filesize ? 0 : $filesize;
}
+=back
+
+=head2 Other functions
+
+=over 4
+
+=cut
+
#- compute installed flags for all packages in depslist.
#-
#- side-effects: flag_upgrade, flag_installed
@@ -1601,15 +1911,26 @@ sub compute_flag {
}
}
-#- 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
-#-
+=item compute_flags($urpm, $val, %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 :
+
+=over
+
+=item callback : sub to be called for each package where the flag is set
+
+=item skip : if true, set the 'skip' flag
+
+=item disable_obsolete : if true, set the 'disable_obsolete' flag
+
+=back
+
+=cut
+
#- side-effects:
#- + those of compute_flag (flag_skip, flag_disable_obsolete)
sub compute_flags {
@@ -1674,11 +1995,15 @@ sub _choose_bests_obsolete {
map { _choose_best_pkg_($urpm, $pkg_installed, @$_) } values %by_name;
}
-#- 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)
-#-
+=item request_packages_to_upgrade($urpm, $db, $state, $requested, %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.
+(used for --auto-select)
+
+=cut
+
#- side-effects: $requisted, flag_installed, flag_upgrade
sub request_packages_to_upgrade {
my ($urpm, $db, $state, $requested, %options) = @_;
@@ -1733,6 +2058,14 @@ sub request_packages_to_upgrade {
$requested;
}
+=back
+
+=head2 Graph functions
+
+=over 4
+
+=cut
+
#- side-effects: none
sub _sort_by_dependencies_get_graph {
my ($urpm, $state, $l) = @_;
@@ -1782,8 +2115,14 @@ sub _add_group {
# warn "# groups: ", join(' ', map { join('+', @$_) } uniq(values %$groups)), "\n";
}
-#- nb: this handles $nodes list not containing all $nodes that can be seen in $edges
-#-
+=item sort_graph($nodes, $edges)
+
+Sort the graph
+
+nb: this handles $nodes list not containing all $nodes that can be seen in $edges
+
+=cut
+
#- side-effects: none
sub sort_graph {
my ($nodes, $edges) = @_;
@@ -1842,6 +2181,10 @@ sub sort_graph {
@sorted;
}
+=item check_graph_is_sorted($sorted, $nodes, $edges)
+
+=cut
+
#- side-effects: none
sub check_graph_is_sorted {
my ($sorted, $nodes, $edges) = @_;
@@ -1893,6 +2236,10 @@ sub _sort_by_dependencies__add_obsolete_edges {
}
}
+=item sort_by_dependencies($urpm, $state, @list_unsorted)
+
+=cut
+
#- side-effects: none
sub sort_by_dependencies {
my ($urpm, $state, @list_unsorted) = @_;
@@ -1907,6 +2254,10 @@ sub sort_by_dependencies {
sort_graph(\@list_unsorted, $requires);
}
+=item sorted_rpms_to_string($urpm, @sorted)
+
+=cut
+
sub sorted_rpms_to_string {
my ($urpm, @sorted) = @_;
@@ -1915,9 +2266,13 @@ sub sorted_rpms_to_string {
} @sorted);
}
-#- build transaction set for given selection
-#- options: start, end, idlist, split_length, keep
-#-
+=item build_transaction_set($urpm, $db, $state, %options)
+
+Build transaction set for given selection
+Options: start, end, idlist, split_length, keep
+
+=cut
+
#- side-effects: $state->{transaction}, $state->{transaction_state}
sub build_transaction_set {
my ($urpm, $db, $state, %options) = @_;
@@ -2014,3 +2369,17 @@ sub build_transaction_set {
}
1;
+
+__END__
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002-2005 MandrakeSoft SA
+
+Copyright (C) 2005-2010 Mandriva SA
+
+Copyright (C) 2011-2013 Mageia
+
+=cut