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;
}
#########################################################################
# 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;
}
##########################################################################
# 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) {
$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;