Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

BinGOs (7246)

BinGOs
  (email not shown publicly)
http://gumbynet.org.uk/

System administrator, part-time Perl hacker, full-time POE [perl.org] evangelist. One day he will be made to pay for his crimes.

He has some modules on CPAN [cpan.org]. They may or may not be useful

Journal of BinGOs (7246)

Sunday December 03, 2006
05:02 AM

CPANPLUS Pruning

[ #31792 ]

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

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.