Util::Log (version 1.2)


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
# HISTORY: $Log: Log.pm,v $
# 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: 1.2
#
##############################################################################

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);

    open  JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
    print JOBLOG "<STRONG>-> $message</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);

    ################
    # 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 ($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
    ################################
    open JOBLOG, ">>$self->{JOBLOG}" or die "Can't open $self->{JOBLOG}";
    print JOBLOG "<H2><A NAME=\"$anchor\">E$level\[$tag] $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
    #####################################
    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;

    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;
    }

	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;