1a409537dSespie#!/usr/bin/perl
2a409537dSespie# ex:ts=8 sw=4:
3*f1ddee08Sespie# $OpenBSD: PkgDelete.pm,v 1.13 2011/07/12 10:51:28 espie Exp $
4a409537dSespie#
5a409537dSespie# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
6a409537dSespie#
7a409537dSespie# Permission to use, copy, modify, and distribute this software for any
8a409537dSespie# purpose with or without fee is hereby granted, provided that the above
9a409537dSespie# copyright notice and this permission notice appear in all copies.
10a409537dSespie#
11a409537dSespie# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12a409537dSespie# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13a409537dSespie# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14a409537dSespie# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15a409537dSespie# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16a409537dSespie# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17a409537dSespie# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18a409537dSespie
19a409537dSespieuse strict;
20a409537dSespieuse warnings;
21a409537dSespie
22a409537dSespieuse OpenBSD::AddDelete;
23a409537dSespie
24681090d4Sespiepackage OpenBSD::PkgDelete::Tracker;
25681090d4Sespie
26681090d4Sespiesub new
27681090d4Sespie{
28681090d4Sespie	my $class = shift;
29681090d4Sespie	bless {}, $class;
30681090d4Sespie}
31681090d4Sespie
32681090d4Sespiesub sets_todo
33681090d4Sespie{
34681090d4Sespie	my ($self, $offset) = @_;
35681090d4Sespie	return sprintf("%u/%u", (scalar keys %{$self->{done}})-$offset,
36681090d4Sespie		scalar keys %{$self->{total}});
37681090d4Sespie}
38681090d4Sespie
39681090d4Sespiesub handle_set
40681090d4Sespie{
41681090d4Sespie	my ($self, $set) = @_;
42681090d4Sespie	$self->{total}{$set} = 1;
43681090d4Sespie	if ($set->{finished}) {
44681090d4Sespie		$self->{done}{$set} = 1;
45681090d4Sespie	}
46681090d4Sespie}
47681090d4Sespie
48681090d4Sespiesub todo
49681090d4Sespie{
50681090d4Sespie	my ($self, $list) = @_;
51681090d4Sespie	for my $set (@$list) {
52681090d4Sespie		for my $pkgname ($set->older_names) {
53681090d4Sespie			$self->{todo}{$pkgname} = $set;
54681090d4Sespie		}
55681090d4Sespie		$self->handle_set($set);
56681090d4Sespie	}
57681090d4Sespie}
58681090d4Sespie
59681090d4Sespie
60681090d4Sespiesub done
61681090d4Sespie{
62681090d4Sespie	my ($self, $set) = @_;
63681090d4Sespie	$set->{finished} = 1;
64681090d4Sespie	for my $pkgname ($set->older_names) {
65681090d4Sespie		delete $self->{todo}{$pkgname};
66681090d4Sespie	}
67681090d4Sespie	$self->handle_set($set);
68681090d4Sespie}
69681090d4Sespie
70681090d4Sespiesub find
71681090d4Sespie{
72681090d4Sespie	my ($self, $pkgname) = @_;
73681090d4Sespie	return $self->{todo}{$pkgname};
74681090d4Sespie}
75681090d4Sespie
76681090d4Sespie
77681090d4Sespie
78a409537dSespiepackage OpenBSD::PkgDelete::State;
79a409537dSespieour @ISA = qw(OpenBSD::AddDelete::State);
80a409537dSespie
81681090d4Sespiesub new
82681090d4Sespie{
83681090d4Sespie	my $class = shift;
84681090d4Sespie	my $self = $class->SUPER::new(@_);
85681090d4Sespie	$self->{tracker} = OpenBSD::PkgDelete::Tracker->new;
86681090d4Sespie	return $self;
87681090d4Sespie}
88681090d4Sespie
89681090d4Sespiesub tracker
90681090d4Sespie{
91681090d4Sespie	my $self = shift;
92681090d4Sespie	return $self->{tracker};
93681090d4Sespie}
94681090d4Sespie
958a660df1Sespiesub handle_options
968a660df1Sespie{
978a660df1Sespie	my $state = shift;
988a660df1Sespie	$state->SUPER::handle_options('',
99681090d4Sespie	    '[-acIinqsvx] [-B pkg-destdir] [-D name[=value]] pkg-name [...]');
1008a660df1Sespie
1018a660df1Sespie	my $base = $state->opt('B') // $ENV{'PKG_DESTDIR'} // '';
1028a660df1Sespie	if ($base ne '') {
1038a660df1Sespie		$base.='/' unless $base =~ m/\/$/o;
1048a660df1Sespie	}
1058a660df1Sespie	$ENV{'PKG_DESTDIR'} = $base;
1068a660df1Sespie
1078a660df1Sespie	$state->{destdir} = $base;
1088a660df1Sespie	if ($base eq '') {
1098a660df1Sespie	    $state->{destdirname} = '';
1108a660df1Sespie	} else {
1118a660df1Sespie	    $state->{destdirname} = '${PKG_DESTDIR}';
1128a660df1Sespie	}
1138a660df1Sespie}
1148a660df1Sespie
115a409537dSespiesub todo
116a409537dSespie{
11700f714c9Sespie	my ($state, $offset) = @_;
118681090d4Sespie	return $state->tracker->sets_todo($offset);
119681090d4Sespie}
120681090d4Sespie
121681090d4Sespiesub stem2location
122681090d4Sespie{
123681090d4Sespie	my ($self, $locator, $name, $state) = @_;
124681090d4Sespie	require OpenBSD::Search;
125681090d4Sespie	my $l = $locator->match_locations(OpenBSD::Search::Stem->new($name));
126681090d4Sespie	if (@$l > 1 && !$state->defines('allversions')) {
127681090d4Sespie		$l = OpenBSD::Search::FilterLocation->keep_most_recent->filter_locations($l);
128681090d4Sespie	}
129681090d4Sespie	return $state->choose_location($name, $l);
130a409537dSespie}
131a409537dSespie
132a409537dSespiepackage OpenBSD::PkgDelete;
133a409537dSespieour @ISA = qw(OpenBSD::AddDelete);
134a409537dSespie
135a409537dSespieuse OpenBSD::PackingList;
136a409537dSespieuse OpenBSD::RequiredBy;
137a409537dSespieuse OpenBSD::Delete;
138a409537dSespieuse OpenBSD::PackageInfo;
139a409537dSespieuse OpenBSD::UpdateSet;
140681090d4Sespieuse OpenBSD::Handle;
141a409537dSespie
142a409537dSespie
143681090d4Sespiesub add_location
144681090d4Sespie{
145681090d4Sespie	my ($self, $state, $l) = @_;
146681090d4Sespie	push(@{$state->{setlist}},
147681090d4Sespie	    $state->updateset->add_older(OpenBSD::Handle->from_location($l)));
148681090d4Sespie}
149681090d4Sespie
150681090d4Sespiesub create_locations
151681090d4Sespie{
152681090d4Sespie	my ($state, @l) = @_;
153681090d4Sespie	my $inst = $state->repo->installed;
154681090d4Sespie	my $result = [];
155681090d4Sespie	for my $name (@l) {
156681090d4Sespie		my $l = $inst->find($name, $state->{arch});
157681090d4Sespie		if (!defined $l) {
158681090d4Sespie			$state->errsay("Can't find #1 in installed packages",
159681090d4Sespie			    $name);
160681090d4Sespie			$state->{bad}++;
161681090d4Sespie		} else {
162681090d4Sespie			push(@$result, $state->updateset->add_older(OpenBSD::Handle->from_location($l)));
163681090d4Sespie		}
164681090d4Sespie	}
165681090d4Sespie	return $result;
166681090d4Sespie}
167681090d4Sespie
168a409537dSespiesub process_parameters
169a409537dSespie{
170a409537dSespie	my ($self, $state) = @_;
1717096cf21Sespie
172681090d4Sespie	my $inst = $state->repo->installed;
1737096cf21Sespie
174681090d4Sespie	if (@ARGV == 0 && $state->{automatic}) {
175681090d4Sespie		for my $l (@{$inst->locations_list}) {
176681090d4Sespie			$self->add_location($state, $l);
177a409537dSespie		}
178a409537dSespie	} else {
179681090d4Sespie		for my $pkgname (@ARGV) {
180681090d4Sespie			my $l;
181681090d4Sespie
182681090d4Sespie			if (OpenBSD::PackageName::is_stem($pkgname)) {
183681090d4Sespie				$l = $state->stem2location($inst, $pkgname, $state);
184681090d4Sespie			} else {
185681090d4Sespie				$l = $inst->find($pkgname, $state->{arch});
186681090d4Sespie			}
187681090d4Sespie			if (!defined $l) {
188681090d4Sespie				$state->say("Problem finding #1", $pkgname);
189a409537dSespie				$state->{bad}++;
190681090d4Sespie			} else {
191681090d4Sespie				$self->add_location($state, $l);
192a409537dSespie			}
193a409537dSespie		}
194681090d4Sespie	}
195a409537dSespie}
196a409537dSespie
197a409537dSespiesub finish_display
198a409537dSespie{
199a409537dSespie}
200a409537dSespie
201681090d4Sespiesub really_remove
202681090d4Sespie{
203681090d4Sespie	my ($set, $state) = @_;
204681090d4Sespie	if ($state->{not}) {
205681090d4Sespie		$state->status->what("Pretending to delete");
206681090d4Sespie	} else {
207681090d4Sespie		$state->status->what("Deleting");
208681090d4Sespie	}
209681090d4Sespie	if (!$state->progress->set_header($set->delete_print)) {
210681090d4Sespie		$state->say($state->{not} ?
211681090d4Sespie		    "Pretending to delete #1" :
212681090d4Sespie		    "Deleting #1",
213681090d4Sespie		    $set->delete_print) if $state->verbose;
214681090d4Sespie	}
215681090d4Sespie	for my $pkgname ($set->older_names) {
216681090d4Sespie		$state->log->set_context('-'.$pkgname);
217681090d4Sespie		OpenBSD::Delete::delete_package($pkgname, $state);
218681090d4Sespie	}
219681090d4Sespie	$set->cleanup;
220681090d4Sespie	$state->tracker->done($set);
221681090d4Sespie	$state->progress->next($state->ntogo);
222681090d4Sespie}
223681090d4Sespie
224*f1ddee08Sespiesub delete_dependencies
225*f1ddee08Sespie{
226*f1ddee08Sespie	my $state = shift;
227*f1ddee08Sespie
228*f1ddee08Sespie	if ($state->defines("dependencies")) {
229*f1ddee08Sespie		return 1;
230*f1ddee08Sespie	}
231*f1ddee08Sespie	if ($state->{interactive}) {
232*f1ddee08Sespie		return $state->confirm("Delete them as well", 0);
233*f1ddee08Sespie	}
234*f1ddee08Sespie	return 0;
235*f1ddee08Sespie}
236*f1ddee08Sespie
237*f1ddee08Sespiesub fix_bad_dependencies
238*f1ddee08Sespie{
239*f1ddee08Sespie	my $state = shift;
240*f1ddee08Sespie
241*f1ddee08Sespie	if ($state->defines("baddepend")) {
242*f1ddee08Sespie		return 1;
243*f1ddee08Sespie	}
244*f1ddee08Sespie	if ($state->{interactive}) {
245*f1ddee08Sespie		return $state->confirm("Delete anyways", 0);
246*f1ddee08Sespie	}
247*f1ddee08Sespie	return 0;
248*f1ddee08Sespie}
249*f1ddee08Sespie
250681090d4Sespiesub remove_set
251681090d4Sespie{
252681090d4Sespie	my ($set, $state) = @_;
253681090d4Sespie
254681090d4Sespie	my $todo = {};
255681090d4Sespie	my $bad = {};
256681090d4Sespie	$set = $set->real_set;
257681090d4Sespie	if ($set->{finished}) {
258681090d4Sespie		return ();
259681090d4Sespie	}
260681090d4Sespie    	for my $pkgname ($set->older_names) {
261681090d4Sespie		unless (is_installed($pkgname)) {
262681090d4Sespie			$state->errsay("#1 was not installed", $pkgname);
263681090d4Sespie			$set->{finished} = 1;
264681090d4Sespie			$set->cleanup(OpenBSD::Handle::NOT_FOUND);
265681090d4Sespie			$state->{bad}++;
266681090d4Sespie			return ();
267681090d4Sespie		}
268681090d4Sespie		my $r = OpenBSD::RequiredBy->new($pkgname);
269681090d4Sespie		for my $pkg ($r->list) {
270681090d4Sespie			next if $set->{older}->{$pkg};
271681090d4Sespie			my $f = $state->tracker->find($pkg);
272681090d4Sespie			if (defined $f) {
273681090d4Sespie				$todo->{$pkg} = $f;
274681090d4Sespie			} else {
275681090d4Sespie				$bad->{$pkg} = 1;
276681090d4Sespie			}
277681090d4Sespie		}
278681090d4Sespie	}
279681090d4Sespie	if (keys %$bad > 0) {
280*f1ddee08Sespie		my $bad2 = {};
281*f1ddee08Sespie		for my $pkg (keys %$bad) {
282*f1ddee08Sespie			if (!is_installed($pkg)) {
283*f1ddee08Sespie				$bad2->{$pkg} = 1;
284*f1ddee08Sespie			}
285*f1ddee08Sespie		}
286*f1ddee08Sespie		if (keys %$bad2 > 0) {
287*f1ddee08Sespie			$state->errsay("#1 depends on non-existant #2",
288*f1ddee08Sespie			    $set->delete_print, join(' ', sort keys %$bad2));
289*f1ddee08Sespie			if (fix_bad_dependencies($state)) {
290*f1ddee08Sespie				for my $pkg (keys %$bad2) {
291*f1ddee08Sespie					delete $bad->{$pkg};
292*f1ddee08Sespie				}
293*f1ddee08Sespie			}
294*f1ddee08Sespie		}
295*f1ddee08Sespie	}
296*f1ddee08Sespie	if (keys %$bad > 0) {
297681090d4Sespie		if (!$state->{automatic}) {
298681090d4Sespie			$state->errsay("can't delete #1 without deleting #2",
299*f1ddee08Sespie			    $set->delete_print, join(' ', sort keys %$bad));
300*f1ddee08Sespie			if (delete_dependencies($state)) {
301681090d4Sespie			    	my $l = create_locations($state, keys %$bad);
302681090d4Sespie				$state->tracker->todo($l);
303681090d4Sespie				return (@$l, $set);
304681090d4Sespie			}
305681090d4Sespie			$state->{bad}++;
306681090d4Sespie	    	}
307681090d4Sespie		$set->cleanup(OpenBSD::Handle::CANT_DELETE);
308681090d4Sespie		$state->tracker->done($set);
309681090d4Sespie		return ();
310681090d4Sespie	}
311681090d4Sespie	# XXX this si where we should detect loops
312681090d4Sespie	if (keys %$todo > 0) {
313681090d4Sespie		if ($set->{once}) {
314681090d4Sespie			for my $set2 (values %$todo) {
315681090d4Sespie				# XXX merge all ?
316681090d4Sespie				$set->add_older($set2->older);
317681090d4Sespie				$set2->{merged} = $set;
318681090d4Sespie				$set2->{finished} = 1;
319681090d4Sespie			}
320681090d4Sespie			delete $set->{once};
321681090d4Sespie			return ($set);
322681090d4Sespie		}
323681090d4Sespie		$set->{once} = 1;
324681090d4Sespie		return (values %$todo, $set);
325681090d4Sespie	}
326681090d4Sespie	if ($state->{automatic}) {
327681090d4Sespie		for my $pkg  ($set->older) {
328681090d4Sespie			$pkg->complete_old;
329681090d4Sespie			if ($pkg->plist->has('manual-installation')) {
330681090d4Sespie				$set->cleanup(OpenBSD::Handle::CANT_DELETE);
331681090d4Sespie				$state->tracker->done($set);
332681090d4Sespie				return ();
333681090d4Sespie			}
334681090d4Sespie		}
335681090d4Sespie	}
336681090d4Sespie	really_remove($set, $state);
337681090d4Sespie	return ();
338681090d4Sespie}
339681090d4Sespie
340a409537dSespiesub main
341a409537dSespie{
342a409537dSespie	my ($self, $state) = @_;
343a409537dSespie
3447096cf21Sespie	my %done;
3457096cf21Sespie	my $removed;
3467096cf21Sespie
347681090d4Sespie	$state->tracker->todo($state->{setlist});
348a409537dSespie	# and finally, handle the removal
349681090d4Sespie	while (my $set = shift @{$state->{setlist}}) {
350681090d4Sespie		$state->status->what->set($set);
351681090d4Sespie		unshift(@{$state->{setlist}}, remove_set($set, $state));
352a409537dSespie	}
353a409537dSespie}
354a409537dSespie
355a409537dSespiesub new_state
356a409537dSespie{
3577e83eca3Sespie	my ($self, $cmd) = @_;
3587e83eca3Sespie	return OpenBSD::PkgDelete::State->new($cmd);
359a409537dSespie}
360a409537dSespie
361a409537dSespie1;
362