Perl: Cleaning Core Files on a Linux/Unix/Numa System

Unix and Numa does not have a “stat” command like Linux. However, with the beautiful language of Perl we can provide one from the Perl library. Here is a simple script to find core files from a specific directory and remove them.

#!/usr/bin/perl
use strict;
use File::Find;
use File::stat;

my $wdirectory = "/home/mkniazic";
my $test_direc = "/home";
my $mount_tab = "/etc/mtab";
my $dayofweek = (localtime) [6];
my $flag;
my $core_files;

#function to test for file system in mtab to insure it exists and is mounted
open(FILE, " <;$mount_tab");
while ( ){
$flag = 1 if /$test_direc/;
}
close(FILE);

#If statement to see if the directory is writeable and mounted
if (-w $wdirectory  & & $flag == 1){
chdir "$wdirectory" or die "$wdirectory is not writeable: $!n";
find( &wanted,$wdirectory ); #function to find what we are looking for
}
else {
die "$wdirectory is not writable or cannot be found in the mtab: $!n";
}
sub wanted {
if ($dayofweek == 0 || $dayofweek == 1) {
if($_ =~ /^core$/  & & -f $_){
my $sb = (stat($File::Find::name)) [0];
#If statement is to determine if the day is Sunday or Monday and that the file has not been accessed for over 5 hours
if ($dayofweek == 0 || $dayofweek == 1  & & (scalar localtime $sb- >;atime - 18000) le (scalar (localtime))){
printf "File name $File::Find::name nDate last modified:%snSize:%sn", (scalar localtime $sb- >;mtime),($sb- >;size);
print "File name $File::Find::name nDate last modified:%snSize:%sn", (scalar localtime $sb- >;mtime),($sb- >;size);
}
else {
print "There are no files to removen";
printf "This is the file date:%sn", (scalar localtime $sb- >;mtime);
exit;
}
}
}
else {
if($_ =~ m/^core$/  & & -f $_){
my $sb = (stat($File::Find::name)) [0];
if((scalar localtime $sb- >;atime - 18000) le (scalar (localtime))){
printf "File name $File::Find::name nDate last modified:%snSize:%sn", (scalar localtime $sb- >;atime),($sb- >;size);
#`rm $File::Find::name`;
}
}
}
}
exit;
#

Enjoy,

Mike Kniaziewicz

Comments are closed.