package Util::Log;
##############################################################################
#
# DESCRIPTION: This object handles a log of everything which happens in a
# DESCRIPTION: processing script. The log is in a convenient HTML format
# DESCRIPTION: and includes an index to major processing steps and to
# DESCRIPTION: processing errors.
# DESCRIPTION: The much simpler Util::NoLog class will output
# DESCRIPTION: to stdout and stderr, for times when a log object has not
# DESCRIPTION: yet been created.
# DESCRIPTION:
# DESCRIPTION: Note that the constructor creates new log files, so
# DESCRIPTION: only one Log object should be used throughout a given processing
# DESCRIPTION: script.
#
# HISTORY: 1.0 -> 1.1 2002-03-28
# HISTORY: Modified to allow restart capability
# HISTORY: Milestone timestamp now 0 padded.
# HISTORY:
# HISTORY: 1.1 -> 1.2 2004-04-12
# HISTORY: Now write log file names to parfile
# HISTORY:
# HISTORY: 1.2 -> 1.3 2004-10-01
# HISTORY: Removed text in the error log which claimed the errors had
# HISTORY: been checked by the processing team, and directing people to
# HISTORY: the ascahelp mailing list.
#
# VERSION: 1.3
#
##############################################################################
use strict;
##############################
# class data
##############################
my $CONTINUATION_INDICATOR="<!-- LOG TO BE CONTINUED -->";
############################################################################
# create a new set of HTML log pages and write their headers.
# If there are exsiting files with the same name, rename then by
# appending ".old" to their names. This is sometimes useful when debugging.
############################################################################
sub new { #(filename_object, jobpar_object)
my $proto = shift;
my $class = ref($proto) || $proto;
my $filename = shift;
my $self={};
#################################
# save the jobpar objects
# since we need to record errors
# in the job.par
##################################
$self->{JOBPAR} = shift;
##############################################################
# save the process ID of the processes which created this
# object. This is so we can later tell if we are in a forked
# off child when it comes time to close up the logs
##############################################################
$self->{PID_OF_CREATOR}=$$;
############################################################
# set the "keep open" flag to false, so that the logs will
# normally be closed when the script exits
############################################################
$self->{KEEP_OPEN} = 0;
#############################################################
# flags to avoid infinite loops due to recursive calls
# to the error method
#############################################################
$self->{ERROR_RECURSION}=0;
$self->{MAX_ERROR_RECURSIONS}=5;
#####################################
# determine the log file names
#####################################
$self->{JOBLOG} = $filename->get("joblog");
$self->{ERRLOG} = $filename->get("errlog");
$self->{INDEX} = $filename->get("logindex");
################################################
# store the log file names in the parfile
################################################
$self->{JOBPAR}->set({joblog => $self->{JOBLOG},
errlog => $self->{ERRLOG},
milestones => $self->{INDEX} });
########################################################
# check if we are supposed to continue an existing log
########################################################
my $initialize_logs=1;
if( -f $self->{JOBLOG} ) {
###################################################
# there is an old log, so look for a continuation
# marker at the end of it
##################################################
open JOBLOG, "<$self->{JOBLOG}";
my $last_line;
while(<JOBLOG>) { $last_line=$_ }
close JOBLOG;
chomp($last_line);
if($last_line eq $CONTINUATION_INDICATOR ) { $initialize_logs=0 }
}
if($initialize_logs) {
####################################
# open the logs
####################################
my $seq=$filename->{JOBPAR}->read("sequence");
my $ver=$filename->{JOBPAR}->read("seqprocnum");
my $joblog = $self->{JOBLOG};
my $errlog = $self->{ERRLOG};
my $index = $self->{INDEX};
my $header = $filename->get("header");
#######################
# job log
#######################
if( -e $joblog) {
##################################
# save any old version of the log
##################################
rename $joblog, $joblog . ".old";
}
open JOBLOG, ">$joblog" or die "Can't open $joblog";
print JOBLOG "<HTML>";
print JOBLOG "<HEAD>";
print JOBLOG "<TITLE>";
print JOBLOG "Processing Job Log for Sequence $seq, version $ver";
print JOBLOG "</TITLE>\n";
print JOBLOG "</HEAD>\n";
print JOBLOG "<BODY>\n";
print JOBLOG "<CENTER>\n";
print JOBLOG "<H1>Processing Job Log for Sequence $seq,\n";
print JOBLOG "version ${ver}</H1>\n";
print JOBLOG "</CENTER>\n";
print JOBLOG "This is the complete and detailed record of how this\n";
print JOBLOG "sequence was processed.\n";
print JOBLOG "<P>\n";
print JOBLOG "The following information is also available:\n";
print JOBLOG "<UL>\n";
print JOBLOG " <LI><STRONG><A HREF=\"$index\">";
print JOBLOG "The processing log index</A></STRONG>\n";
print JOBLOG " <LI><A HREF=\"$errlog\">";
print JOBLOG "An index of processing errors</A>\n";
print JOBLOG "</UL>\n";
print JOBLOG "<HR><!-- |||||||||||||||||||||||||||||||||||||||||".
"||||||||||||||||||||||| -->\n";
close JOBLOG;
##########################
# Error Log
##########################
if ( -e "$errlog" ) {
rename $errlog, "${errlog}.old";
}
open (ERRLOG, ">$errlog") or die "Can't open $errlog";
print ERRLOG "<HTML>\n";
print ERRLOG "<HEAD>\n";
print ERRLOG "<TITLE>\n";
print ERRLOG "Errors in Processing for Sequence $seq, version $ver";
print ERRLOG "</TITLE>\n";
print ERRLOG "</HEAD>\n";
print ERRLOG "<BODY>\n";
print ERRLOG "<CENTER><H1>Errors in Processing for Sequence $seq,\n";
print ERRLOG "version $ver</H1></CENTER>\n";
print ERRLOG "This page gives a list of all the errors encountered \n";
print ERRLOG "in processing this sequence.\n";
# print ERRLOG "These errors have been \n";
# print ERRLOG "checked by the processing staff and should not affect \n";
# print ERRLOG "the validity of these data. If you have any questions \n";
# print ERRLOG "please contact\n";
# print ERRLOG "<TT>ascahelp\@legacy.gsfc.nasa.gov</TT>.\n";
print ERRLOG "<P>\n";
print ERRLOG "The following information is also available:\n";
print ERRLOG "<UL>\n";
print ERRLOG " <LI><STRONG><A HREF=\"$index\">";
print ERRLOG "The processing log index</A></STRONG>\n";
print ERRLOG " <LI><A HREF=\"${joblog}\">The entire processing ".
"log</A>\n";
print ERRLOG "</UL>\n";
print ERRLOG "<HR><!-- |||||||||||||||||||||||||||||||||||||||||".
"||||||||||||||||||||||| -->\n";
print ERRLOG "<OL>\n";
close ERRLOG;
#######################
# job log index
#######################
if ( -e "$index" ) {
rename $index, "$index.old";
}
open INDEX, ">$index" or die "Can't open $index";
print INDEX "<HTML>\n";
print INDEX "<HEAD>\n";
print INDEX "<TITLE>";
print INDEX "Processing Log Index for Sequence $seq, version $ver";
print INDEX "</TITLE>\n";
print INDEX "</HEAD>\n";
print INDEX "<BODY>\n";
print INDEX "<CENTER><H1>Processing Log Index for Sequence $seq, ";
print INDEX "version ${ver}</H1></CENTER>\n";
print INDEX "The processing log documents the creation of the files\n";
print INDEX "in this distribution\n";
print INDEX "and indicates any errors that may have occurred.\n";
print INDEX "This page gives an index to the major processing steps\n";
print INDEX "and the 24 hour clock time at which the event \n";
print INDEX "occurred.<P>\n";
print INDEX "The following information is also available:\n";
print INDEX "<UL>\n";
print INDEX " <LI><STRONG><A HREF=\"${header}\">";
print INDEX "The processing header page</A></STRONG>\n";
print INDEX " <LI><A HREF=\"${errlog}\">";
print INDEX "An index of processing errors</A>\n";
print INDEX " <LI><A HREF=\"${joblog}\">";
print INDEX "The entire processing log</A>\n";
print INDEX "</UL>\n";
print INDEX "<HR><!-- |||||||||||||||||||||||||||||||||||||||||".
"||||||||||||||||||||||| -->\n";
print INDEX "<OL>\n";
close INDEX;
#########################################
# initialize the job.par parameters
#########################################
$self->{JOBPAR}->set({nprocerrors=>0,
proc_error =>"no"});
} # end if we need to initialize the logs
bless($self,$class);
return $self;
} # end of constructor
###########################
# ACCESSORS:
###########################
#############################################################################
# signify whether the logs should be kept open on quitting
# the default argument is "true"
# This should be called if processing is stopping in the middle
# and hopes to resume later
############################################################################
sub keep_open() {
my $self = shift;
my $boolean=shift;
if( ! defined $boolean) { $boolean=1 }
$self->{KEEP_OPEN}=$boolean;
}
###########################
# METHODS:
###########################
#######################################
# make an entry in the job log
#######################################
sub entry {
my $self = shift;
my $message=shift;
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<STRONG>-> $message</STRONG><BR>\n";
close JOBLOG;
}
##############################################
# mark a major event in the job log and index
##############################################
sub milestone {
my $self = shift;
my $message=shift;
###############################
# get unique HTML anchor name
###############################
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $anchor="LO$mday$hour$min$sec";
my $timestamp=sprintf("%02d:%02d:%02d",$hour,$min,$sec);
################
# Job log entry
################
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<HR><!-- --------------------------------------------- -->\n";
print JOBLOG "<H2><A NAME=\"$anchor\">";
print JOBLOG "$message ($timestamp)</A></H2>\n\n";
close JOBLOG;
##############
# Index entry
#############
open INDEX, ">>$self->{INDEX}" or die "Can't open $self->{INDEX}";
print INDEX " <LI><A HREF=\"$self->{JOBLOG}#$anchor\">\n";
print INDEX "$message ($hour:$min:$sec)</A>\n";
close INDEX;
}
###########################################################################
# signal an error
###########################################################################
sub error {
my $self = shift;
my $level=shift;
my $message=shift;
#######################################################################
# check for excessive recursion, then increment the recursion counter
#######################################################################
if($self->{ERROR_RECURSION} > $self->{MAX_ERROR_RECURSIONS}) {
############################################################
# the logging mechanism is busted, so give an error message
# to stderr and give up
#############################################################
print STDERR "The Util::Log->error method has called itself more ".
"than $self->{MAX_ERROR_RECURSIONS} times\n";
print STDERR "The last error was E$level: $message\n";
exit 3;
}
$self->{ERROR_RECURSION}++;
########################
# get HTML anchor name
########################
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $anchor="E$level$mday$hour$min$sec";
################################
# job log entry
################################
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<H2><A NAME=\"$anchor\">E$level: $message</A></H2>\n";
############################
# do a calling stack trace
############################
my $package;
my $filename;
my $line;
my $subroutine;
my $hasargs;
my $wantargs;
print JOBLOG "Stack Trace:\n";
print JOBLOG "<OL>\n";
my $i=0;
while (($package,$filename,$line,$subroutine,$hasargs,$wantargs)
=caller($i) ) {
$filename =~ s/^.*\/(.*\/.*)$/$1/;
print JOBLOG "<LI><strong>File:</strong> $filename ";
print JOBLOG "<strong>Line:</strong> $line\n";
$i++;
}
print JOBLOG "</OL>\n";
close JOBLOG;
###########################
# error log entry
###########################
open ERRLOG,">>$self->{ERRLOG}" or die "Can't open $self->{ERRLOG}";
print ERRLOG "<LI><A HREF=\"$self->{JOBLOG}#$anchor\">";
print ERRLOG "E${level}: $message</A>\n";
close ERRLOG;
#####################################
# indicate the error in the job.par
#####################################
$self->{JOBPAR}->increment("nprocerrors");
if($level == 3 ) {
####################
# fatal error
####################
$self->{JOBPAR}->set({proc_error=>"yes"});
exit $level;
}
##################################
# decrement the recursion counter
##################################
$self->{ERROR_RECURSION}--;
} # end of error method
###################################################
# dump the contents of a file to the log
###################################################
sub file {
my $self=shift;
my $file=shift;
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<PRE>\n";
if( ! open(FILE, "<$file") ) {
$self->error(2,"Could not dump file $file to log");
return;
}
while (<FILE>) {
print JOBLOG;
}
close FILE;
print JOBLOG "</PRE>\n";
close JOBLOG;
}
###################################################
# dump the contents of a string to the log.
# The string will be enclosed in <PRE> tags, so this
# is most appropriate for multi-line text
###################################################
sub text {
my $self=shift;
my $text=shift;
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<PRE>\n";
print JOBLOG $text;
print JOBLOG "</PRE>\n";
close JOBLOG;
}
#####################################################
# object destructor method.
# Close up the logs
#####################################################
sub DESTROY {
my $self=shift;
# print "log DESTROY PID=$$ PID_OF_CREATOR=$self->{PID_OF_CREATOR}\n";
#print "About to close logs\n";
#system("cp *errlog* z1");
################################################################
# Check to see if we are in some dying child process
# in that case don't close up the logs, because that
# would mean the log would be close multiple times when the
# parent and child are done. This comes into play when using
# ExternalScript
################################################################
if($self->{PID_OF_CREATOR} != $$ ) {
return;
}
#######################################################
# check if the keep open flag has been set - probably
# because we are stopping in the middle and hope to
# resume procesisng later. If we want to keep the
# logs we write the continuation indicator at the end
# of the joblog so that we will know not to
# start a new log when we restart
#######################################################
if( $self->{KEEP_OPEN} ) {
open JOBLOG, ">>$self->{JOBLOG}";
print JOBLOG "\n$CONTINUATION_INDICATOR\n";
close JOBLOG;
return;
}
######################################################
# if we get here we are in the same process which
# created this object. So mark the end of processing
# with a milestone...
######################################################
$self->milestone("Processing complete");
#system("cp *errlog* z2");
###############################################
# ... and then put closing HTML tags into all
# the logs
###############################################
my $log;
foreach $log ($self->{JOBLOG},$self->{ERRLOG},$self->{INDEX}) {
open LOG, ">>$log" or die "Can't open $log";
if($log ne $self->{JOBLOG}) {
print LOG "</OL>\n";
}
print LOG "</BODY>\n</HTML>\n";
close LOG;
}
} # end of DESTROY method
1;