root/bin/cleanpkgs

#!/usr/bin/perl
use warnings;
use strict;

use File::Copy qw(move);
use FileHandle;
use IPC::Open2;
use File::Spec::Functions;
use File::Find;
use File::Basename;

use Getopt::Long;

our $DEBUG = 0;
our $remove = '';       # no, trash, delete

our $parentdir = '/Volumes/Junior/Dave/packages';
our $pid; # of child process

GetOptions(
        'debug'                 => \$DEBUG,
        'r|remove=s'    => \$remove,
) or die "Bad options\n";
$remove = 0 if grep { $_ eq lc $remove } ('false', '0', 'no');

sub remote_needed {
        my ($in, $out);
        my $input = <<COMMAND;
. /fink/permanent/bin/init.sh
/Users/vasi/Hacking/bin/fink-needed
COMMAND
        $pid = open2($in, $out, qw(ssh -T 10.0.1.203));
        print $out $input; 
        close $out;
        return $in;
}

our %targets = (
        DEFAULT => {
                keep => sub { \*STDIN },
                scan => sub { m,/binary-darwin-powerpc$, }
        },
        
        permanent => {
                subdir  => 'ToasterPermanentFink',
                keep    => sub { \*STDIN },
                scan    => sub { m,/binary-darwin-powerpc$, },
        },
        regular => {
                subdir  => 'ToasterFink105',
                keep    => sub { \*STDIN },
                scan    => sub { m,/binary-darwin-powerpc$, },
        },
);

sub needed {
        my ($target) = @_;
        
        my $in = &{$target->{keep}}();
        my @result = <$in>;
        close $in;
        
        waitpid $pid, 0 if defined $pid;
        
        print @result if $DEBUG;
        die "Not enough needed, probably a bug!\n" . join('', @result)
                unless scalar(@result) > 10;
        
        chomp @result;
        return @result;
}

sub have {
        my @debs;
        find({ no_chdir => 1, wanted => sub {
                return if m,^\W*/trash/,;
                return unless /\.deb$/;
                push @debs, $_;
        }}, '.');
        print map { "$_\n" } @debs if $DEBUG;
        @debs;
}

my ($tname, $tdir) = @ARGV;
my $target = $targets{$tname} || $targets{DEFAULT};
$target->{subdir} ||= $tdir;
print "### Cleaning up target '$tname'\n";

my $debdir = catdir($parentdir, $target->{subdir});
my $trash = catdir($debdir, 'trash');
mkdir $trash unless -d $trash;
chdir($debdir);

if ($remove) {
        print "### Getting the debs to keep\n";
        my %needed = map { $_ => 1 } needed($target);
                
        print "### Finding the debs we have\n";
        my @have = have;
        
        print "### Throwing out the ones we don't want anymore\n";
        for my $have (@have) {
                my ($file, $dir) = fileparse($have);
                unless ($needed{$file}) {
                        my $newdir = catdir($trash, $dir);
                        unless (-d $newdir) {
                                system('mkdir', '-p', $newdir) == 0
                                        or die "Can't create the target dir $newdir: $!\n";
                        }
                        my $newfile = catfile($newdir, $file);
                        print "  $have => $newfile\n";
                        File::Copy::move($have, $newfile);
                }
        }
}

print "### Updating the Packages.gz files\n";
my @scandirs;
find({ no_chdir => 1, wanted => sub {
        return if m,^\W*/trash/, || !&{$target->{scan}}();
        push @scandirs, $_;
        $File::Find::prune = 1;
}}, '.');

use lib '/sw/lib/perl5';
use Fink::Scanpackages;
my $sp = Fink::Scanpackages->new(db => 'scanpackages.db');
my $release = {
        Origin => 'Vasi',
        Label => 'Fink',
        Architecture => 'darwin-powerpc'
};
$sp->scan_dists({ release => $release }, @scandirs);


if (!$DEBUG && $remove eq 'delete') {
        print "### Permanently deleting old debs\n";
        system('rm', '-rf', $trash) == 0 or die "Can't take out the trash: $!\n";
}