sourcecode
DaveRoberts
<CODE>
use File::Find;
# Wrapper to configure the correct log file....
use constant TRUE => 1;
use constant FALSE => 0;
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= gmtime(time);
my $label = sprintf "%02d%s%04d_%02d%02d%02d",
$mday,$months[$mon],($year+1900),$hour,$min,$sec;
my($verbose) = FALSE; # Set verbose flag to off
my($age) = 7; # Max age of log files....(in days)
my($redirect,$ldir,$rv,@CODE,$exit_value,$signal_num,$dumped_core);
$exit_value = 0;
$|=1;
if ( $] >= 5.006 ) {
$redirect = TRUE;
}else{
$redirect = FALSE;
}
$ldir = shift @ARGV; # log file (first element of @ARGV)
mkdir $ldir unless (-d $ldir); # Create the log file directory
#-------------------------------------------------------------------------------
# Manage the log files
#
if ( $ldir =~ /(.*)\.(\S+)$/ ) {
my($name) = $1;
my($suffix) = $2;
$log = "$name-$label.$suffix";
my($root) = $name;
if ( $name =~ m/(.*)[\\|\/]([a-zA-Z0-9]+)/ ) {
my($root) = $1;
my($patt) = $2;
sub prune {
my ($dev,$ino,$mode,$nlink,$uid,$gid);
if ( /^$patt.*\z/s && (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
-f $_ && (int(-M _) > $age) ) {
my($file) = $File::Find::name;
print "Pruning log $file\n";
unlink $file || print " - failed to unlink $file\n";
}
}
sub archive {
if ( /^$patt.*\z/s && -f $_ ) {
my($file) = $File::Find::name;
my($rname) = $ldir . '/' . $_;
return if ($File::Find::dir eq $ldir );
if ( rename $file,$rname) {
print "archiving log $file to $rname\n";
}else{
print " - failed to move $file to $rname\n";
}
}
}
# Traverse desired filesystems
File::Find::find({wanted => \&prune}, $ldir);
# Prune log files older than $age days
File::Find::find({wanted => \&archive}, $root);
# move old log file to archive dir
}
}
if (open(FILE,">> $log ")) {
open(STDOUT_BACKUP,">&STDOUT");
open(STDOUT,">&FILE");
pr("perlcaller: @ARGV\n");
if ( $ARGV[0] =~ /\.(pl|cmd)$/ ) {
if ( $ARGV[0] =~ /\.pl$/ ) {
push(@CODE,"perl");
}else{
push(@CODE,"cmd");
}
push(@CODE,@ARGV);
pr("CODE: @CODE\n");
if (open(CODE_OUT, "@CODE 2>&1 |")){
$|=1;
while (<CODE_OUT>) {
print STDOUT " > $_" if ( $redirect );
print FILE " > $_" unless ( $redirect );
}
close CODE_OUT;
$rv=$?;
if ( $rv != 0 ) {
$exit_value = $rv >> 8;
$signal_num = $rv & 127;
$dumped_core = $rv & 128;
pr ("Return Code: $rv\n");
pr ("Exit Value : $exit_value\n");
pr ("Signal No : $signal_num\n");
pr ("Dumped Core: $dumped_core\n");
}
}else{
pr("Unable to execute @CODE ($?)\n");
$exit_value = $? >> 8;
$signal_num = $? & 127;
$dumped_core = $? & 128;
}
}else{
pr("$ARGV[0] is neither perl script (.pl) or a command file (.cmd)\n");
}
pr("perlcaller: done\n");
open(STDOUT,">&STDOUT_BACKUP");
close(STDOUT_BACKUP);
close(FILE);
}else{
print "failed to open log file $log ($!)\n";
}
exit $exit_value;
sub pr {
my($message)= @_;
my($dt)="[" . scalar( gmtime() ) . "] ";
print STDOUT "$dt $message" if ( $redirect );
print FILE "$dt $message" unless ( $redirect );
}
1;
</CODE>
This script is intended to be called by sysmon.pl - and manages the log file associated with this service.
Win32 Stuff
DaveRoberts@iname.com