use warnings;
use strict;
use DBI;
use Set::Tiny;
use CPAN;

CPAN::HandleConfig->load;
CPAN::Shell::setup_output;
CPAN::Index->force_reload;

my $dbfile = '/home/vagrant/.cpan/cpandb.sql';
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","");
my $query_distros = $dbh->prepare(q{select A.dist_file from dists A jo
+in auths B on A.auth_id = B.auth_id where B.cpanid = ?});
my $query_authors = $dbh->prepare(q{select cpanid from auths});
$query_authors->execute();
my $removed = 0;

while (my $row = $query_authors->fetchrow_arrayref()) {
    my $distros = get_distro_files($dbh, $query_distros, $row->[0]);
    my $path = '/minicpan/authors/id/' . substr($row->[0],0,1) . '/' .
+ substr($row->[0],0,2) . '/' . $row->[0];
    next unless ( -d $path );
    opendir(DIR,$path) or die "Cannot read $path: $!";
    my @files = readdir(DIR);
    close(DIR);
    shift(@files);
    shift(@files);

    foreach my $distro_file(@files) {
        next if $distro_file eq 'CHECKSUMS';
        my $to_remove = $path . '/' . $distro_file;
        next unless (-f $to_remove);
        
        unless ($distros->has($distro_file)) {
            my $to_remove = $path . '/' . $distro_file;
            print "$to_remove can be removed\n";
            unlink( $to_remove ) or warn "could not remove $to_remove:
+ $!";
            $removed++;
        }
    }
    
}

$dbh->disconnect();
print "Total removed: $removed\n";
    
sub get_distro_files {
    my ($dbh, $sth, $author) = @_;
    $sth->bind_param(1, $author);
    $sth->execute();
    my @distros;

    while ( my $row = $sth->fetchrow_arrayref() ) {
        push(@distros, $row->[0]);
    }
    
    return Set::Tiny->new(@distros);
}
[download]