Subs::Sub (version 2.1)


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;