Perl::Script::Cleanup Old Files
The following script will accept a list of folders and recursively look through each one for files older than a specified number of days.
A parameter file is used to provide input so it can be flexible after packaging with PerlPackager.
#cleanup.pl
use File::Find;
#get parameters
open (PRM, ";
close (PRM);
my $folder = $prm[0];
chomp $folder;
my @folder = split(/,/,$folder);
my $limit = $prm[1];
chomp $limit;
#Create log folder if it does not exist
if (not(-e "cleanup\\.")) {
mkdir ("cleanup");
}
#Name Log File
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime();
$m = sprintf("%0.2i", $mon+1);
$d = sprintf("%0.2i", $mday);
$y = $year + 1900 ;
$yy = substr($y, -2, 2);
$yy = sprintf("%0.2i", $yy);
$hh = sprintf("%0.2i", $hour);
$mm = sprintf("%0.2i", $min);
$ss = sprintf("%0.2i", $sec);
$T = "$y$m$d$hh$mm$ss" ;
$logfile=".\\cleanup\\$T.log";
open(LOG, ">$logfile");
print LOG "Cleanup run: $m\/$d\/$y $hh:$mm:$ss\n Folders: @folder\n Delete older than: $limit days\n";
print LOG "The following files, if any, have been deleted:\n";
find(\&CheckFile, @folder);
sub CheckFile {
if (not(-d $_)) {
if ($limit < (-M $_)) { $current = $File::Find::name; $current =~ tr/\//\\\\/; unlink $_; print LOG " $current\n"; } } } close (LOG);
The parameter file is below. It is setup to purge it's own log folder (.\cleanup) after the same number of days.
.\cleanup,c:\dev\purge\test\bak\1,c:\dev\purge\test\bak\2
10
#line 1 = comma separated list of folders to recursively search for old files.
#line 2 = number of days after which to delete files.
No comments:
Post a Comment