recursive uninstaler

recursive_uninstaler.pl (text/plain), 1.31 KB, created by Mladen Stefanov on 2006-05-03 04:53:58 UTC

#!/usr/bin/perl

sub packstrip
{
	my $pakg = shift(@_);
	$pakg =~ m/(.*)-r[0-9]+/;
	if ($1) { $pakg = $1; }
	$pakg =~ m/(.*)-[0-9,\-,\.]*/;
	return $1;
}

open FG, "<pkglist";
open FOUT, ">output";
open FR, ">pkg_to_reemerge";
@glines = <FG>;
@output = ();
@outl = ();
foreach $pack (@glines) { 
	chomp $pack;
	$pack=packstrip($pack);
	if (!grep(/$pack/, @output)) 
		{ 
		push(@output, $pack); }
	} 
@blackl =();
@checked = ();
while  ($pack=shift(@output))
{
	if (!grep(/$pack/,@blackl)) {
	if (!grep(/$pack/,@outl)) { push(@outl, $pack); print FOUT "$pack\n"; }
	print "Searching packets depending on $pack...\n";
	@packs = `equery depends $pack`;
	push(@checked, $pack);
	shift @packs;
	while ($newpack=shift(@packs)) { 
		$newp = packstrip($newpack);
		if (!grep(/$newp/, @outl)) {
			if (grep(/$newp/,@blackl)) { print "skipping $newp ...\n"; }
			else {
			print "$newp is not in the list. Add ?\n";
			read STDIN, $ch, 2;
			if ($ch !~ /n.*/i) {
				print "Adding $newp\n";
				if (!grep(/$newp/,@output) && !grep(/$newp/,@checked)) { push(@output, $newp); }
				if (!grep(/$newp/,@outl)) {
					push(@outl, $newp);
					print FOUT "$newp\n"; }
				}
			else { push(@blackl, $newp); }
			}
		} else { print "$newp is in the list...\n"; }
		
	}
	}
}
while  ($pack=shift(@blackl)) 
{
	print FR "$pack\n";
}
close FG;
close FR;
close FOUT;