Take that more as a "proof of concept", hasn't gone thru nearly enough testing
yet.
This does rewrite pkg_delete to look a lot more like pkg_add works, and this
is the reason why I've rejected small tweaks to pkg_delete in the recent past,
since I knew I had to do this one day.
In particular, this should deal with nasty interdependencies (yes, you can
end up with that in some nasty corners of the tree with pkg_add -r).
It should also be easily tweaked to be able to remove all !manual-installs
packages that are no longer needed.
And also, it deletes what it can, and tells you automatically what it cannot
delete.
If things don't work, well tough... like I said, it's not been tested a lot
yet.
diff --git a/OpenBSD/PkgDelete.pm b/OpenBSD/PkgDelete.pm
index 66f3cd1..e7b9926 100644
--- a/OpenBSD/PkgDelete.pm
+++ b/OpenBSD/PkgDelete.pm
@@ -50,6 +50,42 @@ sub todo
return sprintf("%u/%u", $state->{done} - $offset, $state->{total});
}
+sub track
+{
+ my ($state, $list) = @_;
+ for my $set (@$list) {
+ for my $pkgname ($set->older_names) {
+ $state->{todo}->{$pkgname} = $set;
+ }
+ }
+}
+
+sub find
+{
+ my ($state, $pkgname) = @_;
+ return $state->{todo}->{$pkgname};
+}
+
+sub finished
+{
+ my ($state, $set) = @_;
+ $set->{finished} = 1;
+ for my $pkgname ($set->older_names) {
+ delete $state->{todo}->{$pkgname};
+ }
+}
+
+sub stem2location
+{
+ my ($self, $locator, $name, $state) = @_;
+ require OpenBSD::Search;
+ my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name));
+ if (@$l > 1 && !$state->defines('allversions')) {
+ $l =
OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l);
+ }
+ return $state->choose_location($name, $l);
+}
+
package OpenBSD::PkgDelete;
our @ISA = qw(OpenBSD::AddDelete);
@@ -58,63 +94,107 @@ use OpenBSD::RequiredBy;
use OpenBSD::Delete;
use OpenBSD::PackageInfo;
use OpenBSD::UpdateSet;
+use OpenBSD::Handle;
sub process_parameters
{
my ($self, $state) = @_;
- my @realnames;
- my @toremove;
-
- OpenBSD::PackageInfo::solve_installed_names(\@ARGV, \@realnames,
- "(removing them all)", $state);
-
- @toremove = OpenBSD::RequiredBy->compute_closure(@realnames);
-
- if (@toremove > @realnames) {
- my $details = $state->verbose >= 2 ||
- $state->defines('verbosedeps');
- my $show = sub {
- my ($p, $d) = @_;
- $state->say("Can't remove #1".
- " without also removing:\n#2",
- join(' ', @$p), join(' ', @$d));
- };
- if ($state->{interactive} || !$details) {
- my %deps = map {($_, 1)} @toremove;
- for my $p (@realnames) {
- delete $deps{$p};
- }
- &$show([@realnames], [keys %deps]);
- if (@realnames > 1 && (keys %deps) > 1 &&
- $state->confirm("Do you want details", 1)) {
- $details = 1;
- }
- }
- if ($details) {
- for my $pkg (@realnames) {
- my @deps =
OpenBSD::RequiredBy->compute_closure($pkg);
- next unless @deps > 1;
- @deps = grep {$_ ne $pkg} @deps;
- &$show([$pkg], [@deps]);
- }
+ if (@ARGV == 0) {
+ @ARGV = sort(installed_packages());
+ }
+ my $inst = $state->repo->installed;
+ for my $pkgname (@ARGV) {
+ my $l;
+
+ if (OpenBSD::PackageName::is_stem($pkgname)) {
+ $l = $state->stem2location($inst, $pkgname, $state);
+ } else {
+ $l = $inst->find($pkgname, $state->{arch});
}
- my $them = @toremove > 1 ? 'them' : 'it';
- if ($state->defines('dependencies') or
- $state->confirm("Do you want to remove $them as well", 0)) {
- $state->say("(removing #1 as well)", $them);
+ if (!defined $l) {
+ $state->say("Problem finding #1", $pkgname);
} else {
- $state->{bad}++;
+ push(@{$state->{setlist}},
+
$state->updateset->add_older(OpenBSD::Handle->from_location($l)));
}
}
- $state->{toremove} = \@toremove;
}
sub finish_display
{
}
+sub really_remove
+{
+ my ($set, $state) = @_;
+ for my $pkgname ($set->older_names) {
+ $state->status->object($pkgname);
+ if (!$state->progress->set_header($pkgname)) {
+ $state->say($state->{not} ?
+ "Pretending to delete #1" :
+ "Deleting #1",
+ $pkgname) if $state->verbose;
+ }
+ $state->log->set_context('-'.$pkgname);
+ OpenBSD::Delete::delete_package($pkgname, $state);
+ }
+ $set->{finished} = 1;
+}
+
+sub remove_set
+{
+ my ($set, $state) = @_;
+
+ my $todo = {};
+ my $bad = {};
+ $set = $set->real_set;
+ if ($set->{finished}) {
+ return ();
+ }
+ for my $pkgname ($set->older_names) {
+ unless (is_installed($pkgname)) {
+ $state->errsay("#1 was not installed", $pkgname);
+ $set->{finished} = 1;
+ return ();
+ }
+ my $r = OpenBSD::RequiredBy->new($pkgname);
+ for my $pkg ($r->list) {
+ next if $set->{older}->{$pkg};
+ my $f = $state->find($pkg);
+ if (defined $f) {
+ $todo->{$pkg} = $f;
+ } else {
+ $bad->{$pkg} = 1;
+ }
+ }
+ }
+ if (keys %$bad > 0) {
+ $state->errsay("can't delete #1 without deleting #2",
+ join(' ', $set->older_names), join(' ', sort keys %$bad));
+ $set->{finished} = 1;
+ return ();
+ }
+ # XXX this si where we should detect loops
+ if (keys %$todo > 0) {
+ if ($set->{once}) {
+ for my $set2 (values %$todo) {
+ # XXX merge all ?
+ $set->add_older($set2->older);
+ $set2->{merged} = $set;
+ $set2->{finished} = 1;
+ }
+ delete $set->{once};
+ return ($set);
+ }
+ $set->{once} = 1;
+ return (values %$todo, $set);
+ }
+ really_remove($set, $state);
+ return ();
+}
+
sub main
{
my ($self, $state) = @_;
@@ -122,55 +202,13 @@ sub main
my %done;
my $removed;
+ $state->{total} = scalar @{$state->{setlist}};
+ $state->track($state->{setlist});
# and finally, handle the removal
- do {
- $removed = 0;
- if ($state->{not}) {
- $state->status->what("Pretending to delete");
- } else {
- $state->status->what("Deleting");
- }
- $state->{total} = scalar @{$state->{toremove}};
- DELETE: for my $pkgname (@{$state->{toremove}}) {
- if ($done{$pkgname}) {
- next;
- }
- unless (is_installed($pkgname)) {
- $state->errsay("#1 was not installed",
$pkgname);
- $done{$pkgname} = 1;
- $removed++;
- next;
- }
- my $r = OpenBSD::RequiredBy->new($pkgname);
- if ($r->list > 0) {
- if ($state->defines('baddepend')) {
- for my $p ($r->list) {
- if ($done{$p}) {
- $r->delete($p);
- } else {
- next DELETE;
- }
- }
- } else {
- next;
- }
- }
- my $info = sub {
- };
-
- $state->status->object($pkgname);
- if (!$state->progress->set_header($pkgname)) {
- $state->say($state->{not} ?
- "Pretending to delete #1" :
- "Deleting #1",
- $pkgname) if $state->verbose;
- }
- $state->log->set_context('-'.$pkgname);
- OpenBSD::Delete::delete_package($pkgname, $state);
- $done{$pkgname} = 1;
- $removed++;
- }
- } while ($removed);
+ while (my $set = shift @{$state->{setlist}}) {
+ $state->status->what->set($set);
+ unshift(@{$state->{setlist}}, remove_set($set, $state));
+ }
}
sub new_state
