package Util::Filename;
##############################################################################
#
# DESCRIPTION: This is a generic filename generator.
# DESCRIPTION: Files are grouped into types, each type having a specific
# DESCRIPTION: name. This class allows you to refer to files by their type
# DESCRIPTION: and a list of their properties, such as instrument, mode, etc.
# DESCRIPTION: This way you may modify the file names without having to
# DESCRIPTION: modify the processing script in multiple places.
# DESCRIPTION:
# DESCRIPTION: This class also knows some things about the output catalogs
# DESCRIPTION: for the processing script. It knows the file class for
# DESCRIPTION: each file type and catalog, and it also knows a human-readible
# DESCRIPTION: description of each file type.
# DESCRIPTION:
# DESCRIPTION: This class gets most of its information from the file_classes
# DESCRIPTION: list file for the processing script. The constructor reads this
# DESCRIPTION: file and remembers its contents.
# DESCRIPTION:
# DESCRIPTION: This is a mission-independant class.
# DESCRIPTION: It knows about the
# DESCRIPTION: file names of universal things like log files, catalogs, etc.,
# DESCRIPTION: and can read the input catalog and the processing parameter file
# DESCRIPTION: to get more file names.
# DESCRIPTION: Although you can get alot of mileage out of this class,
# DESCRIPTION: nearly all missions need to create a sub-class of this one
# DESCRIPTION: to handle the particular needs of that mission.
#
# HISTORY
# HISTORY: $Log: Filename.pm,v $
# HISTORY: Revision 1.3 2014/02/27 07:01:06 apsop
# HISTORY: VERSION header now shows CVS Revision
# HISTORY:
# HISTORY: Revision 1.2 2006/08/01 20:35:34 apsop
# HISTORY: Add in CVS history indicator.
# HISTORY:
# HISTORY: 1.0 -> 1.1 2000-06-20
# HISTORY: Split off a generic fetch method which is now called by fetch_cal
# HISTORY:
# HISTORY: 1.1 -> 1.2 2000-08-15
# HISTORY: Fetch method now checks if a file name has been specified.
# HISTORY:
# HISTORY: 1.2 -> 1.3 2002-04-23
# HISTORY: Now pad "seqprocnum" to be three digits long
# HISTORY:
# HISTORY: 1.3 -> 1.4 2002-05-14
# HISTORY: Fixed a bug in the "exist" method. Seems this method had never
# HISTORY: been used. Happy birthday to me.
# HISTORY:
# HISTORY: 1.4 -> 1.5 2003-04-28
# HISTORY: Anumber of additions to facilitate a shared repository
# HISTORY:
# HISTORY: 1.5 -> 2.0 2003-04-30
# HISTORY: Substantial modifications to allow selecting files in a directory
# HISTORY: other than the working directory. Now template generation,
# HISTORY: globbing and filtering are in separate methods called by get.
# HISTORY:
# HISTORY: 2.0 -> 2.1 2004-01-22
# HISTORY: Now use a system call to fetch files.
# HISTORY:
# HISTORY: 2005-05-27
# HISTORY: Add capability a file type to have more than one file class
# HISTORY:
#
# VERSION: $Revision: 1.3 $
#
##############################################################################
use Util::NoLog;
use strict;
my $LOG;
########################################################################
# This mostly reads the file_classes list file and stores its contents
# internally.
########################################################################
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $jobpar = shift;
my $procpar = shift;
my $file_classes = shift;
my $self={};
$self->{MISSION} = $jobpar->read("mission");;
$self->{SEQUENCE}= $jobpar->read("sequence");
$self->{VERSION} = sprintf("%03d", $jobpar->read("seqprocnum") );
$self->{JOBPAR} = $jobpar;
$self->{PROCPAR} = $procpar;
$self->{SERIOUSNESS}=2; #error level
$self->{GLOB_DIR}=""; # directory where filename globbing will happen
######################################################
# set the calibration file directory if there is one
######################################################
if($procpar->has("caldir") ) {
$self->{CALDIR}=$procpar->read("caldir");
} else {
$self->{CALDIR}='';
}
######################################
# files included in the input catalog
######################################
$self->{INPUT_FILES}={};
####################################################
# generic filename arguments to the get method
# to be used by the any method
####################################################
$self->{GENERIC_ARGS}= ["*","*","*","*","*"];
#############################
# read the file_classes file
#############################
my $type;
my $tapeclass;
my $trendclass;
my $description;
$self->{CLASS} = {};
$self->{TYPES} = {};
$self->{TYPES}->{all}=();
$self->{DESCRIPTION} = {};
$self->{CATALOGS}=[];
open CLASSES, "<$file_classes";
while(<CLASSES>) {
chomp;
###############################
# skip blanks and a comments
###############################
if(/^\s*$/ || /^\s*#/ ) { next }
###########################################
# parse the line
############################################
my ($type,@classes)=split /\s*\|\s*/;
my $description = pop @classes;
##############################################
# set the catalog list on the first iteration
##############################################
if(! @{$self->{CATALOGS}}) {
########################################################
# set the catalog list from the first line of the file
# or use the default
########################################################
if($type eq "type" ) { @{$self->{CATALOGS}}=@classes }
else { @{$self->{CATALOGS}}=("tapecat","trendcat") }
##################################################
# initialize various lists and things
##################################################
my $cat;
foreach $cat (@{$self->{CATALOGS}}) {
$self->{TYPES}->{$cat}=[];
$self->{CLASS}->{$cat}={};
}
if($type eq "type" ) {next}
} # end if CATALOGS list is undefined
####################################
# set the classes for this type
####################################
push @{$self->{TYPES}->{all} }, ($type);
my $cat;
foreach $cat (@{$self->{CATALOGS}}) {
my $class=shift @classes;
if($class && $class ne "none" ) {
$self->{CLASS}->{$cat}->{$type} = []
unless $self->{CLASS}->{$cat}->{$type};
#############################################
# this file type appears in this catalog
#############################################
push @{$self->{TYPES}->{$cat} }, ($type);
push @{ $self->{CLASS}->{$cat}->{$type} }, ($class);
}
} # end of loop over catalogs
############################################
# store the description for this file type
############################################
$self->{DESCRIPTION}->{$type}=$description;
}
close CLASSES;
#################################################
# Make sure there is only on entry for each type
#################################################
foreach my $cat (@{$self->{CATALOGS}}) {
my @types = @{$self->{TYPES}->{$cat} };
my %temp;
@temp{@types} = (1) x @types;
@{$self->{TYPES}->{$cat} } = keys %temp;
}
bless($self,$class);
return $self;
}
######################
# ACCESSORS:
######################
###############################################
# get or set the log object in the class data
###############################################
sub log {
my $self = shift;
if (@_) { $LOG = shift }
if($LOG) {return $LOG}
else {return Util::NoLog->new() }
}
#############################################################
# get or set the processing parfile object in the class data
#############################################################
sub procpar {
my $self = shift;
if (@_) { $self->{PROCPAR} = shift }
return $self->{PROCPAR};
}
#############################################################
# get or set the job.par parfile object in the class data
#############################################################
sub jobpar {
my $self = shift;
if (@_) { $self->{JOBPAR} = shift }
return $self->{JOBPAR};
}
######################################################################
# get or set the level of errors issued by the methods of this class
######################################################################
sub seriousness {
my $self = shift;
if (@_) { $self->{SERIOUSNESS} = shift }
return $self->{SERIOUSNESS};
}
######################################################################
# returns the mission specifier string
######################################################################
sub mission {
my $self = shift;
return $self->{MISSION};
}
######################################################################
# returns the sequence number identifying the current dataset
######################################################################
sub sequence {
my $self = shift;
return $self->{SEQUENCE};
}
######################################################################
# returns the processing version number for the current processing of the
# current dataset
######################################################################
sub version {
my $self = shift;
return $self->{VERSION};
}
######################################################################
# return an array of the file types for all the output catalogs
######################################################################
sub catalog_types {
my $self=shift;
return @{$self->{CATALOGS}};
}
############################################################################
# Set the directory where filename globbing will occur.
# Note this is reset to an empty string by the get method
############################################################################
sub glob_dir {
my $self = shift;
my $dir = shift;
#################################
# make sure it ends with a slash
#################################
if($dir && $dir !~ m|/$| ) {
$dir .= "/"
}
##########################
# set the member variable
##########################
$self->{GLOB_DIR} = $dir || "";
}
############################################################################
#
############################################################################
sub sequence_specific {
my $self = shift;
return $self->{MISSION} . $self->{SEQUENCE};
}
############################################################################
#
############################################################################
sub version_specific {
my $self = shift;
return $self->sequence_specific() . "_" . $self->{VERSION};
}
#############################################
# read the file types from the input catalog
#############################################
sub set_input_files {
my $self=shift;
#######################################################
# get the name of the input catalog file and make
# sure it's readable - otherwise it's a fatal problem.
#######################################################
my $inputcat=$self->{JOBPAR}->read("inputcat");
unless( -r $inputcat ) {
$self->log()->error(3,"Can't read inputcat $inputcat");
}
my $file;
my $type;
foreach (split /\n/, Util::FITSfile->new($inputcat,1,)
->cols("FILENAME TYPE")
->dump_table() ) {
chomp;
($file,$type)=split;
#####################################################
# don't take the name of the tapecat file from the
# input cat, since that is the tapecat from the
# previous level of processing not for this level
# of processing
#####################################################
if($type eq "tapecat") {next};
#################################################
# append the file to the list of the given type
#################################################
if(!$self->{INPUT_FILES}->{$type}) {$self->{INPUT_FILES}->{$type}=()}
push @{$self->{INPUT_FILES}->{$type}}, ($file);
}
} # end of set_input_files_method
####################
# METHODS:
####################
######################################################################
# returns the human-readable description for a given file type
######################################################################
sub description {
my $self = shift;
my $type=shift;
return $self->{DESCRIPTION}->{$type};
}
######################################################################
# return an array of all the file types for a given output catalog
######################################################################
sub types {
my $self = shift;
my $catalog=shift || "all";
return @{$self->{TYPES}->{$catalog} };
}
######################################################################
# return the class for a given file type as it will appear in a given
# output catalog.
######################################################################
sub class {
my $self=shift;
my $catalog=shift;
my $type=shift;
return $self->{CLASS}->{$catalog}->{$type};
}
#########################################################################
# returns a list if filename templates possible containing wildcards.
#########################################################################
sub glob_template {
my $self=shift;
my $type =shift;
my $inst =shift || "";
my $index=shift || "";
my $mode =shift || "";
########################################
# give the file name of the chosen type
########################################
if( $self->procpar()->has($type) ) {
###################################################
# read the file name from the procpar file
###################################################
return ($self->procpar()->read($type));
} elsif($type eq "joblog" ) {
###########################
# job log
############################
return ($self->version_specific() . "_joblog.html");
} elsif($type eq "errlog" ) {
###########################
# error log
###########################
return ($self->version_specific() . "_errlog.html");
} elsif($type eq "logindex" ) {
###########################
# Job log index
###########################
return ($self->version_specific() . "_index.html");
} elsif($type eq "header" ) {
###########################
# HTML header page
###########################
return ($self->version_specific() . "_hdr_page.html");
} elsif($type eq "fileinfo" ) {
###########################
# HTML file list
###########################
return ($self->version_specific() . "_file_info.html");
} elsif($type eq "inputcat" ) {
###########################
# input file catalog
###########################
return ($self->{JOBPAR}->read("inputcat"));
} elsif($type eq "jobpar" ) {
############################
# Product catalog file
############################
return ($self->version_specific() . "_job.par");
} elsif($type eq "procpar" ) {
############################
# Product catalog file
############################
return ($self->version_specific() . "_process.par");
} elsif($type eq "tapecat" ) {
############################
# Product catalog file
############################
return ($self->sequence_specific() . "_tape.cat");
} elsif($type eq "trendcat" ) {
############################
# Product catalog file
############################
return ($self->sequence_specific() . "_trend.cat");
} elsif($type eq "checksum" ) {
######################################
# site independant FITS checksum list
######################################
return $self->version_specific() . "_check.txt";
} elsif($type eq "eventlog" ) {
######################################
# site independant FITS checksum list
######################################
return $self->version_specific() . "_evt.xml";
} elsif($type eq "orbit") {
##################################
# orbit file
##################################
return $self->fetch_orbit("just gimme the name");
} else {
#########################
# unknown
#########################
$self->error("Unknown file type: $type");
return "";
}
} # end of glob_template method
#########################################################################
# Do filename globbing on a list of files in the current $self->{GLOB_DIR}
# This is called by the get method
#########################################################################
sub glob {
my $self = shift;
my @templates = @_;
my @files = ();
my $template;
foreach $template (@templates) {
push @files, glob("$self->{GLOB_DIR}$template");
unless( @files == 1 && $files[0] eq "$self->{GLOB_DIR}$template" ){
push @files, glob("$self->{GLOB_DIR}$template.gz");
}
}
return (@files);
} # end of glob method
#########################################################################
# takes a reference to a list of filenames, plus a set of file descriptor
# arguments and returns a list of files valid for those descriptors.
# This method always returns the input list. Subclasses may overrirde this.
# This method is used by the "get" method.
#########################################################################
sub filter {
my $self = shift;
my $list = shift;
return (@{$list});
}
#########################################################################
# removes the glob directory path from a file name
#########################################################################
sub remove_path {
my $self = shift;
my $name = shift;
if($name && $self->{GLOB_DIR}) {
$name =~ s|^$self->{GLOB_DIR}||;
}
return $name;
}
#########################################################################
# generate a filename of a given type
#########################################################################
sub get {
my $self=shift;
my @args = @_;
my @templates = $self->glob_template(@_);
#print "templates=@templates\n";
my @files = $self->glob(@templates);
#print "globbed files=@files\n";
my @filtered = $self->filter(\@files, @args);
#print "filtered files=@filtered\n";
###################################
# strip off the directory path and
# reset the glob directory.
###################################
if($self->{GLOB_DIR}) {
my $path = $self->{GLOB_DIR};
foreach (@filtered) {
$_=$self->remove_path($_);
}
########################################################
# set the glob directory back to the working directory
#######################################################
$self->glob_dir();
}
#########################################################
# return an array or a joined list depending on context
#########################################################
return (@filtered) if wantarray;
return join "\n", @filtered if (@filtered && $filtered[0]);
return "";
} # end of get method
########################################################################
# Produce an array of all the files of a given type
########################################################################
sub any {
my $self=shift;
my $type=shift;
if($self->{INPUT_FILES}->{$type}) {
#################################
# this is an input file type
#################################
return @{$self->{INPUT_FILES}->{$type}};
} else {
##########################################
# generate a generic filename
##########################################
my @list = ($self->get($type,@{$self->{GENERIC_ARGS}}));
return (@list);
}
}
##############################################################################
##############################################################################
# Extract the components of a filename and return them in an array
# The components are the arguments to the "get" method which would
# be required to produce this file name.
# This method doesn't know how to parse anything and should
# be overridden by mission specific sub-classes.
##############################################################################
sub parse {
my $self=shift;
my $filename=shift;
my $type=shift;
############################################
# right now the generic method does nothing
############################################
$self->error("Can't parse $type file $filename");
return ();
}
###########################################################################
###########################################################################
# parse a file name and return the file of a different type which would
# have had the same arguments.
###########################################################################
sub corresponding {
my $self=shift;
my $old_type=shift;
my $new_type=shift;
my $old_name=shift;
return $self->get($new_type, $self->parse($old_name, $old_type) );
}
################################################################################
# Copy a named file from a given directory into the working directory.
# If the directory is omitted, it defaults to the calibration file directory.
# Returns true is a file was actually fetched. Returns 0 otherwise, either
# becuase the file already exists in the working directory or because of error.
################################################################################
sub fetch {
my $self=shift;
my $file=shift;
my $dir=shift || $self->{CALDIR};
my $log=$self->log();
########################################
# check that there is a file name given
########################################
unless($file) {
$self->error("No file name given for fetching");
return;
}
##########################################################
# do we already have the file or do we need to go get it?
##########################################################
if( ! -e $file ) {
################################################
# need to copy file from calibration repository
#################################################
if( -e "$dir/$file") {
$log->entry("Fetching $file from $dir");
system("cp $dir/$file .");
return 1;
}else{
$self->error("File $dir/$file does not exist");
}
} else {
########################################
# file already exists
########################################
my $log;
if($log=$self->log()) {
$log->entry("$file is already present in the working directory");
}
}
return 0;
} # end of fetch method
################################################################################
# Fetch a calibration file specified by the arguments which would
# be given to the get method to specify its name. The method returns the
# name of the fetched file.
################################################################################
sub fetch_cal { #(type, arg1, arg2,...)
my $self=shift;
my $log=$self->log();
###################################
# get the name of the actual file
##################################
$self->glob_dir($self->{CALDIR});
my $file=$self->get(@_);
#######################################################
# return an empty string if we didn't get a file name
#######################################################
if(!$file) {return $file}
#####################################
# fetch the file
#####################################
$self->fetch($file);
################################
# return the name of the file
################################
return $file ;
} # end of fetch_cal method
########################################################################
########################################################################
# copy the orbit file into the current working directory and
# return the name of the (local) orbit file.
# If an argument is given which evaluates to true, this method
# will not actually fetch the file, but will just return the name.
# That's so the "get" method can use the same parfile reading
# and parsing code.
########################################################################
sub fetch_orbit {
my $self=shift;
my $justname=shift;
#####################################################
# get the full path to the file in the job.par file
#####################################################
my $path = $self->jobpar()->read("orbit");
my ($file) = $path =~ /\/([^\/]*)$/;
unless( -e $file or $justname ) {
##########################
# file needs to be copied
##########################
my $log = $self->log();
if( -e $path ) {
###################################################
# file exists in the parent directory, so copy it
###################################################
$log->entry("Copying orbit file $path to working directory");
system("cp $path .");
# open IN, "<$path";
# open OUT, ">$file";
# print OUT <IN>;
# close OUT;
# close IN;
} else {
#############################################
# file does not exist in parent directory
#############################################
$log->error(2,"Orbit file $path does not exist");
}
}
return $file;
} # end of fetch_orbit method
########################################################################
########################################################################
# This method takes a list of file names and
# returns a list of all the files which actually exist.
# Note this method does not do any globbing.
########################################################################
sub exist {
my $self=shift;
my @out=();
foreach (@_) {
if( -f) { push @out, ($_) }
}
return (@out);
} # end of exist method
#################################
# internal error handling method
#################################
sub error {
my $self=shift;
my $message=shift;
my $log=$self->log();
if($log) {
############################################
# log is defined so use it to give an error
############################################
$log->error($self->{SERIOUSNESS},$message);
} 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;