#!/usr/bin/perl

use warnings;
use strict;

opendir my($dh), "." or die;
my(@keep, @delete, %f);

for my $dirent (readdir $dh) {
  next unless $dirent =~ m{^ perl - ([pm] - [^@]+?) @ ([\d]+) $ }x;
  $f{$1}{$2} = $dirent;
  # warn "considering dirent[$dirent]";
}
for my $k (sort keys %f) {
  my @f = sort {$a <=> $b} keys %{$f{$k}};
  # warn "k[$k]f[@f]";
  for my $k2 (0..$#f) {
    if ( $k2 < $#f ) {
      push @delete, $f{$k}{$f[$k2]}
    } else {
      push @keep, $f{$k}{$f[$k2]};
    }
  }
}
if (@keep) {
  print "keep[@keep]\n";
} else {
  print "Found no perl build directories\n";
}
if (@delete){
  my @ok_to_delete = grep { -M > 0.5 } @delete;
  if (my $let_live = scalar @delete - scalar @ok_to_delete) {
    print "not deleting $let_live young directories\n";
    @delete = @ok_to_delete;
  }
  print "delete[@delete]\n"
} else {
  print "nothing to delete\n";
}

use File::Find;

if (@delete) {
  $| = 1;
  my %seen;
  for my $delete (@delete) {
    find({
          wanted => sub {
            lstat;
            if (-l _) {
              unlink $_;
            } elsif (-d _) {
              rmdir $_;
              my $ffn = $File::Find::name;
              my $cntslash = $File::Find::name =~ tr|/||;
              $ffn =~ s|/.*||;
              print $seen{$ffn}++ ? $cntslash < 2 ? "." : "" : "\nrm $ffn";
            } elsif (-f _) {
              unlink $_;
            }
          },
          bydepth => 1,
         }, $delete);
    rmdir $delete;
  }
}
print "\n";