# perl script to remove old checkpoints
# akalaveshi@mahinetworks.com
use Getopt::Std;
use vars qw'$opt_h $opt_d $opt_n';
getopts('hd:n:') || usage();
if ($opt_h) { usage();}
unless ($opt_d && $opt_n) { usage();}
opendir (DIR, "$opt_d");
my (@files) = readdir (DIR);
closedir (DIR);
my (@checkpoints, @journals);
foreach my $file (@files) {
if ($file =~ /^checkpoint\.\d+\.gz$/) {
push (@checkpoints, $file);
} elsif ($file =~ /^journal\.\d+\.gz$/) {
push (@journals, $file);
}
}
my (@sortedcheckpoints) = sort byinstance @checkpoints;
my (@sortedjournals) = sort byinstance @journals;
deletetop (\@sortedcheckpoints, $opt_n);
deletetop (\@sortedjournals, $opt_n);
sub deletetop {
my ($files, $number) = @_;
if (scalar(@$files) >= $number) {
my ($limit) = $#{$files} - $number;
for my $i (0..$limit) {
unlink ($$files[$i]);
}
}
}
sub usage {
# print usage
print "NAME\n$0\n";
print "SYNOPSIS\n$0 [-h] [-d <dir>] [-n <#>]\n";
print "DESCRIPTION\nA perl script to delete old perforce checkpoints\n";
print "OPTIONS\n";
print "\t-h\n\t\tDisplay this page.\n";
print "\t-d\n\t\tDefines the directory where the checkpoints are kept.\n";
print "\t-n\n\t\tNumber of checkpoints/ journals to keep.\n";
exit;
}
sub getinstance {
my ($filename) = @_;
if ($filename =~ /.*\.(\d+)\.gz/) {
return($1);
}
}
sub byinstance {
getinstance($a) <=> getinstance($b);
}