package Util::ParfileTool;
##############################################################################
#
# DESCRIPTION: This sub-class adds functionality for handling FTOOL-style
# DESCRIPTION: parameter files.
#
# HISTORY
# HISTORY: $Log: ParfileTool.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 2006/09/10 20:10:03 apsop
# HISTORY: Change the default query mode from "h" to "hl".
# HISTORY:
# HISTORY: Revision 1.2 2006/08/01 20:35:34 apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2004-02-11
# HISTORY: Moved the environment setup into Tool.pm
# HISTORY:
# HISTORY: 1.1 -> 1.2 2004-03-09
# HISTORY: Moved the HEADASNOQUERY environment variable here from HEAdas.pm,
# HISTORY: since we are starting to see PseudoFtools based on the HEAdas
# HISTORY: libraries instead of the FTOOLS ones.
#
# VERSION: $Revision: 1.4 $
#
##############################################################################
use Util::Tool;
@ISA=("Util::Tool");
use strict;
use Util::Parfile;
##########################################################################
# This constructor should be called by subclass constructors after
# sufficient initialization has been done so that the
# bins and syspfiles methods methods will work
##########################################################################
sub new {
my $self = shift;
my $tool = shift;
my $syspfiles = shift;
my $bin_ref = shift;
my $lib_ref = shift;
my @bins=@$bin_ref;
my @libs=@$lib_ref;
####################################################
# find the executable in one of the bin directories
####################################################
my $bin="";
foreach (@bins) {
if( -x "$_/$tool" ) {
###############
# found it
##############
$bin=$_;
last;
}
}
unless($bin) {
#############################
# unknown tool
#############################
my $log = $self->log();
if($log) { $log->error(2,"Unknown tool $tool"); }
else { print STDERR "Unknown tool $tool\n"; }
return $self;
}
########################################
# inherit the generic Tool constructor
########################################
$self=$self->SUPER::new($bin,$tool);
##############################
# remember directories
##############################
$self->{BINS}=$bin_ref;
if($lib_ref) { $self->{LIBS}=$lib_ref }
else { $self->{LIBS}=[] }
$self->{SYSPFILES}=$syspfiles;
#############################################
# copy the parfile to the current directory
#############################################
my $parfile="$tool.par";
if(open IN, "<$syspfiles/$parfile") {
open OUT, ">$parfile";
print OUT <IN>;
close OUT;
close IN;
}
#########################################################
# create the parfile object
# and set the default query mode to "hl"
# so FTOOLS won't hang if we forget to set a parameter
#########################################################
$self->{PARFILE} = Util::Parfile->new("$parfile");
$self->{PARFILE}->set({mode=>"hl"});
##########################################################
# flag to distinguish scripts from compiled tools
# scripts have different environment requirements
##########################################################
$self->{IS_SCRIPT} = 0;
return $self;
}
######################
# ACCESSORS:
######################
#########################################################################
# return the directory containing the "system" parfiles
#########################################################################
sub syspfiles {
my $self=shift;
return $self->{SYSPFILES};
}
#########################################################################
# 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;
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;
return @{$self->{BINS}};
}
########################################################################
# Returns a hash of environment variables which must
# be set before running this tool
########################################################################
sub environment {
my $self=shift;
return {PFILES =>".;".$self->syspfiles(),
PFCLOBBER =>1 ,
HEADASNOQUERY=>"yes"
};
} # end of environment method
#########################################################################
# set the flag indicating whether this is a script
#########################################################################
sub is_script {
my $self=shift;
$self->{IS_SCRIPT} = shift;
return $self;
}
#################################################################
# get or set the Util::Parfile object for the parameter file.
# This can be used to read values which the program wrote to the
# parfile. Note the parfile is deleted when this object is destroyed
# so you may need to explicitly call DESTROY() so that it will
# stick around long enough to be read.
#################################################################
sub parfile {
my $self=shift;
if (@_) { $self->{PARFILE} = shift }
return $self->{PARFILE};
}
#################################################################
# set the FTOOL input parameters. Note the parameters
# are given as a reference to a hash.
#################################################################
sub params { #({name1=>value1, name2=>value2});
my $self=shift;
my $params=shift;
if(!$self->{PARAMS}) {
#####################################################
# no params defined before, so just take the new set
#####################################################
$self->{PARAMS} = $params;
} else {
##################################################
# merge the new parameters list with the old one
##################################################
my $key;
foreach $key (keys(%$params)) {
$self->{PARAMS}->{$key} = $params->{$key};
}
}
return $self;
}
#############################################################################
# find a file in one of the bin directories
#############################################################################
sub find_bin {
my $self=shift;
my $file=shift;
foreach ($self->bins()) {
if( -f "$_/$file" ) { return $_ }
}
return "";
}
#####################################################
# Special initialization - set the parameters
# in the parfile
#####################################################
sub init {
my $self=shift;
############################
# do the inherited init
############################
$self->SUPER::init();
###################################################
# set the parameters
# Then empty the parfile values stored in memory
# we have to do this because running the tool may
# modify the parameters in an unpredictable way
# which does not use a Parfile object
###################################################
$self->{PARFILE}->set($self->{PARAMS});
$self->{PARFILE}->clear_param_cache();
###################################################
# If this is a script, remember the parfiles
# in the working directory. Scripts can
# leave parfiles behind which we would like to delete
# without touching the already existing parfiles
######################################################
if($self->{IS_SCRIPT}) {
$self->{PRE_EXISTING_PARFILES} = {map { $_ => 1 } glob("*.par")};
}
} # end of init method
###############################################################################
#
###############################################################################
sub cleanup {
my $self = shift;
if($self->{IS_SCRIPT} && $self->{PRE_EXISTING_PARFILES} ) {
########################################################
# delete all the parfiles created by running the script
########################################################
foreach (glob("*.par") ) {
####################################################
# ski pthe parfiles which were already here before
# we ran the script
####################################################
if($self->{PRE_EXISTING_PARFILES}->{$_}) { next; }
unlink;
} # end of loop over parfiles
} # end if this is a script
###################################
# now inherit generic tool stuff
###################################
$self->SUPER::cleanup();
} # end of cleanup method
######################################################
# override the generic tool error routine
# to also dump the parfile to the log if it exists
######################################################
sub error {
my $self=shift;
###########################
# do all the generic stuff
###########################
$self->SUPER::error();
#############################
# dump the parfile
#############################
my $log=$self->log();
my $parfile=$self->{PARFILE}->{NAME};
if($log) {
$log->entry("Contents of $parfile");
$log->file($parfile);
}
} # end of error method
####################################
# destructor - deletes the parfile.
####################################
sub DESTROY {
my $self=shift;
##############################
# delete the parfile
##############################
unlink "$self->{PARFILE}->{NAME}";
# check for an overridden destructor...
$self->SUPER::DESTROY if $self->can("SUPER::DESTROY");
}
1;