Util::Tool (version 1.4)


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: 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: 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 true 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:
######################


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

    unless($self->{STDIN}) {
        ##################################################
        # redirect stdin from /dev/null if we aren't
        # expecting any input. That can sometimes keep
        # a tool from hanging if it decides to prompt
        # for input
        #################################################
        $command .= " < /dev/null";
    }
    my $pid=open3(\*IN,\*OUT,\*ERR,"$command;");

    ###############################################################
    # read the stdout and stderr from the process
    # we have to use this complicated proceedure (which I don't fully
    # understand) in order to avoid the situation where one buffer
    # fills up and stops the process while we are waiting for
    # something to read from the other buffer
    ###############################################################
    my $win = '';
    my $ein = '';
    my $wout='';
    my $eout='';

    vec($win,fileno(OUT),1) = 1;
    vec($ein,fileno(ERR),1) = 1;

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

    my $errline='';
    my $outline='';

    my $in_start=0;
    my $in_length=length($self->{STDIN});

   # if($in_length) {
   #     print "\n$command\n";
   #     print "stdin length=$in_length\n";
   # }

    my $outcount=1;
    my $errcount=1;
    while($outcount || $errcount) {

        #############################################
        # stdin
        #############################################
        if($self->{STDIN} && $in_start <$in_length ) {

            my $sent=syswrite IN, $self->{STDIN}, 
                              $self->{IN_BUFFER_SIZE}, $in_start;
       #     print "done sending stdin sent=$sent\n";

            $in_start += $sent;
       
            if($in_start >= $in_length ) {close IN} 
        }

        ###################################
        # stdout
        ###################################
        if(select($wout=$win, undef, undef, 1.)) {

            $outcount=sysread OUT, $outline, $self->{OUT_BUFFER_SIZE};

            if($outcount == $self->{OUT_BUFFER_SIZE}) {
                ##############################################
                # we filled the buffer, so increase its size
                ##############################################
                $self->{OUT_BUFFER_SIZE} *= 2;
            }
            $self->{STDOUT} .= $outline;

        #    print "outcount=$outcount outbuffer=$self->{OUT_BUFFER_SIZE}\n";
        }

        ###################################
        # stderr
        ###################################
        if(select($eout=$ein, undef, undef, 1.)) {

            $errcount=sysread ERR, $errline, $self->{ERR_BUFFER_SIZE};

            if($errcount == $self->{ERR_BUFFER_SIZE}) {
                ##############################################
                # we filled the buffer, so increase its size
                ##############################################
                $self->{ERR_BUFFER_SIZE} *= 2;
            }

            $self->{STDERR} .= $errline;

#            print "errcount=$errcount errbuffer=$self->{ERR_BUFFER_SIZE}\n";
#if($errcount) { print "$command ERROR:\n"; print $errline; print "\n";}
        }

    } # end of loop reading stdout and stderr


    ########################
    # read the output
    ########################
    close OUT;
    close ERR;

    ####################################################
    # this is to avoid zombies and get the exit status
    ####################################################
    waitpid $pid,0; # avoids zombies
    my $status=$?;
    $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->{STDOUT} && $log) {
        $log->entry("stdout output from $self->{COMMAND}");
        $log->text($self->{STDOUT});
 
    }

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

    }

    ############################
    # dump the error log
    ############################
    if( $self->{STDERR} && $log) {
        $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
    #####################################
    $self->{HAD_ERROR}=1;


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

}



1;