summaryrefslogtreecommitdiffstats
path: root/urpm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'urpm.pm')
-rw-r--r--urpm.pm431
1 files changed, 0 insertions, 431 deletions
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 {