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 getInstalledPackages () {
	my %packages = ();
	open(my $fh, 'pkg_info |')
	    or die $!;
	while(<$fh>) {
		s/[[:space:]]+.*//;
		chomp;
		$packages{$_} = 1;
	}
	close($fh);
	return \%packages;
}


sub getAvailablePackages ($) {
	my $subdir = shift;
	my $arch = `uname -m`;
	chomp $arch;
	my $directory = "$portsdir/packages/$arch/$subdir";
	my %packages = ();
	return \%packages if (! -d "$directory");
	open(my $fh, "ls $directory |")
	    or die $!;
	while (<$fh>) {
		$_ =~ s/\.tgz$//;
		chomp;
		$packages{$_} = 1;
	}
	close($fh);
	return \%packages;
}


sub getNotInstalledPackages ($$$) {
	my $installed = shift;
	my $available = shift;
	my $dir = shift;
	my $arch = `uname -m`;
	chomp $arch;

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

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