use Perl

So yesterday I discovered the hard disk was filling up on my NetBSD laptop.

After much investigating with du I found that the culprit was the .cpanplus directory in my $HOME. Doh.

It appears that CPANPLUS doesn't currently prune the build directory and CPAN Testing generates a lot of files in there.

Now I know that CPAN prunes the build dir based on size, but it occurred to me that for smoking purposes size doesn't matter, but the modification time of the distribution folders in there would.

I have a fairly clean perl installation I use for smoke testing (ie. it only has CPANPLUS and dependencies installed ). This means that a module and all it's prerequisities get tested. I didn't want big prereqs like Catalyst to be deleted unnecessarily.

So the script I came up with uses CPANPLUS to find the build directory, then removes anything older than 14 days

use strict;
use warnings;
use CPANPLUS::Backend;
use POSIX;
use File::Find;
use File::Spec;

my %dirs;

my $dir = _get_build_dir();
my $olderthan = time() - ( 14 * 24 * 60 * 60 );

opendir my $DIR, $dir or die "$!\n";

while ( my $item = readdir($DIR) ) {
  next if $item =~ /^\./;
  my $filename = File::Spec->catfile( $dir, $item );
  my $mtime = ( stat($filename) )[9];
  $dirs{$filename} = $mtime if $mtime < $olderthan;
}

closedir($DIR);

for my $d ( sort { $dirs{$a} <=> $dirs{$b} } keys %dirs ) {
  print "$d: ", strftime("%Y-%m-%d %H:%M:%S",localtime($dirs{$d})), "\n";
  finddepth(\&wanted, $d);
}

exit 0;

sub wanted {
  chmod 0755, $File::Find::name;
  print "Removing ", $File::Find::name, "\n";
  if ( -d $File::Find::name ) {
    rmdir $File::Find::name;
    return;
  }
  unlink $File::Find::name;
  return;
}

sub _get_build_dir {
  my $cb = CPANPLUS::Backend->new();
  my $conf = $cb->configure_object();
  File::Spec->catdir(
    $conf->get_conf('base'),
    $cb->_perl_version( perl => $^X ),
    $conf->_get_build('moddir')
  );
}

Adjust to taste