Attachment #38378 for bug #60763

View | Details | Raw Unified | Return to bug 60763
Collapse All | Expand All

Lines 8-14 Link Here

(-)pkg_cutleaves/Makefile (-1 / +1 lines)
8	#	8	#
9		9
10	PORTNAME= pkg_cutleaves	10	PORTNAME= pkg_cutleaves
11	PORTVERSION= 20031227	11	PORTVERSION= 20031231
12	CATEGORIES= sysutils	12	CATEGORIES= sysutils
13	MASTER_SITES= # none	13	MASTER_SITES= # none
14	DISTFILES= # none	14	DISTFILES= # none




# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $FreeBSD$

# Interactive script for deinstalling "leaf" packages;
# requires the portupgrade tools

	ROUND: while($again eq "y") {
		# Get list of leaf packages and put them into a hash
		my %leaves = get_leaves($dbdir, $exclpattern);
		# Ignore all leaves the user already told us to keep
		foreach my $leaf (keys %leavestokeep) {
			if ($leaves{$leaf}) {
				delete $leaves{$leaf};
			}
		}
		# Any leaves left?
		if (keys(%leaves) == 0) {
			# If not, don't go on, there's nothing left to do.
			print "Didn't find any new leaves, exiting.\n";
			last ROUND;
		}
		# Always start with an empty list of leaves to cut
		%leavestocut = ();

		LEAVESLOOP: foreach my $leaf (sort keys %leaves) {
			print "$leaf - $leaves{$leaf}\n";
			print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? ";
			# Get first character of input, without leading whitespace
			my ($answer) = (lc(<STDIN>) =~ m/(\S)/);
			if ($answer eq "d") {
				print "** Marking $leaf for removal.\n\n";
				$leavestocut{$leaf} = 1;
			}
			elsif ($answer eq "f") {
				print "\n";
				last LEAVESLOOP;
			}
			elsif ($answer eq "a") {
				print "\n";
				last ROUND;
			}
			else {
				print "** Keeping $leaf.\n\n";
				$leavestokeep{$leaf} = 1;
					$leavestokeep{$leaf} = 1;
				}
			}
		} # LEAVESLOOP


		# loop through packages marked for removal and pkg_deinstall them
		foreach my $leaf (sort keys %leavestocut) {
			$noff++;
			print "Deleting $leaf (package $noff of $ncuts).\n";
			my @deinstall_args;
			if ($opt_recursive) {
				@deinstall_args = ($pkgdeinstall, '-R', $leaf);

				@deinstall_args = ($pkgdeinstall, $leaf);
			}
			if ((my $status = system(@deinstall_args) >> 8) != 0) {
				print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n";
				last ROUND;
			}
			@cutleaves = (@cutleaves, $leaf);

		if ($opt_pkgdb) {
			print "Running 'pkgdb -F'.\n";
			if ((my $status = system(@pkgdb_args) >> 8) != 0) {
				print STDERR "\n\n$0: pkgdb returned $status - exiting, fix this first.\n\n";
				last ROUND;
			}
		}

		print "Go on with new leaf packages ((y)es/[no])? ";
		# Get first character of input, without leading whitespace
		($again) = (lc(<STDIN>) =~ m/(\S)/);
		print "\n";
	} # ROUND

Return to bug 60763

Lines 25-31 Link Here

(-)pkg_cutleaves/src/pkg_cutleaves (-26 / +37 lines)
25	# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF	25	# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
26	# SUCH DAMAGE.	26	# SUCH DAMAGE.
27	#	27	#
28	# $FreeBSD: ports/sysutils/pkg_cutleaves/src/pkg_cutleaves,v 1.3 2003/12/27 23:08:05 pav Exp $	28	# $FreeBSD$
29		29
30	# Interactive script for deinstalling "leaf" packages;	30	# Interactive script for deinstalling "leaf" packages;
31	# requires the portupgrade tools	31	# requires the portupgrade tools
Lines 156-186 Link Here
156	ROUND: while($again eq "y") {	156	ROUND: while($again eq "y") {
157	# Get list of leaf packages and put them into a hash	157	# Get list of leaf packages and put them into a hash
158	my %leaves = get_leaves($dbdir, $exclpattern);	158	my %leaves = get_leaves($dbdir, $exclpattern);
		159	# Ignore all leaves the user already told us to keep
		160	foreach my $leaf (keys %leavestokeep) {
		161	if ($leaves{$leaf}) {
		162	delete $leaves{$leaf};
		163	}
		164	}
		165	# Any leaves left?
		166	if (keys(%leaves) == 0) {
		167	# If not, don't go on, there's nothing left to do.
		168	print "Didn't find any new leaves, exiting.\n";
		169	last ROUND;
		170	}
159	# Always start with an empty list of leaves to cut	171	# Always start with an empty list of leaves to cut
160	%leavestocut = ();	172	%leavestocut = ();
161		173
162	LEAVESLOOP: foreach my $leaf (sort keys %leaves) {	174	LEAVESLOOP: foreach my $leaf (sort keys %leaves) {
163	if (!$leavestokeep{$leaf}) {	175	print "$leaf - $leaves{$leaf}\n";
164	print "$leaf - $leaves{$leaf}\n";	176	print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? ";
165	print "$leaf - [keep]/(d)elete/(f)lush marked pkgs/(a)bort? ";	177	# Get first character of input, without leading whitespace
166	my $answer = substr(lc(<STDIN>), 0, 1);	178	my ($answer) = (lc(<STDIN>) =~ m/(\S)/);
167		179	if ($answer eq "d") {
168	if ($answer eq "d") {	180	print "** Marking $leaf for removal.\n\n";
169	print "** Marking $leaf for removal.\n\n";	181	$leavestocut{$leaf} = 1;
170	$leavestocut{$leaf} = 1;	182	}
171	}	183	elsif ($answer eq "f") {
172	elsif ($answer eq "f") {	184	print "\n";
173	print "\n";	185	last LEAVESLOOP;
174	last LEAVESLOOP;	186	}
175	}	187	elsif ($answer eq "a") {
176	elsif ($answer eq "a") {	188	print "\n";
177	print "\n";	189	last ROUND;
178	last ROUND;	190	}
179	}	191	else {
180	else {	192	print "** Keeping $leaf.\n\n";
181	print "** Keeping $leaf.\n\n";	193	$leavestokeep{$leaf} = 1;
182	$leavestokeep{$leaf} = 1;
183	}
184	}	194	}
185	} # LEAVESLOOP	195	} # LEAVESLOOP
186		196
Lines 190-196 Link Here
190	# loop through packages marked for removal and pkg_deinstall them	200	# loop through packages marked for removal and pkg_deinstall them
191	foreach my $leaf (sort keys %leavestocut) {	201	foreach my $leaf (sort keys %leavestocut) {
192	$noff++;	202	$noff++;
193	print "Deleting $leaf, package $noff of $ncuts.\n";	203	print "Deleting $leaf (package $noff of $ncuts).\n";
194	my @deinstall_args;	204	my @deinstall_args;
195	if ($opt_recursive) {	205	if ($opt_recursive) {
196	@deinstall_args = ($pkgdeinstall, '-R', $leaf);	206	@deinstall_args = ($pkgdeinstall, '-R', $leaf);
Lines 198-204 Link Here
198	@deinstall_args = ($pkgdeinstall, $leaf);	208	@deinstall_args = ($pkgdeinstall, $leaf);
199	}	209	}
200	if ((my $status = system(@deinstall_args) >> 8) != 0) {	210	if ((my $status = system(@deinstall_args) >> 8) != 0) {
201	print "\npkg_cutleaves: pkg_deinstall returned $status - exiting, fix this first.\n\n";	211	print STDERR "\n\n$0: pkg_deinstall returned $status - exiting, fix this first.\n\n";
202	last ROUND;	212	last ROUND;
203	}	213	}
204	@cutleaves = (@cutleaves, $leaf);	214	@cutleaves = (@cutleaves, $leaf);
Lines 208-220 Link Here
208	if ($opt_pkgdb) {	218	if ($opt_pkgdb) {
209	print "Running 'pkgdb -F'.\n";	219	print "Running 'pkgdb -F'.\n";
210	if ((my $status = system(@pkgdb_args) >> 8) != 0) {	220	if ((my $status = system(@pkgdb_args) >> 8) != 0) {
211	print "\npkg_cutleaves: pkgdb returned $status - exiting, fix this first.\n\n";	221	print STDERR "\n\n$0: pkgdb returned $status - exiting, fix this first.\n\n";
212	last ROUND;	222	last ROUND;
213	}	223	}
214	}	224	}
215		225
216	print "Go on with new leaf packages ((y)es/[no])? ";	226	print "Go on with new leaf packages ((y)es/[no])? ";
217	$again = substr(lc(<STDIN>), 0, 1);	227	# Get first character of input, without leading whitespace
		228	($again) = (lc(<STDIN>) =~ m/(\S)/);
218	print "\n";	229	print "\n";
219	} # ROUND	230	} # ROUND