#! /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); }