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: The error, entry, milestone, and text (but not yet file)
# DESCRIPTION: methods now call XML::Dumper::quote_xml_chars, which was
# DESCRIPTION: already called by writeEvent, to quote the four HTML-special
# DESCRIPTION: characters &, <, >, and ", in their input message or text,
# DESCRIPTION: to avoid interfering with the real HTML tags. (A useful
# DESCRIPTION: extension might be to include a flag argument to indicate
# DESCRIPTION: that the message is HTML, so that eg. colors can be used.)
# 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
# HISTORY: $Log: Log.pm,v $
# HISTORY: Revision 1.4 2014/02/27 07:01:07 apsop
# HISTORY: VERSION header now shows CVS Revision
# HISTORY:
# HISTORY: Revision 1.3 2012/04/26 08:54:59 apsop
# HISTORY: Quote the HTML-special characters before writing to log file.
# HISTORY:
# HISTORY: Revision 1.2 2006/08/01 20:35:34 apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# 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
#
# VERSION: $Revision: 1.4 $
#
##############################################################################
use strict;
use Util::CoreTags;
use FileHandle;
use XML::Dumper;
##############################
# 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");
$self->{EVENTLOG} = $filename->get("eventlog");
################################################
# 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 $eventlog = $self->{EVENTLOG};
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 "<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;
#######################
# [XML] event log
#######################
if ( -e $eventlog) {
rename $eventlog, "$eventlog.old";
}
$self->{EVENTFH} = FileHandle->new($eventlog, 'w')
or die "Can't open $eventlog [$!]";
$self->{EVENTFH}->print("<Log>\n");
#########################################
# 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;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime();
my $timestamp =
sprintf("%4d-%03d-%02d:%02d:%02d", $year+1900, $yday+1, $hour, $min, $sec);
my $qmessage = XML::Dumper::quote_xml_chars($message);
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<STRONG>-> $qmessage</STRONG> ($timestamp)<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 $t = time;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
my $anchor = "LO$mday$hour$min$sec";
my $timestamp =
sprintf("%4d-%03d-%02d:%02d:%02d", $year+1900, $yday+1, $hour, $min, $sec);
my $qmessage = XML::Dumper::quote_xml_chars($message);
################
# 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 "$qmessage ($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 "$qmessage ($timestamp)</A>\n";
close INDEX;
$self->timestamp($message);
}
sub writeEvent
{
my ($self, $tag, $text, $level, $time) = @_;
$tag ||= 'none';
my $str = "\n<Event>\n";
$str .= "\t<tag>$tag</tag>\n";
if ($level) {
$str .= "\t<level>$level</level>\n";
}
if ($time) {
$str .= "\t<time>$time</time>\n";
}
my $xml = XML::Dumper::quote_xml_chars($text);
$str .= "\t$xml\n";
$str .= "</Event>\n";
if ($self->{EVENTFH}) {
$self->{EVENTFH}->print($str);
}
else {
# during global destruction
open EVENTFH, ">>$self->{EVENTLOG}";
print EVENTFH $str;
close EVENTFH;
}
}
sub secToHMS
{
my ($s) = @_;
my $str = $s;
my $h = int($s / 3600);
$s -= 3600 * $h;
my $m = int($s / 60);
$s -= 60 * $m;
if ($h > 0) {
$str .= sprintf('=%d:%02d:%02d', $h, $m, $s);
}
elsif ($m > 0) {
$str .= sprintf('=%d:%02d', $m, $s);
}
return $str;
}
sub timestamp
{
my ($self, $text) = @_;
my $t = time;
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($t);
my $tstr = sprintf('%d/%02d/%02d %02d:%02d:%02d',
1900 + $year, 1 + $mon, $mday, $hour, $min, $sec);
if ($self->{TZERO}) {
my $elapsed = secToHMS($t - $self->{TZERO});
my $delta = secToHMS($t - $self->{TLAST});
$text .= " [elapsed=$elapsed delta=$delta]";
}
else {
$self->{TZERO} = $t;
}
$self->{TLAST} = $t;
$self->writeEvent(TIMESTAMP, $text, 0, $tstr);
}
sub event
{
my ($self, $tag, $text, %args) = @_;
$tag ||= 'none';
my $level = $args{level} || 0;
my $time = $args{time} || 0;
$self->writeEvent($tag, $text, $level, $time);
}
###########################################################################
# signal an error
###########################################################################
sub error {
my $self = shift;
my $control = shift;
my $message = shift;
my $level = 0;
my $tag = undef;
if (UNIVERSAL::isa($control, 'ARRAY')) {
($level, $tag) = @$control;
}elsif ($control =~ /^\d+$/) {
$level = $control;
$tag = UNKNOWN_ERROR;
}else {
$tag = $control;
}
$self->event($tag, $message, level => $level);
#######################################################################
# 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) = gmtime(time);
my $anchor="E$level$mday$hour$min$sec";
################################
# job log entry
################################
my $qmessage = XML::Dumper::quote_xml_chars($message);
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<H2><A NAME=\"$anchor\">E$level\[$tag] $qmessage</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}: $qmessage</A>\n";
close ERRLOG;
#####################################
# indicate the error in the job.par
#####################################
if($level >= 2 ) {
$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;
my $qtext = XML::Dumper::quote_xml_chars($text);
open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
print JOBLOG "<PRE>\n";
print JOBLOG $qtext;
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;
}
if (-f $self->{EVENTLOG}) {
if ($self->{EVENTFH}) {
$self->{EVENTFH}->close;
undef($self->{EVENTFH});
}
open EVENTFH, ">>$self->{EVENTLOG}";
print EVENTFH "\n</Log>\n";
close EVENTFH;
}
} # end of DESTROY method
1;