summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xgurpmi213
-rw-r--r--urpm.pm431
-rw-r--r--urpm/select.pm442
-rw-r--r--urpme6
-rwxr-xr-xurpmi17
-rwxr-xr-xurpmq7
6 files changed, 466 insertions, 450 deletions
diff --git a/gurpmi2 b/gurpmi2
index 62a12b17..488753fb 100755
--- a/gurpmi2
+++ b/gurpmi2
@@ -16,6 +16,7 @@ use urpm::install;
use urpm::media;
use urpm::signature;
use urpm::get_pkgs;
+use urpm::select;
use Gtk2;
#- GUI globals
@@ -71,19 +72,19 @@ my $urpm = configure_urpm();
my $state = {};
my %requested = $urpm->register_rpms(@all_rpms);
if (@gurpmi::names) {
- $urpm->search_packages(\%requested, [ @gurpmi::names ]);
+ urpm::select::search_packages($urpm, \%requested, [ @gurpmi::names ]);
}
-$urpm->resolve_dependencies(
+urpm::select::resolve_dependencies($urpm,
$state,
\%requested,
callback_choices => \&ask_choice,
auto_select => $gurpmi::options{'auto-select'},
);
-my @ask_unselect = $urpm->unselected_packages($state);
+my @ask_unselect = urpm::select::unselected_packages($urpm, $state);
@ask_unselect
? ask_continue(N(
"Some requested packages cannot be installed:\n%s\nContinue installation anyway?",
- $urpm->translate_why_unselected($state, @ask_unselect)
+ urpm::select::translate_why_unselected($urpm, $state, @ask_unselect)
), \&do_install)
: do_install();
@@ -186,11 +187,11 @@ sub ask_continue_blocking {
sub do_install {
wait_label();
- my @ask_remove = $urpm->removed_packages($state);
+ my @ask_remove = urpm::select::removed_packages($urpm, $state);
@ask_remove
? ask_continue(N(
"The following packages have to be removed for others to be upgraded:\n%s\nContinue installation anyway?",
- $urpm->translate_why_removed($state, @ask_remove)
+ urpm::select::translate_why_removed($urpm, $state, @ask_remove)
), \&do_install_2)
: goto &do_install_2;
}
diff --git a/urpm.pm b/urpm.pm
index 80895262..d1c1d649 100644
--- a/urpm.pm
+++ b/urpm.pm
@@ -149,226 +149,6 @@ sub register_rpms {
%requested;
}
-sub _findindeps {
- my ($urpm, $found, $qv, $v, $caseinsensitive, $src) = @_;
-
- foreach (keys %{$urpm->{provides}}) {
- #- search through provides to find if a provide matches this one;
- #- but manage choices correctly (as a provides may be virtual or
- #- defined several times).
- /$qv/ || !$caseinsensitive && /$qv/i or next;
-
- my @list = grep { defined $_ } map {
- my $pkg = $urpm->{depslist}[$_];
- $pkg && ($src ? $pkg->arch eq 'src' : $pkg->arch ne 'src')
- ? $pkg->id : undef;
- } keys %{$urpm->{provides}{$_} || {}};
- @list > 0 and push @{$found->{$v}}, join '|', @list;
- }
-}
-
-#- search packages registered by their names by storing their ids into the $packages hash.
-#- Recognized options:
-#- all
-#- caseinsensitive
-#- fuzzy
-#- src
-#- use_provides
-sub search_packages {
- my ($urpm, $packages, $names, %options) = @_;
- my (%exact, %exact_a, %exact_ra, %found, %foundi);
- foreach my $v (@$names) {
- my $qv = quotemeta $v;
- $qv = '(?i)' . $qv if $options{caseinsensitive};
-
- unless ($options{fuzzy}) {
- #- try to search through provides.
- if (my @l = map {
- $_
- && ($options{src} ? $_->arch eq 'src' : $_->is_arch_compat)
- && ($options{use_provides} || $_->name eq $v)
- && defined($_->id)
- && (!defined $urpm->{searchmedia} ||
- $urpm->{searchmedia}{start} <= $_->id
- && $urpm->{searchmedia}{end} >= $_->id)
- ? $_ : @{[]};
- } map {
- $urpm->{depslist}[$_];
- } keys %{$urpm->{provides}{$v} || {}})
- {
- #- we assume that if there is at least one package providing
- #- the resource exactly, this should be the best one; but we
- #- first check if one of the packages has the same name as searched.
- if (my @l2 = grep { $_->name eq $v } @l) {
- @l = @l2;
- }
- $exact{$v} = join('|', map { $_->id } @l);
- next;
- }
- }
-
- if ($options{use_provides} && $options{fuzzy}) {
- _findindeps($urpm, \%found, $qv, $v, $options{caseinsensitive}, $options{src});
- }
-
- foreach my $id (defined $urpm->{searchmedia} ?
- ($urpm->{searchmedia}{start} .. $urpm->{searchmedia}{end}) :
- (0 .. $#{$urpm->{depslist}})
- ) {
- my $pkg = $urpm->{depslist}[$id];
- ($options{src} ? $pkg->arch eq 'src' : $pkg->is_arch_compat) or next;
- my $pack_name = $pkg->name;
- my $pack_ra = $pack_name . '-' . $pkg->version;
- my $pack_a = "$pack_ra-" . $pkg->release;
- my $pack = "$pack_a." . $pkg->arch;
- unless ($options{fuzzy}) {
- if ($pack eq $v) {
- $exact{$v} = $id;
- next;
- } elsif ($pack_a eq $v) {
- push @{$exact_a{$v}}, $id;
- next;
- } elsif ($pack_ra eq $v || $options{src} && $pack_name eq $v) {
- push @{$exact_ra{$v}}, $id;
- next;
- }
- }
- $pack =~ /$qv/ and push @{$found{$v}}, $id;
- $pack =~ /$qv/i and push @{$foundi{$v}}, $id unless $options{caseinsensitive};
- }
- }
-
- my $result = 1;
- foreach (@$names) {
- if (defined $exact{$_}) {
- $packages->{$exact{$_}} = 1;
- foreach (split /\|/, $exact{$_}) {
- my $pkg = $urpm->{depslist}[$_] or next;
- $pkg->set_flag_skip(0); #- reset skip flag as manually selected.
- }
- } else {
- #- at this level, we need to search the best package given for a given name,
- #- always prefer already found package.
- my %l;
- foreach (@{$exact_a{$_} || $exact_ra{$_} || $found{$_} || $foundi{$_} || []}) {
- my $pkg = $urpm->{depslist}[$_];
- push @{$l{$pkg->name}}, $pkg;
- }
- if (values(%l) == 0 || values(%l) > 1 && !$options{all}) {
- $urpm->{error}(N("No package named %s", $_));
- values(%l) != 0 and $urpm->{error}(
- N("The following packages contain %s: %s",
- $_, "\n" . join("\n", sort { $a cmp $b } keys %l))
- );
- $result = 0;
- } else {
- if (!@{$exact_a{$_} || $exact_ra{$_} || []}) {
- #- we found a non-exact match
- $result = 'substring';
- }
- foreach (values %l) {
- my $best;
- foreach (@$_) {
- if ($best && $best != $_) {
- $_->compare_pkg($best) > 0 and $best = $_;
- } else {
- $best = $_;
- }
- }
- $packages->{$best->id} = 1;
- $best->set_flag_skip(0); #- reset skip flag as manually selected.
- }
- }
- }
- }
-
- #- return true if no error has been encountered, else false.
- $result;
-}
-
-#- Resolves dependencies between requested packages (and auto selection if any).
-#- handles parallel option if any.
-#- The return value is true if program should be restarted (in order to take
-#- care of important packages being upgraded (priority upgrades)
-#- %options :
-#- rpmdb
-#- auto_select
-#- install_src
-#- priority_upgrade
-#- %options passed to ->resolve_requested:
-#- callback_choices
-#- keep
-#- nodeps
-sub resolve_dependencies {
- #- $state->{selected} will contain the selection of packages to be
- #- installed or upgraded
- my ($urpm, $state, $requested, %options) = @_;
- my $need_restart;
-
- if ($options{install_src}) {
- #- only src will be installed, so only update $state->{selected} according
- #- to src status of files.
- foreach (keys %$requested) {
- my $pkg = $urpm->{depslist}[$_] or next;
- $pkg->arch eq 'src' or next;
- $state->{selected}{$_} = undef;
- }
- }
- if ($urpm->{parallel_handler}) {
- urpm::parallel::resolve_dependencies($urpm, $state, $requested, %options);
- } else {
- my $db;
-
- if ($options{rpmdb}) {
- $db = new URPM;
- $db->parse_synthesis($options{rpmdb});
- } else {
- $db = db_open_or_die($urpm, $urpm->{root});
- }
-
- my $sig_handler = sub { undef $db; exit 3 };
- local $SIG{INT} = $sig_handler;
- local $SIG{QUIT} = $sig_handler;
-
- #- auto select package for upgrading the distribution.
- if ($options{auto_select}) {
- $urpm->request_packages_to_upgrade($db, $state, $requested, requested => undef,
- start => $urpm->{searchmedia}{start}, end => $urpm->{searchmedia}{end});
- }
-
- #- resolve dependencies which will be examined for packages that need to
- #- have urpmi restarted when they're updated.
- $urpm->resolve_requested($db, $state, $requested, %options);
-
- if ($options{priority_upgrade} && !$options{rpmdb}) {
- my (%priority_upgrade, %priority_requested);
- @priority_upgrade{split /,/, $options{priority_upgrade}} = ();
-
- #- check if a priority upgrade should be tried
- foreach (keys %{$state->{selected}}) {
- my $pkg = $urpm->{depslist}[$_] or next;
- exists $priority_upgrade{$pkg->name} or next;
- $priority_requested{$pkg->id} = undef;
- }
-
- if (%priority_requested) {
- my %priority_state;
-
- $urpm->resolve_requested($db, \%priority_state, \%priority_requested, %options);
- if (grep { ! exists $priority_state{selected}{$_} } keys %priority_requested) {
- #- some packages which were selected previously have not been selected, strange!
- $need_restart = 0;
- } elsif (grep { ! exists $priority_state{selected}{$_} } keys %{$state->{selected}}) {
- #- there are other packages to install after this priority transaction.
- %$state = %priority_state;
- $need_restart = 1;
- }
- }
- }
- }
- $need_restart;
-}
-
#- checks whether the delta RPM represented by $pkg is installable wrt the
#- RPM DB on $root. For this, it extracts the rpm version to which the
#- delta applies from the delta rpm filename itself. So naming conventions
@@ -429,220 +209,9 @@ sub extract_packages_to_install {
#- deprecated
sub install { require urpm::install; &urpm::install::install }
-#- find packages to remove.
-#- options:
-#- bundle
-#- callback_base
-#- callback_fuzzy
-#- callback_notfound
-#- force
-#- matches
-#- root
-#- test
-sub find_packages_to_remove {
- my ($urpm, $state, $l, %options) = @_;
-
- if ($urpm->{parallel_handler}) {
- #- invoke parallel finder.
- $urpm->{parallel_handler}->parallel_find_remove($urpm, $state, $l, %options, find_packages_to_remove => 1);
- } else {
- my $db = db_open_or_die($urpm, $options{root});
- my (@m, @notfound);
-
- if (!$options{matches}) {
- foreach (@$l) {
- my ($n, $found);
-
- #- check if name-version-release-architecture was given.
- if (($n) = /^(.*)-[^\-]*-[^\-]*\.[^\.\-]*$/) {
- $db->traverse_tag('name', [ $n ], sub {
- my ($p) = @_;
- $p->fullname eq $_ or return;
- $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
- push @m, scalar $p->fullname;
- $found = 1;
- });
- $found and next;
- }
-
- #- check if name-version-release was given.
- if (($n) = /^(.*)-[^\-]*-[^\-]*$/) {
- $db->traverse_tag('name', [ $n ], sub {
- my ($p) = @_;
- my ($name, $version, $release) = $p->fullname;
- "$name-$version-$release" eq $_ or return;
- $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
- push @m, scalar $p->fullname;
- $found = 1;
- });
- $found and next;
- }
-
- #- check if name-version was given.
- if (($n) = /^(.*)-[^\-]*$/) {
- $db->traverse_tag('name', [ $n ], sub {
- my ($p) = @_;
- my ($name, $version) = $p->fullname;
- "$name-$version" eq $_ or return;
- $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
- push @m, scalar $p->fullname;
- $found = 1;
- });
- $found and next;
- }
-
- #- check if only name was given.
- $db->traverse_tag('name', [ $_ ], sub {
- my ($p) = @_;
- $p->name eq $_ or return;
- $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
- push @m, scalar $p->fullname;
- $found = 1;
- });
- $found and next;
-
- push @notfound, $_;
- }
- if (!$options{force} && @notfound && @$l > 1) {
- $options{callback_notfound} && $options{callback_notfound}->($urpm, @notfound)
- or return ();
- }
- }
- if ($options{matches} || @notfound) {
- my $match = join "|", map { quotemeta } @$l;
- my $qmatch = qr/$match/;
-
- #- reset what has been already found.
- %$state = ();
- @m = ();
-
- #- search for packages that match, and perform closure again.
- $db->traverse(sub {
- my ($p) = @_;
- my $f = scalar $p->fullname;
- $f =~ $qmatch or return;
- $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
- push @m, $f;
- });
-
- if (!$options{force} && @notfound) {
- if (@m) {
- $options{callback_fuzzy} && $options{callback_fuzzy}->($urpm, @$l > 1 ? $match : $l->[0], @m)
- or return ();
- } else {
- $options{callback_notfound} && $options{callback_notfound}->($urpm, @notfound)
- or return ();
- }
- }
- }
-
- #- check if something needs to be removed.
- find_removed_from_basesystem($urpm, $db, $state, $options{callback_base})
- or return ();
- }
- grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} } keys %{$state->{rejected}};
-}
-
-sub find_removed_from_basesystem {
- my ($urpm, $db, $state, $callback_base) = @_;
- if ($callback_base && %{$state->{rejected} || {}}) {
- my %basepackages;
- my @dont_remove = ('basesystem', split /,\s*/, $urpm->{global_config}{'prohibit-remove'});
- #- check if a package to be removed is a part of basesystem requires.
- $db->traverse_tag('whatprovides', \@dont_remove, sub {
- my ($p) = @_;
- $basepackages{$p->fullname} = 0;
- });
- foreach (grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} } keys %{$state->{rejected}}) {
- exists $basepackages{$_} or next;
- ++$basepackages{$_};
- }
- if (grep { $_ } values %basepackages) {
- return $callback_base->($urpm, grep { $basepackages{$_} } keys %basepackages);
- }
- }
- return 1;
-}
-
#- deprecated
sub parallel_remove { &urpm::parallel::remove }
-#- misc functions to help finding ask_unselect and ask_remove elements with their reasons translated.
-sub unselected_packages {
- my (undef, $state) = @_;
- grep { $state->{rejected}{$_}{backtrack} } keys %{$state->{rejected} || {}};
-}
-
-sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
-
-sub translate_why_unselected {
- my ($urpm, $state, @fullnames) = @_;
-
- join("\n", map { translate_why_unselected_one($urpm, $state, $_) } sort @fullnames);
-}
-
-sub translate_why_unselected_one {
- my ($urpm, $state, $fullname) = @_;
-
- my $rb = $state->{rejected}{$fullname}{backtrack};
- my @froms = keys %{$rb->{closure} || {}};
- my @unsatisfied = @{$rb->{unsatisfied} || []};
- my $s = join ", ", (
- (map { N("due to missing %s", $_) } @froms),
- (map { N("due to unsatisfied %s", $_) } uniq(map {
- #- XXX in theory we shouldn't need this, dependencies (and not ids) should
- #- already be present in @unsatisfied. But with biarch packages this is
- #- not always the case.
- /\D/ ? $_ : scalar($urpm->{depslist}[$_]->fullname);
- } @unsatisfied)),
- $rb->{promote} && !$rb->{keep} ? N("trying to promote %s", join(", ", @{$rb->{promote}})) : (),
- $rb->{keep} ? N("in order to keep %s", join(", ", @{$rb->{keep}})) : (),
- );
- $fullname . ($s ? " ($s)" : '');
-}
-
-sub removed_packages {
- my (undef, $state) = @_;
- grep {
- $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted};
- } keys %{$state->{rejected} || {}};
-}
-
-sub translate_why_removed {
- my ($urpm, $state, @fullnames) = @_;
- join("\n", map { translate_why_removed_one($urpm, $state, $_) } sort @fullnames);
-}
-sub translate_why_removed_one {
- my ($urpm, $state, $fullname) = @_;
-
- my $closure = $state->{rejected}{$fullname}{closure};
- my ($from) = keys %$closure;
- my ($whyk) = keys %{$closure->{$from}};
- my $whyv = $closure->{$from}{$whyk};
- my $frompkg = $urpm->search($from, strict_fullname => 1);
- my $s = do {
- if ($whyk =~ /old_requested/) {
- N("in order to install %s", $frompkg ? scalar $frompkg->fullname : $from);
- } elsif ($whyk =~ /unsatisfied/) {
- join(",\n ", map {
- if (/([^\[\s]*)(?:\[\*\])?(?:\[|\s+)([^\]]*)\]?$/ && $2 ne '*') {
- N("due to unsatisfied %s", "$1 $2");
- } else {
- N("due to missing %s", $_);
- }
- } @$whyv);
- } elsif ($whyk =~ /conflicts/) {
- N("due to conflicts with %s", $whyv);
- } elsif ($whyk =~ /unrequested/) {
- N("unrequested");
- } else {
- undef;
- }
- };
- #- now insert the reason if available.
- $fullname . ($s ? "\n ($s)" : '');
-}
-
#- get reason of update for packages to be updated
#- use all update medias if none given
sub get_updates_description {
diff --git a/urpm/select.pm b/urpm/select.pm
new file mode 100644
index 00000000..3abf6507
--- /dev/null
+++ b/urpm/select.pm
@@ -0,0 +1,442 @@
+package urpm::select;
+
+# $Id$
+
+use urpm::msg;
+use urpm::util;
+use URPM;
+
+sub _findindeps {
+ my ($urpm, $found, $qv, $v, $caseinsensitive, $src) = @_;
+
+ foreach (keys %{$urpm->{provides}}) {
+ #- search through provides to find if a provide matches this one;
+ #- but manage choices correctly (as a provides may be virtual or
+ #- defined several times).
+ /$qv/ || !$caseinsensitive && /$qv/i or next;
+
+ my @list = grep { defined $_ } map {
+ my $pkg = $urpm->{depslist}[$_];
+ $pkg && ($src ? $pkg->arch eq 'src' : $pkg->arch ne 'src')
+ ? $pkg->id : undef;
+ } keys %{$urpm->{provides}{$_} || {}};
+ @list > 0 and push @{$found->{$v}}, join '|', @list;
+ }
+}
+
+#- search packages registered by their names by storing their ids into the $packages hash.
+#- Recognized options:
+#- all
+#- caseinsensitive
+#- fuzzy
+#- src
+#- use_provides
+sub search_packages {
+ my ($urpm, $packages, $names, %options) = @_;
+ my (%exact, %exact_a, %exact_ra, %found, %foundi);
+ foreach my $v (@$names) {
+ my $qv = quotemeta $v;
+ $qv = '(?i)' . $qv if $options{caseinsensitive};
+
+ unless ($options{fuzzy}) {
+ #- try to search through provides.
+ if (my @l = map {
+ $_
+ && ($options{src} ? $_->arch eq 'src' : $_->is_arch_compat)
+ && ($options{use_provides} || $_->name eq $v)
+ && defined($_->id)
+ && (!defined $urpm->{searchmedia} ||
+ $urpm->{searchmedia}{start} <= $_->id
+ && $urpm->{searchmedia}{end} >= $_->id)
+ ? $_ : @{[]};
+ } map {
+ $urpm->{depslist}[$_];
+ } keys %{$urpm->{provides}{$v} || {}})
+ {
+ #- we assume that if there is at least one package providing
+ #- the resource exactly, this should be the best one; but we
+ #- first check if one of the packages has the same name as searched.
+ if (my @l2 = grep { $_->name eq $v } @l) {
+ @l = @l2;
+ }
+ $exact{$v} = join('|', map { $_->id } @l);
+ next;
+ }
+ }
+
+ if ($options{use_provides} && $options{fuzzy}) {
+ _findindeps($urpm, \%found, $qv, $v, $options{caseinsensitive}, $options{src});
+ }
+
+ foreach my $id (defined $urpm->{searchmedia} ?
+ ($urpm->{searchmedia}{start} .. $urpm->{searchmedia}{end}) :
+ (0 .. $#{$urpm->{depslist}})
+ ) {
+ my $pkg = $urpm->{depslist}[$id];
+ ($options{src} ? $pkg->arch eq 'src' : $pkg->is_arch_compat) or next;
+ my $pack_name = $pkg->name;
+ my $pack_ra = $pack_name . '-' . $pkg->version;
+ my $pack_a = "$pack_ra-" . $pkg->release;
+ my $pack = "$pack_a." . $pkg->arch;
+ unless ($options{fuzzy}) {
+ if ($pack eq $v) {
+ $exact{$v} = $id;
+ next;
+ } elsif ($pack_a eq $v) {
+ push @{$exact_a{$v}}, $id;
+ next;
+ } elsif ($pack_ra eq $v || $options{src} && $pack_name eq $v) {
+ push @{$exact_ra{$v}}, $id;
+ next;
+ }
+ }
+ $pack =~ /$qv/ and push @{$found{$v}}, $id;
+ $pack =~ /$qv/i and push @{$foundi{$v}}, $id unless $options{caseinsensitive};
+ }
+ }
+
+ my $result = 1;
+ foreach (@$names) {
+ if (defined $exact{$_}) {
+ $packages->{$exact{$_}} = 1;
+ foreach (split /\|/, $exact{$_}) {
+ my $pkg = $urpm->{depslist}[$_] or next;
+ $pkg->set_flag_skip(0); #- reset skip flag as manually selected.
+ }
+ } else {
+ #- at this level, we need to search the best package given for a given name,
+ #- always prefer already found package.
+ my %l;
+ foreach (@{$exact_a{$_} || $exact_ra{$_} || $found{$_} || $foundi{$_} || []}) {
+ my $pkg = $urpm->{depslist}[$_];
+ push @{$l{$pkg->name}}, $pkg;
+ }
+ if (values(%l) == 0 || values(%l) > 1 && !$options{all}) {
+ $urpm->{error}(N("No package named %s", $_));
+ values(%l) != 0 and $urpm->{error}(
+ N("The following packages contain %s: %s",
+ $_, "\n" . join("\n", sort { $a cmp $b } keys %l))
+ );
+ $result = 0;
+ } else {
+ if (!@{$exact_a{$_} || $exact_ra{$_} || []}) {
+ #- we found a non-exact match
+ $result = 'substring';
+ }
+ foreach (values %l) {
+ my $best;
+ foreach (@$_) {
+ if ($best && $best != $_) {
+ $_->compare_pkg($best) > 0 and $best = $_;
+ } else {
+ $best = $_;
+ }
+ }
+ $packages->{$best->id} = 1;
+ $best->set_flag_skip(0); #- reset skip flag as manually selected.
+ }
+ }
+ }
+ }
+
+ #- return true if no error has been encountered, else false.
+ $result;
+}
+
+#- Resolves dependencies between requested packages (and auto selection if any).
+#- handles parallel option if any.
+#- The return value is true if program should be restarted (in order to take
+#- care of important packages being upgraded (priority upgrades)
+#- %options :
+#- rpmdb
+#- auto_select
+#- install_src
+#- priority_upgrade
+#- %options passed to ->resolve_requested:
+#- callback_choices
+#- keep
+#- nodeps
+sub resolve_dependencies {
+ #- $state->{selected} will contain the selection of packages to be
+ #- installed or upgraded
+ my ($urpm, $state, $requested, %options) = @_;
+ my $need_restart;
+
+ if ($options{install_src}) {
+ #- only src will be installed, so only update $state->{selected} according
+ #- to src status of files.
+ foreach (keys %$requested) {
+ my $pkg = $urpm->{depslist}[$_] or next;
+ $pkg->arch eq 'src' or next;
+ $state->{selected}{$_} = undef;
+ }
+ }
+ if ($urpm->{parallel_handler}) {
+ require urpm::parallel; #- help perl_checker;
+ urpm::parallel::resolve_dependencies($urpm, $state, $requested, %options);
+ } else {
+ my $db;
+
+ if ($options{rpmdb}) {
+ $db = new URPM;
+ $db->parse_synthesis($options{rpmdb});
+ } else {
+ $db = urpm::db_open_or_die($urpm, $urpm->{root});
+ }
+
+ my $sig_handler = sub { undef $db; exit 3 };
+ local $SIG{INT} = $sig_handler;
+ local $SIG{QUIT} = $sig_handler;
+
+ #- auto select package for upgrading the distribution.
+ if ($options{auto_select}) {
+ $urpm->request_packages_to_upgrade($db, $state, $requested, requested => undef,
+ start => $urpm->{searchmedia}{start}, end => $urpm->{searchmedia}{end});
+ }
+
+ #- resolve dependencies which will be examined for packages that need to
+ #- have urpmi restarted when they're updated.
+ $urpm->resolve_requested($db, $state, $requested, %options);
+
+ if ($options{priority_upgrade} && !$options{rpmdb}) {
+ my (%priority_upgrade, %priority_requested);
+ @priority_upgrade{split /,/, $options{priority_upgrade}} = ();
+
+ #- check if a priority upgrade should be tried
+ foreach (keys %{$state->{selected}}) {
+ my $pkg = $urpm->{depslist}[$_] or next;
+ exists $priority_upgrade{$pkg->name} or next;
+ $priority_requested{$pkg->id} = undef;
+ }
+
+ if (%priority_requested) {
+ my %priority_state;
+
+ $urpm->resolve_requested($db, \%priority_state, \%priority_requested, %options);
+ if (grep { ! exists $priority_state{selected}{$_} } keys %priority_requested) {
+ #- some packages which were selected previously have not been selected, strange!
+ $need_restart = 0;
+ } elsif (grep { ! exists $priority_state{selected}{$_} } keys %{$state->{selected}}) {
+ #- there are other packages to install after this priority transaction.
+ %$state = %priority_state;
+ $need_restart = 1;
+ }
+ }
+ }
+ }
+ $need_restart;
+}
+
+#- find packages to remove.
+#- options:
+#- bundle
+#- callback_base
+#- callback_fuzzy
+#- callback_notfound
+#- force
+#- matches
+#- root
+#- test
+sub find_packages_to_remove {
+ my ($urpm, $state, $l, %options) = @_;
+
+ if ($urpm->{parallel_handler}) {
+ #- invoke parallel finder.
+ $urpm->{parallel_handler}->parallel_find_remove($urpm, $state, $l, %options, find_packages_to_remove => 1);
+ } else {
+ my $db = urpm::db_open_or_die($urpm, $options{root});
+ my (@m, @notfound);
+
+ if (!$options{matches}) {
+ foreach (@$l) {
+ my ($n, $found);
+
+ #- check if name-version-release-architecture was given.
+ if (($n) = /^(.*)-[^\-]*-[^\-]*\.[^\.\-]*$/) {
+ $db->traverse_tag('name', [ $n ], sub {
+ my ($p) = @_;
+ $p->fullname eq $_ or return;
+ $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
+ push @m, scalar $p->fullname;
+ $found = 1;
+ });
+ $found and next;
+ }
+
+ #- check if name-version-release was given.
+ if (($n) = /^(.*)-[^\-]*-[^\-]*$/) {
+ $db->traverse_tag('name', [ $n ], sub {
+ my ($p) = @_;
+ my ($name, $version, $release) = $p->fullname;
+ "$name-$version-$release" eq $_ or return;
+ $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
+ push @m, scalar $p->fullname;
+ $found = 1;
+ });
+ $found and next;
+ }
+
+ #- check if name-version was given.
+ if (($n) = /^(.*)-[^\-]*$/) {
+ $db->traverse_tag('name', [ $n ], sub {
+ my ($p) = @_;
+ my ($name, $version) = $p->fullname;
+ "$name-$version" eq $_ or return;
+ $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
+ push @m, scalar $p->fullname;
+ $found = 1;
+ });
+ $found and next;
+ }
+
+ #- check if only name was given.
+ $db->traverse_tag('name', [ $_ ], sub {
+ my ($p) = @_;
+ $p->name eq $_ or return;
+ $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
+ push @m, scalar $p->fullname;
+ $found = 1;
+ });
+ $found and next;
+
+ push @notfound, $_;
+ }
+ if (!$options{force} && @notfound && @$l > 1) {
+ $options{callback_notfound} && $options{callback_notfound}->($urpm, @notfound)
+ or return ();
+ }
+ }
+ if ($options{matches} || @notfound) {
+ my $match = join "|", map { quotemeta } @$l;
+ my $qmatch = qr/$match/;
+
+ #- reset what has been already found.
+ %$state = ();
+ @m = ();
+
+ #- search for packages that match, and perform closure again.
+ $db->traverse(sub {
+ my ($p) = @_;
+ my $f = scalar $p->fullname;
+ $f =~ $qmatch or return;
+ $urpm->resolve_rejected($db, $state, $p, removed => 1, bundle => $options{bundle});
+ push @m, $f;
+ });
+
+ if (!$options{force} && @notfound) {
+ if (@m) {
+ $options{callback_fuzzy} && $options{callback_fuzzy}->($urpm, @$l > 1 ? $match : $l->[0], @m)
+ or return ();
+ } else {
+ $options{callback_notfound} && $options{callback_notfound}->($urpm, @notfound)
+ or return ();
+ }
+ }
+ }
+
+ #- check if something needs to be removed.
+ find_removed_from_basesystem($urpm, $db, $state, $options{callback_base})
+ or return ();
+ }
+ grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} } keys %{$state->{rejected}};
+}
+
+sub find_removed_from_basesystem {
+ my ($urpm, $db, $state, $callback_base) = @_;
+ if ($callback_base && %{$state->{rejected} || {}}) {
+ my %basepackages;
+ my @dont_remove = ('basesystem', split /,\s*/, $urpm->{global_config}{'prohibit-remove'});
+ #- check if a package to be removed is a part of basesystem requires.
+ $db->traverse_tag('whatprovides', \@dont_remove, sub {
+ my ($p) = @_;
+ $basepackages{$p->fullname} = 0;
+ });
+ foreach (grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} } keys %{$state->{rejected}}) {
+ exists $basepackages{$_} or next;
+ ++$basepackages{$_};
+ }
+ if (grep { $_ } values %basepackages) {
+ return $callback_base->($urpm, grep { $basepackages{$_} } keys %basepackages);
+ }
+ }
+ return 1;
+}
+
+#- misc functions to help finding ask_unselect and ask_remove elements with their reasons translated.
+sub unselected_packages {
+ my (undef, $state) = @_;
+ grep { $state->{rejected}{$_}{backtrack} } keys %{$state->{rejected} || {}};
+}
+
+sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
+
+sub translate_why_unselected {
+ my ($urpm, $state, @fullnames) = @_;
+
+ join("\n", map { translate_why_unselected_one($urpm, $state, $_) } sort @fullnames);
+}
+
+sub translate_why_unselected_one {
+ my ($urpm, $state, $fullname) = @_;
+
+ my $rb = $state->{rejected}{$fullname}{backtrack};
+ my @froms = keys %{$rb->{closure} || {}};
+ my @unsatisfied = @{$rb->{unsatisfied} || []};
+ my $s = join ", ", (
+ (map { N("due to missing %s", $_) } @froms),
+ (map { N("due to unsatisfied %s", $_) } uniq(map {
+ #- XXX in theory we shouldn't need this, dependencies (and not ids) should
+ #- already be present in @unsatisfied. But with biarch packages this is
+ #- not always the case.
+ /\D/ ? $_ : scalar($urpm->{depslist}[$_]->fullname);
+ } @unsatisfied)),
+ $rb->{promote} && !$rb->{keep} ? N("trying to promote %s", join(", ", @{$rb->{promote}})) : (),
+ $rb->{keep} ? N("in order to keep %s", join(", ", @{$rb->{keep}})) : (),
+ );
+ $fullname . ($s ? " ($s)" : '');
+}
+
+sub removed_packages {
+ my (undef, $state) = @_;
+ grep {
+ $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted};
+ } keys %{$state->{rejected} || {}};
+}
+
+sub translate_why_removed {
+ my ($urpm, $state, @fullnames) = @_;
+ join("\n", map { translate_why_removed_one($urpm, $state, $_) } sort @fullnames);
+}
+sub translate_why_removed_one {
+ my ($urpm, $state, $fullname) = @_;
+
+ my $closure = $state->{rejected}{$fullname}{closure};
+ my ($from) = keys %$closure;
+ my ($whyk) = keys %{$closure->{$from}};
+ my $whyv = $closure->{$from}{$whyk};
+ my $frompkg = $urpm->search($from, strict_fullname => 1);
+ my $s = do {
+ if ($whyk =~ /old_requested/) {
+ N("in order to install %s", $frompkg ? scalar $frompkg->fullname : $from);
+ } elsif ($whyk =~ /unsatisfied/) {
+ join(",\n ", map {
+ if (/([^\[\s]*)(?:\[\*\])?(?:\[|\s+)([^\]]*)\]?$/ && $2 ne '*') {
+ N("due to unsatisfied %s", "$1 $2");
+ } else {
+ N("due to missing %s", $_);
+ }
+ } @$whyv);
+ } elsif ($whyk =~ /conflicts/) {
+ N("due to conflicts with %s", $whyv);
+ } elsif ($whyk =~ /unrequested/) {
+ N("unrequested");
+ } else {
+ undef;
+ }
+ };
+ #- now insert the reason if available.
+ $fullname . ($s ? "\n ($s)" : '');
+}
+
+
+1;
diff --git a/urpme b/urpme
index 9658f2a4..6938a543 100644
--- a/urpme
+++ b/urpme
@@ -25,6 +25,8 @@ use urpm::args;
use urpm::msg;
use urpm::install;
use urpm::media;
+use urpm::select;
+
$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin";
delete @ENV{qw(ENV BASH_ENV IFS CDPATH)};
@@ -88,7 +90,7 @@ urpm::media::configure($urpm,
);
#- examine packages...
-my @toremove = $urpm->find_packages_to_remove(
+my @toremove = urpm::select::find_packages_to_remove($urpm,
$state,
\@l,
matches => $matches,
@@ -114,7 +116,7 @@ my @toremove = $urpm->find_packages_to_remove(
root => $root,
) or $urpm->{fatal}(0, N("Nothing to remove"));
-my $list = $urpm->translate_why_removed($state, @toremove);
+my $list = urpm::select::translate_why_removed($urpm, $state, @toremove);
if ($test && $auto) {
#- Warning : the following message is parsed in urpm::parallel_*
my $msg = N("Checking to remove the following packages");
diff --git a/urpmi b/urpmi
index ea749a52..40916d4e 100755
--- a/urpmi
+++ b/urpmi
@@ -25,6 +25,7 @@ use urpm::args;
use urpm::msg;
use urpm::install;
use urpm::media;
+use urpm::select;
use urpm::get_pkgs;
use urpm::signature;
use urpm::util qw(untaint difference2 member);
@@ -403,7 +404,7 @@ if ($bug) {
#- search the packages according to the selection given by the user.
my $search_result;
if (@names) {
- $search_result = $urpm->search_packages(
+ $search_result = urpm::select::search_packages($urpm,
\%requested, [ @names ],
all => $all,
use_provides => $use_provides,
@@ -415,7 +416,7 @@ if (@names) {
}
}
if (@src_names) {
- $search_result = $urpm->search_packages(\%requested, [ @src_names ],
+ $search_result = urpm::select::search_packages($urpm, \%requested, [ @src_names ],
all => $all,
use_provides => $use_provides,
fuzzy => $urpm->{options}{fuzzy},
@@ -452,7 +453,7 @@ sub ask_choice {
#- handle parallel option if any.
#- return value is true if program should be restarted (in order to take care of important
#- packages being upgraded (problably urpmi and perl-URPM, but maybe rpm too, and glibc also ?).
-my $restart_itself = $urpm->resolve_dependencies(
+my $restart_itself = urpm::select::resolve_dependencies($urpm,
$state,
\%requested,
rpmdb => $env && "$env/rpmdb.cz",
@@ -483,9 +484,9 @@ that are older than the installed ones:\n%s", $list);
}
}
-my @ask_unselect = $urpm->unselected_packages($state);
+my @ask_unselect = urpm::select::unselected_packages($urpm, $state);
if (@ask_unselect) {
- my $list = $urpm->translate_why_unselected($state, @ask_unselect);
+ my $list = urpm::select::translate_why_unselected($urpm, $state, @ask_unselect);
my $msg = N("Some requested packages cannot be installed:\n%s", $list);
if ($urpm->{options}{auto}) {
print "$msg\n";
@@ -501,11 +502,11 @@ if (@ask_unselect) {
}
}
-my @ask_remove = $urpm->{options}{'allow-force'} ? @{[]} : $urpm->removed_packages($state);
+my @ask_remove = $urpm->{options}{'allow-force'} ? @{[]} : urpm::select::removed_packages($urpm, $state);
if (@ask_remove) {
{
my $db = urpm::db_open_or_die($urpm, $root);
- $urpm->find_removed_from_basesystem($db, $state, sub {
+ urpm::select::find_removed_from_basesystem($urpm, $db, $state, sub {
my $urpm = shift @_;
foreach (@_) {
$urpm->{error}(N("removing package %s will break your system", $_));
@@ -513,7 +514,7 @@ if (@ask_remove) {
@_ and $no_remove = 1;
});
}
- my $list = $urpm->translate_why_removed($state, @ask_remove);
+ my $list = urpm::select::translate_why_removed($urpm, $state, @ask_remove);
if ($no_remove && !$force) {
print N("The installation cannot continue because the following packages
diff --git a/urpmq b/urpmq
index 0924d9ab..a5dee31d 100755
--- a/urpmq
+++ b/urpmq
@@ -28,6 +28,7 @@ use urpm::args;
use urpm::msg;
use urpm::sys;
use urpm::media;
+use urpm::select;
use urpm::get_pkgs;
#- default options.
@@ -197,7 +198,7 @@ if ($urpm::args::options{list_aliases}) {
#- search the packages according to the selection given by the user.
if (@names) {
- $urpm->search_packages(
+ urpm::select::search_packages($urpm,
\%requested,
[ @names ],
use_provides => $urpm::args::options{use_provides},
@@ -208,7 +209,7 @@ if ($urpm::args::options{list_aliases}) {
or exit 1;
}
if (@src_names) {
- $urpm->search_packages(
+ urpm::select::search_packages($urpm,
\%requested,
[ @src_names ],
use_provides => $urpm::args::options{use_provides},
@@ -291,7 +292,7 @@ if ($urpm::args::options{list_aliases}) {
}
}
} elsif ($urpm::args::options{auto_select} || $urpm::args::options{upgrade}) {
- $urpm->resolve_dependencies($state, \%requested,
+ urpm::select::resolve_dependencies($urpm, $state, \%requested,
keep => $urpm::args::options{keep},
rpmdb => $urpm::args::options{env} && "$urpm::args::options{env}/rpmdb.cz",
auto_select => $urpm::args::options{auto_select},