package Subs::Sub;
##############################################################################
#
# DESCRIPTION: This class does very little by itself.
# DESCRIPTION: However, it provides an environment convenient for doing a
# DESCRIPTION: discrete stage of processing, which child classes may inherit.
#
# HISTORY
# HISTORY: $Log: Sub.pm,v $
# HISTORY: Revision 1.2 2006/08/01 20:35:34 apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2000-08-11
# HISTORY: Now check for leftover .tmp files in the cleanup method
# HISTORY:
# HISTORY: 1.1 -> 1.2 2001-03-06
# HISTORY: Modified PATH environment variable to work with Linux.
# HISTORY: Added initialization for Xanadu.
# HISTORY:
# HISTORY: 1.2 -> 1.3 2002-03-28
# HISTORY: Added restart capability.
# HISTORY: Also added display argument to Xanadu bin initialization call.
# HISTORY: Xanadu.pm is now a little more sophisticated about checking
# HISTORY: for an Xserver.
# HISTORY:
# HISTORY: 1.3 -> 1.4 2002-04-18
# HISTORY: Put it a check for whether the job.par file exists
# HISTORY:
# HISTORY: 1.4 -> 1.5 2003-04-25
# HISTORY: Added support for generating temp_files and automatically
# HISTORY: cleaning them up at the end.
# HISTORY:
# HISTORY: 1.5 -> 1.6 2003-07-30
# HISTORY: Now looks for file_classes in a script-specific subdirectory
# HISTORY: if it does not find it in the lists directory.
# HISTORY:
# HISTORY: 1.6 -> 1.7 2003-10-10
# HISTORY: put in checks for whether FTOOLS and HEAdas directories exist
# HISTORY:
# HISTORY: 1.7 -> 1.8 2004-01-29
# HISTORY: Fixed a bug in the stopping mechanism
# HISTORY:
# HISTORY: 1.8 -> 1.9 2004-02-04
# HISTORY: fixed more bugs in the stopping/restarting mechanism
# HISTORY:
# HISTORY: 1.9 -> 2.0 2004-04-08
# HISTORY: Now use the HEAdas version of pget/pset
# HISTORY:
# HISTORY: 2.0 -> 2.1 2004-05-20
# HISTORY: Fixed a bug in temp_file which caused an infinite loop if the
# HISTORY: requested temp file already existed.
# HISTORY:
# HISTORY: 2.1 -> 2.2 2004-06-09
# HISTORY: Now allow a proc status of just "stopped", since this occurs when
# HISTORY: the stream daemon advances a sequence to the next processing level.
#
# VERSION: 2.1
#
##############################################################################
use Util::Ftool;
use Util::HEAdas;
use Util::Parfile;
use Util::Log;
use Util::Filename;
use Util::Stool;
use Util::Xanadu;
use Util::FITSfile;
use Util::FileList;
use Util::FITSlist;
use Util::EventFileList;
use Util::Catalog;
use Util::HTMLcatalog;
use Util::Date;
use Util::Extractor;
use Util::CoreTags;
use strict;
##############################
# class data
##############################
my $PROCPAR;
my $JOBPAR;
my $LOG;
my $FILENAME;
my $COMTOP;
my $PROCTOP;
my $SCRIPT;
############################################################################
############################################################################
# This function called when the Sub module is compiled.
# It initializes the class data and sets up the processing environment.
############################################################################
sub BEGIN {
#############################
# for the perl debugger:
#############################
$DB::single = 1;
###########################################################
# set the PATH to a bare minimum. This doesn't matter for
# anything called directly from the perl script, but
# sometimes those things can call other things (e.g. xselect)
#############################################################
$ENV{PATH}="/bin:/usr/bin:/usr/local/bin:/usr/sbin:/usr/openwin/bin";
#############################################################
# confirm that the library path for mission specific
# modules is set to the directory containing the main script
#############################################################
my ($dir)= $0 =~ /^(.*)\/[^\/]*$/;
foreach (@INC) {
if( $_ eq $dir) { $PROCTOP=$_};
}
if(! defined $PROCTOP ) {
print STDERR "Script directory $dir not in library path\n";
print STDERR "Check the \"use\" statements in the main script\n";
exit 3;
}
########################################################
# now get the name of the top directory containing the
# common, mission-independant modules
########################################################
$dir =~ s|/[^/]*/[^/]*$||;
# $dir =~ s/\/[^\/]*\/[^\/]*$//;
$dir .= "/common";
foreach (@INC) {
if( /^$dir/ ) { $COMTOP=$_};
}
if( ! defined $COMTOP ){
print STDERR "Could not find common module directory in library path\n";
print STDERR "Check the \"use\" statements in the main script\n";
exit 3;
}
#######################
# get the script name
#######################
$SCRIPT=$0;
# $SCRIPT =~ s/^.*\///;
$SCRIPT =~ s|^.*/||;
####################################
# make sure the job.par file exists
####################################
unless( -f "job.par" ) {
print STDERR "No job.par file in this directory\n";
exit 3
}
##########################################################
# copy the processing par file into the current directory
# if it is not already here
##########################################################
my $procpar="$SCRIPT.par";
if(! -e $procpar ) {
unless(open IN, "<$PROCTOP/$procpar") {
die "Can't copy $procpar to working directory";
}
open OUT, ">$procpar";
print OUT <IN>;
close IN;
close OUT;
}
#####################################
# set job.par and process.par objects
#####################################
$PROCPAR=Util::Parfile->new($procpar);
$JOBPAR =Util::Parfile->new("job.par");
###############################################################
# now set the default LD_LIBRARY_PATH. Note that we do not
# want to inherit LD_LIBRARY_PATH (or anything else)
# from the environment, since the proc script need to run the
# same way each time regardless of where it is run.
###############################################################
$ENV{LD_LIBRARY_PATH}="";
if($PROCPAR->has("lib_path") ) {
$ENV{LD_LIBRARY_PATH}=$PROCPAR->read("lib_path");
}
########################################
# set the "pget" program name
# for all parfile strutures
########################################
my $ftools=$PROCPAR->read("ftools");
if( ! -d $ftools ) {
print STDERR "Invalid FTOOLS directory $ftools\n";
exit 3;
}
Util::Parfile->ftools($ftools);
# Set up the CALDB environment, if needed.
if ($PROCPAR->has('caldb')) {
my $caldb = $PROCPAR->read('caldb');
if (not -d $caldb) {
print STDERR "Invalid CALDB directory $caldb\n";
exit 3;
}
$ENV{CALDB} = $caldb;
$ENV{CALDBCONFIG} = "$caldb/software/tools/caldb.config";
$ENV{CALDBALIAS} = "$caldb/software/tools/alias_config.fits";
}
########################################################
# set the FTOOLS and STOOLS, and XANADU bin directories
# we need to do this early on, so that LD_LIBRARY_PATH
# will be set for the FTOOLS and pget get will work
# and we can read parfiles
########################################################
Util::Ftool->install_dir($ftools);
Util::Stool->bin($PROCPAR->read("stools") );
Util::Xanadu->bin("$ftools/bin", $PROCPAR->read("display") );
##########################################
# HEAdas software, if needed
##########################################
if($PROCPAR->has("headas") ) {
my $headas = $PROCPAR->read("headas");
if(! -d $headas) {
print STDERR "Invalid HEAdas directory $headas";
exit 3;
}
Util::HEAdas->install_dir($headas);
Util::Parfile->ftools($headas);
}
#######################################
# create a filename generator object
#######################################
my $file_classes="$PROCTOP/lists/file_classes";
if( ! -f $file_classes) {
$file_classes="$PROCTOP/lists/$SCRIPT/file_classes";
}
if( ! -f $file_classes) {
print STDERR "Could not find file_classes file\n";
exit 3;
}
###########################################################################
# determine which filename class to use.
# First it looks for the name of the class in the $::FILENAME
# variable. This way you may explicitly name the filename class to be used
# by putting "BEGIN {$::FILENAME=<module name>}" before any of the
# "use <module>" statements in the main program
#
# If this is not sucessful, we try the module "Util::[SCRIPT]Filename"
# where [SCRIPT] is the uppercased script name.
#
# Finally if this also fails, try "Util::Filename", which is the generic
# filename class.
###########################################################################
my $module;
foreach $module ($::FILENAME || "null",
"Util::".uc($SCRIPT)."Filename",
"Util::Filename") {
$FILENAME=eval {$module->new($JOBPAR, $PROCPAR, $file_classes)};
if(defined $FILENAME) {last}
}
if(! defined $FILENAME ) {
print STDERR "Could not create a filename object\n";
print STDERR "$@\n";
exit 3;
}
######################################
# create the log object
# and tell the other objects about it
######################################
$LOG = Util::Log->new($FILENAME,$JOBPAR);
Util::Parfile->log($LOG);
Util::Tool->log($LOG);
Util::Filename->log($LOG);
#####################################
# read the input file catalog
#####################################
$FILENAME->set_input_files();
################################################
# set the filename object in the Catalog class
################################################
Util::Catalog->filename($FILENAME);
################################
# set up the Date utility class
################################
Util::Date->init_class($PROCPAR->read("refdate"),
$PROCPAR->read("reftime"),
$FILENAME );
################################################
# set the checksum program to be used by the
# FITSfile class to calculate site-independant
# checksums
################################################
Util::FITSfile->checksum_tool( $PROCPAR->read("checksum_tool") );
##########################################
# set the mission for the Extractor class
##########################################
Util::Extractor->mission($JOBPAR->read("mission"));
$LOG->milestone("Processing started");
} # end of BEGIN function
#########################################################################
# The options are read and stored so that child classes may use them.
# Typically the constructor will be invoked with no arguments.
#########################################################################
sub new { # (option1,option2...)
my $proto = shift;
my $class = ref($proto) || $proto;
my $self={};
###################################
# read options
###################################
$self->{OPTIONS}={};
my $arg;
while($arg=shift) {
if($arg =~ /=/ ) {
my ($key,$value)=split /=/, $arg;
$self->{OPTIONS}->{$key}=$value;
} else {
$self->{OPTIONS}->{$arg}="set";
}
}
$self->{TMP_FILES} = [];
bless($self,$class);
return $self;
}
#################################
# ACCESSORS:
#################################
# The log object.
sub log {
my $self = shift;
if (@_) { $LOG = shift }
return $LOG;
}
# Parfile for the processing script.
sub procpar {
my $self = shift;
if (@_) { $PROCPAR = shift }
return $PROCPAR;
}
# Sequence-specific parfile object.
sub jobpar {
my $self = shift;
if (@_) { $JOBPAR = shift }
return $JOBPAR;
}
# filename generator object
sub filename {
my $self = shift;
if (@_) { $FILENAME = shift }
return $FILENAME;
}
# The top level directory for the mission specific code
sub proctop {
my $self = shift;
if (@_) { $PROCTOP = shift }
return $PROCTOP;
}
# The top level directory for the mission independant code
sub comtop {
my $self = shift;
if (@_) { $COMTOP = shift }
return $COMTOP;
}
# Name of the processing script.
sub script {
my $self = shift;
if (@_) { $SCRIPT = shift }
return $SCRIPT;
}
sub option {
my $self=shift;
my $option=shift;
return $self->{OPTIONS}->{$option};
}
##############################################################
# return a unique name for this subroutine
##############################################################
sub name {
my $self = shift;
return ref($self);
}
##################################################################
# METHODS:
##################################################################
##################################################################
# check the proc_command and proc_status job.par parameters
# to see if we need to do anything special like stop or resume
# This method returns true if we should not continue on to run the
# subroutine
##################################################################
sub check_commands {
my $self = shift;
my $jobpar = $self->jobpar();
my $procpar=$self->procpar();
my $log = $self->log();
###############################################
# check the status to see if we are in some
# funny state
###############################################
my $status = $jobpar->read("proc_status");
if($status) {
####################################################
# There is some status.
# Reset the command parameter, since we want to
# ignore all commands given after the status was set.
# Note however, that we do not erase a "killed"
# status, since this means someone is about to
# kill the script by hand, and the "killed" status
# will document that this was done on purpose
# (e.g. for the stream daemon)
####################################################
if($status !~ /^killed/) { $jobpar->set({proc_command=>""}) }
my ($before) = $status =~ /^stopped before (.*)$/;
if($before) {
#####################################
# processing was previously stopped
# make sure the current and previous
# script versions match
#####################################
if($jobpar ->read("procscriptver") ne
$procpar->read("version") ) {
######################
# version mismatch
######################
$log->error(3, "Can't restart, since stopped from version ".
$jobpar->read("procscriptver") );
}
#####################################
# check if this is where we stopped
####################################
if($before eq $self->name() ) {
###############################
# this is where we stopped
# so log the resumption and
# just keep going
###################################
$jobpar->set({proc_status=>""});
$log->entry("Resumed processing at beginning of ".
$self->name());
} else {
####################################################
# this is not the right place to resume processing
# we return a true value to indicate to the run method
# that this subroutine should be skipped
####################################################
return 1;
}
} elsif($status eq "stopped") {
###########################################################
# This happens when the proc script advances frm one
# stage of processing to the next. It means just proceed
# from the beginning
##########################################################
$jobpar->set({proc_status=>""});
} else {
############################
# unknown status
############################
$log->error(1, "Unknown processing status $status");
$jobpar->set({proc_status=>""});
}
} # end if the status was set
###########################################
# check for commands
###########################################
my $command = $jobpar->read("proc_command");
if($command) {
##########################################
# there was a command. Reset the command
# in the parfile no matter what it is
##########################################
$jobpar->set({proc_command=>""});
if( $command eq "stop" ) {
########################################################
# we were commanded to stop at the beginning
# of the next subroutine - so here we are.
# Mark the place where we stopped and exit.
# Oh, and we also make sure the script version
# is recorded so when we restart we can make sure it
# is with the same script
#######################################################
$jobpar->set({proc_status => "stopped before ".$self->name(),
procscriptver => $procpar->read("version") } );
$log->entry("Processing stopped just before ".$self->name() );
$log->milestone("Processing interrupted" );
$log->keep_open();
exit 0;
} else {
##############################################
# don't understand the command
# so log an error and keep going
#############################################
$log->error(1, "unknown command $command");
}
} # end if there was a command
return 0;
} # end of check_commands method
###############################################################################
# Returns the name of a temporary file whose name is based on the given string.
# The file name is guaranteed to be unique. In other words, there will be
# no existing files with the returned name at the time this method is called.
# The object keeps track of the temporary file names and deletes them
# in the cleanup phase.
###############################################################################
sub temp_file {
my $self = shift;
my $tag = shift;
my $tmp;
my $index="";
for($tmp="$tag$index.tmp"; -f $tmp; $index++) {$tmp="$tag$index.tmp"}
push @{$self->{TMP_FILES}}, ($tmp);
return $tmp;
} # end of tmp_files method
###############################################################################
# Do initialization before running the body method.
# Puts a "milestone" entry in the log.
##############################################################################
sub init {
my $self = shift;
####################################################
# mark the beginning of the subroutine in the log
####################################################
my $description=$self->{DESCRIPTION} || "Running ".ref($self);
$self->log()->milestone("$description");
}
##############################################################################
# Do any necessary cleanup after running the body method.
# This method doesn't do much, but it may be
# overridden by sub-classes.
##############################################################################
sub cleanup {
my $self = shift;
#########################################################
# delete any temporary files whose names were generated
# by calls to the temp_file method
#########################################################
foreach (@{$self->{TMP_FILES}}) {
unlink $_;
}
#####################################################
# check for any leftover ".tmp" files and give
# a warning about them to make it easier to track
# down their source
#####################################################
my @files=glob("*.tmp");
if(@files) {
$self->log()->error([ 1, UNKNOWN_FILE ], "Leftover temporary file(s): ".
join(", ", @files) );
}
} # end of cleanup method
#############################################################
# This is the method which does all the work. For this general
# class it does nothing, but it is intended to be overridden
# in sub-classes
#############################################################
sub body {
}
#####################################################################
# This method should be invoked to run the subroutine. It calls
# the init, body, and cleanup methods in that order
#####################################################################
sub run {
my $self=shift;
######################################################
# check the commands and see if we should continue on
######################################################
if($self->check_commands() ) {return}
$self->init();
$self->body();
$self->cleanup();
}
1;