# 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 ] [-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); }