diff options
| -rwxr-xr-x | gurpmi2 | 13 | ||||
| -rw-r--r-- | urpm.pm | 431 | ||||
| -rw-r--r-- | urpm/select.pm | 442 | ||||
| -rw-r--r-- | urpme | 6 | ||||
| -rwxr-xr-x | urpmi | 17 | ||||
| -rwxr-xr-x | urpmq | 7 |
6 files changed, 466 insertions, 450 deletions
@@ -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; } @@ -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; @@ -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"); @@ -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 @@ -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}, |