autoupdate/cleanup_packages.pl

#! /usr/bin/perl
# $Id: cleanup_packages.pl,v 1.1 2011/06/20 17:39:34 markus Exp $
# vi: set tabstop=8 noexpandtab shiftwidth=8:

use strict;
use warnings;

my $portsdir = $ENV{PORTSDIR} || '/usr/ports/';

sub getProcessorArch {
	open(my $fh, '-|', 'uname', '-p')
	    or die "Unable to get processor arch\n";
        my $arch = <$fh>;
	close($fh);
	chomp $arch;
	return $arch;
}

sub getInstalledPackages {
	my %packages = ();
	open(my $fh, '-|', '/usr/sbin/pkg_info')
	    or die "Unable to read package list: $!\n";
	while(<$fh>) {
		s/\s+.*//x;
		chomp;
		$packages{$_} = 1;
	}
	close($fh);
	return \%packages;
}


sub getAvailablePackages {
	my $arch = shift;
	my $subdir = shift;

	my $directory = "$portsdir/packages/$arch/$subdir";
	return {} if (! -d "$directory");
	opendir(my $dh, $directory)
	    or die "Unable to open package directory: $!\n";
        my %packages = map { s/\.tgz$//rx => 1 } grep { !/^\./x } readdir $dh;
	closedir $dh;
	return \%packages;
}


sub printNotInstalledPackages {
	my $arch = shift;
	my $installed = shift;
	my $available = shift;
	my $dir = shift;

	for my $pkg (sort keys %{$available}) {
		if (! exists $installed->{$pkg}) {
			print "rm $portsdir/packages/$arch/$dir/$pkg.tgz\n";
		}
	}
	return;
}

my $arch = getProcessorArch();
print '#! /bin/sh' . "\n";
my $installed = getInstalledPackages();
for my $dir ('all', 'cdrom', 'ftp') {
	my $available = getAvailablePackages($arch, $dir);
	printNotInstalledPackages($arch, $installed, $available, $dir);
}