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;