diff options
Diffstat (limited to 'urpm/select.pm')
| -rw-r--r-- | urpm/select.pm | 442 |
1 files changed, 442 insertions, 0 deletions
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; |