Util::Tool (version $)

package Util::Tool;
##############################################################################
#
# DESCRIPTION: This class provides an interface to external programs.
# DESCRIPTION: It handles error checking and logging and allows access
# DESCRIPTION: to all aspects of input and output to the program.
# DESCRIPTION: Any output to stderr or a non-zero exit status from the program
# DESCRIPTION: signals an error.
# DESCRIPTION: 
# DESCRIPTION: Sub-classes like Util::Ftool, Util::PseudoFtool,
# DESCRIPTION: Util::Extractor, and Util::Stool give additional functionality
# DESCRIPTION: for specific types of programs.
#
# HISTORY
# HISTORY: $Log: Tool.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  2011/01/18 20:36:30  apsop
# HISTORY: Added code to change seriouseness of some errors from critical (2)
# HISTORY: to warnings (1).
# HISTORY:
# HISTORY: Revision 1.2  2006/08/01 20:35:34  apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2001-03-06
# HISTORY: Added more sophisticated exit status interpretation
# HISTORY: to detect core dumps and termination signals.
# HISTORY: Now delete core files in cleanup.
# HISTORY: 
# HISTORY: 1.1 -> 1.2 2002-04-23
# HISTORY: Added name method
# HISTORY:
# HISTORY: 1.2 -> 1.3 2003-06-19
# HISTORY: Now redirect stdin from /dev/null unless some stdin text has
# HISTORY: been specified.
# HISTORY: 
# HISTORY: 1.3 -> 1.4 2004-02-11
# HISTORY: Moved the environment setup functionality that was previously
# HISTORY: in ParfileTool.pm into this class.
#
# VERSION: $Revision: 1.4 $
#
##############################################################################

use IPC::Open3;
#use Util::Log;
use Config;
use strict;

my $LOG;

my @SIG_NAME;

###########################################################################
# this begin function sets up an index of signal names in the class data
##########################################################################
sub BEGIN {

@SIG_NAME=();

########################################
# might not be defined on some systems
########################################
unless( defined $Config{sig_name} ) { return }

@SIG_NAME = split(' ', $Config{sig_name});

} # end of BEGIN function


######################################
# constructor 
######################################
sub new { #(path,command)
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self={};

    $self->{PATH}    = shift;
    $self->{COMMAND} = shift;

    #############################################################
    # treat a null path as an error, since we want to avoid
    # silently running something without explicit path if the path
    # is null by accident.
    #############################################################
    if(!$self->{PATH} ) {
        if($LOG) {
            $LOG->error(2, "null path given for $self->{COMMAND} command");
        } else {
            print STDERR "null path given for $self->{COMMAND} command\n";
            exit 1;
        }
        $self->{PATH}=".";
    }

    ######################################################
    # to run something without explicit path, 
    # specify "system" 
    ######################################################
    if($self->{PATH} eq "system") {$self->{PATH} = ''};

    $self->{ARGUMENTS}="";

    $self->{SERIOUSNESS}=2; # level of error to give
    $self->{VERBOSE}=1; # should stdout be dumped to the log if no error?
    
    $self->{LIBS}=[];
    $self->{BINS}=[];
    $self->{ENVIRONMENT}={};


    $self->{STDIN}   = "";
    $self->{STDOUT}  = "";
    $self->{STDERR}  = "";
    $self->{STATUS}  = 0;
    $self->{CORE_DUMPED} = 0;
    $self->{SIGNAL}      = 0;
    $self->{HAD_ERROR}   = 0;

    $self->{STDOUT_FILE}="";
    $self->{CLOBBER_STDOUT_FILE}=0;

    $self->{IN_BUFFER_SIZE}=8192;
    $self->{OUT_BUFFER_SIZE}=1024;
    $self->{ERR_BUFFER_SIZE}=1024;

    bless($self,$class);
    return $self;

}


#####################################
# ACESSORS:
#####################################

####################################################
# get or set the Util::Log object in the class data
####################################################
sub log {
    my $self = shift;
    if (@_) { $LOG = shift }
    return $LOG;
}

####################################################
# get or set the error level to use when logging
# errors from the tool.
####################################################
sub seriousness {
    my $self = shift;
    if (@_) { $self->{SERIOUSNESS} = shift }
    return $self->{SERIOUSNESS};
}

####################################################
# get or set the text which will be fed to stdin when
# running the tool
####################################################
sub stdin {
    my $self = shift;
    if (@_) { $self->{STDIN} = shift }
    return $self;
}

#########################################################################
# get or set the command line arguments which will be given to the tool.
# multiple arguments are concatenated
#########################################################################
sub command_line {
    my $self = shift;
    if (@_) { $self->{ARGUMENTS} = join ' ', @_ }
    return $self;
}

#########################################################################
# set the amount of output which will logged. 
# - verbose(0) will not log stdout unless there was an error
# - verbose(1) will log all stdout
# Sub-classes may define higher levels of verbosity. Note errors are
# always reported.
#########################################################################
sub verbose {
    my $self = shift;
    if (@_) { $self->{VERBOSE} = shift }
    return $self;
}

#########################################################################
# return the verbosity level (see above)
#########################################################################
sub verbose_level {
    my $self = shift;

    return $self->{VERBOSE};
}

#########################################################################
# return the command including its full directory path (if specified)
# and the command line arguments. 
#########################################################################
sub command {
    my $self=shift;

    if($self->{PATH}) {
        return "$self->{PATH}/$self->{COMMAND} $self->{ARGUMENTS}";
    } else {
        return "$self->{COMMAND} $self->{ARGUMENTS}";
    }
}

#########################################################################
# return the name of the command (no directory path or arguments)
#########################################################################
sub name {
    my $self=shift;
    return $self->{COMMAND};
}



######################################################
# stdout text from running the program
######################################################
sub stdout {
    my $self = shift;
    if (@_) { $self->{STDOUT} = shift }
    return $self->{STDOUT};
}

######################################################
# stderr text from running the program
######################################################
sub stderr {
    my $self = shift;
    if (@_) { $self->{STDERR} = shift }
    return $self->{STDERR};
}

######################################################
# exit status given by the program
######################################################
sub status {
    my $self = shift;
    if (@_) { $self->{STATUS} = shift }
    return $self->{STATUS};
}

#####################################################################
# returns non-zero if an error was detected when running the program
#####################################################################
sub had_error {
    my $self = shift;
    if (@_) { $self->{HAD_ERROR} = shift }
    return $self->{HAD_ERROR};
}

#################################################################
# redirect stdout to the given file when the program is run.
# The optional clobber argument specifies whether the file
# will be deleted or appended to if it already exists.
#################################################################
sub stdout_file { #(file, clobber)
    my $self = shift;

    $self->{STDOUT_FILE} = shift;

    my $clobber=shift;
    if(defined $clobber) { $self->{CLOBBER_STDOUT_FILE}=$clobber}

    return $self;

}

sub stdout_limit {
    my $self = shift;
    my $limit = shift;
    $self->{STDOUT_LIMIT} = $limit;
    return $self->{STDOUT_LIMIT};
}


#########################################################################
# return all shared object library directories for this software package
# These will be prepended to LD_LIBRARY_PATH when the tool is run
#########################################################################
sub libs {
    my $self=shift;
    
    if(@_) { $self->{LIBS} = [@_]; }

    return @{$self->{LIBS}};

}

#########################################################################
# return all executable directories for this software package
# These will be prepended to PATH when the tool is run
#########################################################################
sub bins {
    my $self=shift;

    if(@_) { $self->{BINS} = [@_]; }


    return @{$self->{BINS}};
}

########################################################################
# Returns a reference to a hash of environment variables which must
# be set before running this tool
########################################################################
sub environment {
    my $self=shift;
    
    if(@_) { $self->{ENVIRONMENT} = shift; }

    return $self->{ENVIRONMENT};

} # end of environment method

######################
# METHODS:
######################


sub slurpFile
{
    my ($path) = @_;
    open(SLURP, $path);
    my $text = '';
    while (<SLURP>) {
	$text .= $_;
    }
    close(SLURP);
    return $text;
}


# limit slurped content to first and last $limit lines of $path
sub slurpLimit
{
    my ($path, $limit) = @_;

    my $out = '';
    if (open(SLURP, $path)) {
        my @head;
        my @tail;
        my $count = 0;
        while (<SLURP>) {
            ++$count;
            if (@head < $limit) {
                push(@head, $_);
            }

            if (@tail == $limit) {
                shift(@tail);
            }

            push(@tail, $_);
        }
        close(SLURP);

        if ($count <= $limit) {
            $out = join('', @head);
        }
        elsif ($count > 2 * $limit) {
            $out = join('', @head, "[trimmed]\n", @tail);
        }
        else {
            my $dup = 2 * $limit - $count;
            for (my $i = 0; $i < $dup; ++$i) {
                shift(@tail);
            }
            $out = join('', @head, @tail);
        }
    }

    return $out;
}


##########################################################################
# run the tool. Calls "init" before running and "cleanup" after running.
##########################################################################
sub run {
    my $self = shift;
    my $arguments=shift || "";


    $self->init();

    #########################################################
    # run the command and catch both stdout and stderr
    #########################################################
    my $command=$self->command();

    my $stdin = '/dev/null';
    if ($self->{STDIN}) {
	$stdin = './stdin';
        unlink($stdin);
	open(XXX, ">$stdin");
	print XXX $self->{STDIN};
	close(XXX);
   }

    my $stdout = './stdout';
    my $stderr = './stderr';
    unlink($stdout, $stderr);

    $self->{STDOUT}='';
    $self->{STDERR}='';

    my $status = system("$command < $stdin 1>$stdout 2>$stderr");

    if (-s $stdout) {
        # if limit has been set, then limit slurp
        if (my $limit = $self->{STDOUT_LIMIT}) {
	    $self->{STDOUT} = slurpLimit($stdout, $limit);
        }
        else {
	    $self->{STDOUT} = slurpFile($stdout);
        }
    }

    if (-s $stderr) {
	$self->{STDERR} = slurpFile($stderr);
    }

    $self->{CORE_DUMPED} = $status & 128;
    $self->{SIGNAL}      = $status & 127;
    $self->{STATUS}      = $status >> 8;

    ############################
    # run the cleanup method
    ############################
    $self->cleanup();

    return $self;
}

##########################################################
# initialize a tool before running.
# This method initialized the "had_error" flag and sets up
# the environment for the tool.
# Sub-classes may override this.
# For example Util::Ftool uses this method to set up the
# parameter file.
##########################################################
sub init {

    my $self=shift;

    ############################
    # initialize the error flag
    ############################
    $self->{HAD_ERROR}=0;
    

    #########################################################
    # set the LD_LIBRARY_PATH environment variable
    # to include all the shared object libraries
    # for this package. Remember the original value
    # so we can restore it after running the tool.
    #########################################################
    $self->{ORIGINAL_LD_LIBRARY_PATH}=$ENV{LD_LIBRARY_PATH};

    my @libs=$self->libs();
    if(@libs) {
        $ENV{LD_LIBRARY_PATH}=join(':', @libs) . ":$ENV{LD_LIBRARY_PATH}";
    }


    ###########################################################
    # now do the same thing with the PATH environment variable
    # sometimes scripts need the path set
    ###########################################################
    $self->{ORIGINAL_PATH}=$ENV{PATH};

    my @bins = $self->bins();
    if(@bins) {
        $ENV{PATH}=join(':', @bins) . ":$ENV{PATH}";
    }

    ##############################################
    # set the parameter file environment variables
    ##############################################
    my %environment=%{$self->environment()};
    $self->{ORIGINAL_ENVIRONMENT}={};
    foreach (keys %environment ) {

        ############################
        # remember the old value
        ############################
        if(defined $ENV{$_}) {
            ${$self->{ORIGINAL_ENVIRONMENT}}{$_} = $ENV{$_};
        }

        ################################
        # set the new value
        ################################
        $ENV{$_} = $environment{$_};
    }

} # end of init method

######################################################
# check for errors and do general cleanup
######################################################
sub cleanup {
    my $self=shift;

    my $log=$self->log();
    
    my $was_error=$self->{STATUS} || $self->{STDERR} ||
                  $self->{CORE}   || $self->{SIGNAL};

    ##############################
    # log the stdout
    ##############################
    if( ($self->{VERBOSE} || ($was_error && $self->{SERIOUSNESS}))  
	&& $self->{STDOUT} && $log) {
      $log->entry("stdout output from $self->{COMMAND}");
      $log->text($self->{STDOUT});
    }

######################################################################
#
# Handling some errors differently than the standard way

    if($self->{COMMAND} eq 'attjumpcorr'){
      if($self->{STATUS} == 0 &&
	 $self->{STDERR} =~ /\s*WARNING\:\s+number\s+of\s+jumps\s+detected\s+in\s+this\s+slew\s+\(\d+\)\s+is\s+greater\s+than\s+the\s+maximum/){
	$self->{SERIOUSNESS} = 1;
      }
    }elsif($self->{COMMAND} eq 'aspect'){
      if($self->{STATUS} == 0 &&
	 $self->{STDERR} =~ /Warning\:\s+Exceeded\s+the\s+maximum\s+number\s+of\s+iterations/){
	$self->{SERIOUSNESS} = 1;
      }
    }elsif($self->{COMMAND} eq 'bateconvert'){
      if($self->{STATUS} == 0 &&
	 $self->{STDERR} =~ /WARNING\:\s+Time\s+separation\s+between\s+data\s+\(MET\=\d+\.*\d*\)\s+and\s+gain\/offset\s+sample/){
	$self->{SERIOUSNESS} = 1;
      }
    }elsif($self->{COMMAND} eq 'uvotimsum'){
      if($self->{STATUS} == 3 &&
	 $self->{STDOUT} =~ /error\:\s+combining\s+FRAMTIMEs\s+not\s+allowed/){
	$self->{SERIOUSNESS} = 1;
      }
    }elsif($self->{COMMAND} eq 'xrt2fits'){
      if($self->{STATUS} == 0 &&
	 $self->{STDOUT} =~ /BACKWARDS\s+TIME\s+JUMP\s+New\s+frame/){
	$self->{SERIOUSNESS} = 1;
      }

    }


    ##########################
    # check for errors
    ##########################
    if($was_error && $self->{SERIOUSNESS}) {
       $self->error();
    }

    ############################
    # dump the error log
    ############################
    if( $self->{STDERR} && $log && $self->{SERIOUSNESS}) {
        $log->entry("stderr output from $self->{COMMAND}");
        $log->text($self->{STDERR});
    }

    #############################################
    # dump stdout to a file if one is specified
    #############################################
    if($self->{STDOUT_FILE}) {
     
        if( $self->{CLOBBER_STDOUT_FILE} ) {unlink $self->{STDOUT_FILE} }
        open  FILE, ">>$self->{STDOUT_FILE}";
        print FILE $self->{STDOUT};
        close FILE;
    }

    
    #######################################
    # reset the environment
    #######################################
    $ENV{PATH}            = $self->{ORIGINAL_PATH};
    $ENV{LD_LIBRARY_PATH} = $self->{ORIGINAL_LD_LIBRARY_PATH};

    foreach (keys %{$self->{ORIGINAL_ENVIRONMENT}} ) {

        $ENV{$_} = ${$self->{ORIGINAL_ENVIRONMENT}}{$_};
    }
        
} # end of cleanup method

###################################################################
# assemble the text of an error message 
# Sub-classes may override this method to give more information
###################################################################
sub error_message {
    my $self=shift;

    my $message="Error from $self->{COMMAND} - exit status $self->{STATUS}";
    return $message;
}


##############################################
# internal error handler
##############################################
sub error {
    my $self=shift;

    #####################################
    # mark the fact that we had an error
    #####################################
    if( $self->{STATUS} || $self->{CORE} || $self->{SIGNAL} ){
      $self->{HAD_ERROR}=2;
    }else{
      $self->{HAD_ERROR}=1;
    }

    ##########################################
    # Don't log the error if seriousness is 0
    ##########################################
    return unless $self->{SERIOUSNESS};

    #################################
    # log the error
    #################################
    my $log=$self->log();
    my $message=$self->error_message();

    if($self->{CORE_DUMPED}) {
        $message .= " Core Dumped.";
#system("gdb $self->{PATH}/$self->{COMMAND} core");
        unlink "core";
    }

    if($self->{SIGNAL}) {
        $message .= " Terminated with signal $self->{SIGNAL}";
        if(defined $SIG_NAME[$self->{SIGNAL}] ) {
            $message .= "($SIG_NAME[$self->{SIGNAL}])";
        }
        $message .= ".";
    }

 
    if($log) {
        ############################################
        # log is defined so use it to give an error
        ############################################
        $log->error($self->{SERIOUSNESS},$message);

        $log->entry("Command: ".$self->command());


    } else {
        ###################################
        # we don't have the log yet, so just
        # write to stderr and quit
        ####################################
        print STDERR "Error$self->{SERIOUSNESS}: $message\n";
        exit $self->{STATUS};
    }

}

sub DESTROY {
    my $self=shift;

    ###################################
    # delete files that capture output
    ###################################
    unlink ('stdout', 'stderr');
}


1;