#!/usr/bin/perl
#
# cleansweep.pl
# Quick hack by Jacob Lundberg <jacob@gnifty.net>
#
# Clean up a debian archive by removing entries dpkg-scanpackages
# tells us are duplicates (usually outdated packages).
#

# Safety to prevent obvious abuse.
$target = "./" . $ARGV[0];
$target =~ s#/\.\.(?=/)##g;

# Work in the archive.
chdir($target) || die "$target: archive does not exist.";

# Find out what packages to delete.
$output = `dpkg-scanpackages ./ /dev/null 2>&1 1>/dev/null`;
$output =~ s/^(\s*\!.*)\n(.*\!\s*)$/\1\2/gm;
@output = split(/\n/, $output);
@files  = grep(/^\s*\!.+\!\s*$/, @output);

# The scanpackages program lists old files in two different formats...
map(s/.*ignored data from (\S+).*/\1/i, @files);
map(s/.*\(filename (\S+)\) is repeat;\s*ignored that one.*/\1/i, @files);

# And then delete the packages.
chomp(@files);
$count = unlink(@files);

# User friendly blurb.
if ($count != scalar(@files)) {
	print("$target: unable to delete some old files! (" .
		$count . "/" . scalar(@files) . ")\n");
} elsif ($count == 0) {
	print("$target: no old files to be seen.\n");
} elsif ($count == 1) {
	print("$target: swept up 1 old file.\n");
} else {
	print("$target: swept up $count old files.\n");
}