package Util::SW0Filename;
##############################################################################
#
# DESCRIPTION: This class is the mission-specific filename generator for Swift.
#
# HISTORY:
# HISTORY: $Log: SW0Filename.pm,v $
# HISTORY: Revision 1.35 2005/02/08 14:30:52 apsop
# HISTORY: Fix method for detecting grism files.
# HISTORY:
# HISTORY: Revision 1.34 2004/11/30 21:21:29 apsop
# HISTORY: Changes to support test pipeline, which has an st prefix.
# HISTORY:
# HISTORY: Revision 1.33 2004/11/16 14:22:57 apsop
# HISTORY: Added method to return existing/regular files matching specs.
# HISTORY:
# HISTORY: Revision 1.32 2004/10/13 01:40:42 apsop
# HISTORY: Add in filter check to eliminate files with indexes when index==0
# HISTORY:
# HISTORY: Revision 1.31 2004/09/02 00:02:13 apsop
# HISTORY: Bug fix for handling indexed files with non-indexed files.
# HISTORY:
# HISTORY: Revision 1.30 2004/08/27 18:32:00 apsop
# HISTORY: Added methods for converting between UVOT filter codes and names.
# HISTORY:
# HISTORY: Revision 1.29 2004/07/06 20:03:26 apsop
# HISTORY: Keep track of calibration files and delete them at the end.
# HISTORY:
# HISTORY: Revision 1.28 2004/05/27 00:14:46 apsop
# HISTORY: Modified instrument-specific cal file code to accept index=0
# HISTORY:
# HISTORY: Revision 1.27 2004/05/06 19:58:41 dah
# HISTORY: Add version number back into the header comments.
# HISTORY:
# HISTORY: Revision 1.26 2004/04/16 20:20:37 dah
# HISTORY: Begin using embedded history records
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################
use Util::Filename;
use Util::FilenameInfo;
use Util::ShortTermRepository;
@ISA = ("Util::Filename");
use strict;
#########################
# constructor
#########################
sub new {
my $proto=shift;
my $self=$proto->SUPER::new(@_);
$self->{GENERIC_ARGS}=["*","*","*","*","*"];
####################################
# file name extensions
####################################
$self->{INFO} = Util::FilenameInfo->new();
############################################
# BAT shared repository
############################################
if($self->jobpar()->read("use_repository") eq "yes" ) {
my $dir = $self->procpar()->read("repository");
$self->{REPOSITORY} = Util::ShortTermRepository->new($dir, $self);
}
###############################################
# cache of root names for sequence based files
###############################################
$self->{CORRESPONDING_ROOT}={};
$self->{CAL_FILES}=[];
return $self;
}
############################################################################
# Converts a full instrument name into a single character instrument code
############################################################################
sub instrument_code {
my $self = shift;
my $name = shift;
$name = lc($name);
if( $name eq "uvot" ) { return "u"; }
elsif($name eq "xrt" ) { return "x"; }
elsif($name eq "bat" ) { return "b"; }
elsif($name eq "fom") { return "f"; }
elsif($name eq "swift") { return "s"; }
elsif($name eq "proc" ) { return "p"; }
elsif($name eq "all" ) { return "*"; }
else { return $name; }
}
############################################################################
# returns the full name of an instrument in lower case, given its one
# letter code. Returns "swift" for "s" and returns an empty string
# for an unknown instrument code
############################################################################
sub instrument_name {
my $self = shift;
my $inst = shift;
if($inst eq "u") {return "uvot";}
if($inst eq "x") {return "xrt";}
if($inst eq "b") {return "bat";}
if($inst eq "f") {return "fom";}
if($inst eq "s") {return "swift";}
if($inst eq "p") {return "proc";}
if($inst eq "*") {return "all";}
return "";
}
############################################################################
# returns the a list of uinstrument codes from a string which may contain
# globbing wildcards. Things like "*" and "[ux]" are supported.
############################################################################
sub instrument_list {
my $self = shift;
my $template = shift;
if($template eq "*") {
########
# any
########
return ("u", "x", "b", "s", "f", "p");
} elsif( $template =~ /^\[.*\]$/ ) {
###################################
# handle a bracketed list of names
###################################
my @instruments = $template =~ /\[(.)*\]/;
return (@instruments);
} else {
#################
# no wildcards
#################
return ($template);
}
} # end of instrument list method
############################################################################
# returns true if the given type can have its filename constructed genericly
############################################################################
sub isGeneric {
my $self=shift;
my $type=shift;
return $self->{INFO}->is_generic($type);
}
#########################################################################
# generate a filename of a given type
#########################################################################
sub glob_template {
my $self=shift;
my $type =shift || '';
my $inst =shift || 'proc';
my $mode =shift || '';
my $index=shift;
#####################################################
# convert the instrument to a single character code
#####################################################
$inst = $self->instrument_code($inst);
############################################
# initialize an array to hold the templates
############################################
my @list=();
if( $self->isGeneric($type) ) {
#####################################################
# generic file names - this should handle most cases
#####################################################
my @templates;
##########################################
# force index to be at least two digits
##########################################
if( $index && $index =~ /\d+/ && length($index)<2 ) { $index = sprintf('%02d', $index); }
#########################
# default index
#########################
$index = '*' if $self->{'INFO'}->is_repository($type, $inst);
if( ! $index || $index eq '00' ){
$index = '';
}else{
$index = '_' . $index;
}
foreach my $i ($self->instrument_list($inst) ) {
###################################################
# make sure this instrument has files of this type
###################################################
unless($self->{INFO}->is_valid_instrument($type, $i) ) { next; }
#########################
# TDRSS field
#########################
my $tdrss = '';
$tdrss = 'ms' if $self->{INFO}->is_tdrss($type, $i);
my $suffix_noindex = $self->{INFO}->ext($type, $i);
my $gaoff = '';
$gaoff .= 'o[a-f0-9][a-f0-9][a-f0-9][a-f0-9]'
if ($self->{INFO}->is_offset($type, $i) && $mode!~/o[a-f0-9]{4}/);
$gaoff .= 'g[a-f0-9][a-f0-9][a-f0-9][a-f0-9]'
if ($self->{INFO}->is_gain($type, $i) && $mode!~/g[a-f0-9]{4}/);
$suffix_noindex =~ s/(.*)\.(.*)/$1${gaoff}.$2/
if $gaoff;
my $suffix = $suffix_noindex;
$suffix =~ s/(.*)\.(.*)/$1${index}.$2/
if $index;
my $root;
if( $self->{'INFO'}->is_met($type, $i) || $self->{'INFO'}->is_repository($type, $i) ||
$self->{'INFO'}->is_tdrss($type, $i) ){
$root = 's[tw][t0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]';
}else{
$root = $self->sequence_specific();
}
push @list, $root . $tdrss . $i . $mode . $suffix_noindex if $index eq '_*';
push @list, $root . $tdrss . $i . $mode . $suffix;
} # end of loop over instruments
} elsif( $type eq "telemetry" ) {
###################################################
# telemetry mode is packet type and index is APID
# note that these have overlapping meaning
# instrument translates into a range of APIDs
# That's handled in the filter method
###################################################
push @list, ("swift_${mode}_".
"[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]".
"_[0-9a-f][0-9a-f][0-9a-f][0-9a-f]".
"_${index}*.ccsds");
} else {
########################################################
# Check if this is an instrument cal file. Prepend the
# instrument name to the procpar param name
# This code supports parameter names of the type
# <inst>_<name>_<index>
########################################################
my $procpar = $self->procpar();
foreach ($self->instrument_list($inst)) {
my @cal_list;
my $param = $self->instrument_name($_) . '_' . $type;
$param .= "_$index" if(defined $index && $index ne "" && $index ne '*');
push @cal_list, ($procpar->read($param))
if $procpar->has($param);
if(defined $index && $index eq '*') {
open PARFILE, $procpar->name();
foreach (<PARFILE>){
push @cal_list, ( $procpar->read($1)) if /^(($param)_\d+),/;
}
close PARFILE;
}
push @list, @cal_list;
push @{$self->{CAL_FILES}}, @cal_list;
}
####################################
# inherit mission-independant stuff
####################################
@list=($self->SUPER::glob_template($type,$inst,$index,$mode))
unless @list;
}
return @list;
} # end of glob_template method
#########################################################################
#
#########################################################################
sub filter {
my $self = shift;
my $list = shift;
my $type =shift || '';
my $inst =shift || '';
my $mode =shift || '';
my $index=shift;
$inst = $self->instrument_code($inst);
my @files = @{$list};
if( $self->isGeneric($type) ) {
#######################################################
# In order for $index='*' to work as a glob, must test
# for existence of file with no index.
#######################################################
shift @files if( $index && $index eq '*' && @files && ! -f $files[0] );
@files = (grep !/_\d+\./, @files) if (defined $index && ($index =~ /^0+$/));
return @files unless @files;
#####################################
# eliminate any duplicate file names
#####################################
if( @files> 1 ){
my %files;
foreach (@files) { $files{$_}=1; }
@files = keys %files;
}
##############################################################################
# Check for files that got wrongly associated with this type because they have
# the same suffix as the this type.
#########################################################################
foreach my $i ($self->instrument_list($inst) ) {
my $inst_info = $self->{'INFO'}->{$i};
if( $inst_info->{$type}->{'anti'} ){
##########################################################################
# The type has anti-types. Hopefully this is not true very often, so that
# this part of the code is only executed occasionally
##########################################################################
my @bad;
my $ext = $inst_info->{$type}->{'ext'};
foreach my $atype (@{$inst_info->{$type}->{'anti'}}) {
my $aext = $inst_info->{$atype}->{'ext'};
unless( $aext eq $ext ){
my ($qaext, $gaoff) = ($aext, '');
$gaoff .= '(o[a-f0-9]{4})?' if $self->{'INFO'}->is_offset($atype, $i);
$gaoff .= '(g[a-f0-9]{4})?' if $self->{'INFO'}->is_gain($atype, $i);
$qaext =~ s/(.*)\.(.*)/${1}${gaoff}_?\\d*\\.${2}/;
push @bad, grep(/${qaext}$/, @files);
}else{
######################################################################
# If the extensions for the two types are the same, then there must
# be some other distinguishing factor
######################################################################
my $atdrss = $self->{'INFO'}->is_tdrss($atype, $i);
my $tdrss = $self->{'INFO'}->is_tdrss($type, $i);
if( $atdrss && !$tdrss ){
push @bad, grep(/^s[tw]\d+ms/, @files);
}elsif( !$atdrss && $tdrss ){
push @bad, grep(!/^s[tw]\d+ms/, @files);
}
my $gain = $self->{'INFO'}->is_gain($atype, $i);
my $offset = $self->{'INFO'}->is_offset($atype, $i);
if( $gain && !$offset ){
push @bad, grep( (/g[a-f0-9]{4}[_\.]/ && !/o[a-f0-9]{4}g/), @files );
}elsif( $offset && !$gain ){
push @bad, grep(/o[a-f0-9]{4}[_\.]/, @files);
}elsif( $offset && $gain ){
push @bad, grep(/o[a-f0-9]{4}g[a-f0-9]{4}[_\.]/, @files);
}
}
}
####################################
# Remove 'bad' files from the list
###################################
my %bad;
foreach (@bad){ $bad{$_}=1; }
@files = grep !$bad{$_}, @files;
}
}
###########################################
# Special treatment of repository files
###########################################
if( $self->{'INFO'}->is_repository($type, $inst) ) {
my $best_time = 0;
my $best_file;
foreach (@files) {
if( /_([^_]*)\./ && $1>$best_time && $1<$index ){
$best_file = $_;
$best_time = $1;
}
}
return ($best_file);
}
return @files;
} elsif($type eq "telemetry") {
#####################################################
# telemetry files. Instrument gets translated into
# a range in APIDs.
#####################################################
if($inst eq "*") { return @files; }
my @instruments = $self->instrument_list($inst);
my @list=();
foreach (@files) {
##########################################
# get the instrument for the current file
##########################################
my $file = $self->remove_path($_);
my ($i, $dum2, $dum3) = $self->parse($file, $type);
########################################################
# check if the instrument is among the ones we asked for
########################################################
if(grep { $_ eq $i } @instruments ) { push @list, ($_); }
}
return @list;
} else {
########################################################
# for anything else we inherit the superclass behavior
# which does no filtering
########################################################
return ($self->SUPER::filter($list, $type,$inst,$index,$mode));
}
} # end of filter method
#########################################################################
#
#########################################################################
sub fetch_from_repository {
my $self = shift;
my $type = shift;
my @args = @_;
if($self->{REPOSITORY} ) {
######################################
# Truncate time to the nearest second
######################################
$args[2] = sprintf '%f', $args[2];
$args[2] =~ s/\..*$//;
my $file = $self->{REPOSITORY}->fetch($type, @args);
###################################################
# Remove time index from file name
###################################################
my $new_name = $file;
$new_name =~ s/_[^_]*\././;
rename $file, $new_name;
return $new_name;
} else {
$self->log()->entry("Not using shared repository");
return $self->get($type, @args);
}
}
#########################################################################
#
#########################################################################
sub export_to_repository {
my $self = shift;
my $type = shift;
my $inst = shift;
my @files = @_;
my $log = $self->log();
$inst = $self->instrument_code($inst);
@files=$self->get($type, $inst, '*', '*') unless(@files);
$self->{'INFO'}->{$inst}->{$type}->{'repository'} = 1;
if($self->{REPOSITORY}) {
$log->entry("Exporting the following files to the shared repository: ".
join ' ', @files );
#####################################################
# Rename the files so that the index is the time.
#####################################################
my @new_files;
foreach my $file (@files){
my $newname = $file;
######################################
# Truncate time to the nearest second
######################################
my $time = Util::FITSfile->new($file, 1)->keyword('TSTART');
$time =~ s/\..*$//;
unless($time){
$log->error(1, "File $file does not have proper TSTART. Will not put in respository.");
next;
}
$newname =~ s/(.*)\.(.*)/${1}_${time}.${2}/;
rename $file, $newname;
push @new_files, $newname;
}
$self->{REPOSITORY}->export($type, @new_files);
unlink @new_files;
}
}
#########################################################################
# parse the fields in a filename
#########################################################################
sub parse {
my $self=shift;
my $filename=shift;
my $type=shift;
if($self->isGeneric($type) ){
##################################################
# first we have to pull out the instrument code
##################################################
$filename =~ s/^s[tw]t?\d+//;
my $tdrss;
if(substr($filename,0,2) eq 'ms') {
##########################################################
# looks like there is a TDRSS field before the instrument
##########################################################
$filename =~ s/^ms//;
$tdrss = 1;
}
####################################################
# get various parts from the FilenameInfo registry
####################################################
my $inst = substr($filename, 0, 1);
my ($pre_suffix, $post_suffix) = $self->{INFO}->ext($type, $inst) =~ /(\w*)\.(\w+)/;
$pre_suffix .= 'o[a-f0-9]{4}' if $self->{INFO}->is_offset($type, $inst);
$pre_suffix .= 'g[a-f0-9]{4}' if $self->{INFO}->is_gain($type, $inst);
###############################
# now we can parse
###############################
my @parts;
if( $filename =~ /${pre_suffix}_\d+\./ ){
############################
# there is an index field
############################
@parts =
( $filename =~ /^([spbxuf])(.*)${pre_suffix}_(\d+)\.${post_suffix}$/ );
}else{
###########################################
# no index field in the filename -
# so the "phantom index" defaults to 00
############################################
@parts = $filename =~ /([spbxuf])(.*)${pre_suffix}\.${post_suffix}$/;
$parts[2]=0;
}
return (@parts);
} elsif($type eq "telemetry") {
###################################
# telemetry files
###################################
my @fields = split /_/, $filename;
my $mode =$fields[1];
my $apid = $fields[4];
$apid =~ s/\..*$//;
my $inst = $self->instrument_for_apid($apid);
return ($inst, $mode, $apid);
} else {
################################
# unknown type
###############################
$self->SUPER::parse($filename,$type);
}
} # end of parse method
#########################################################################
# returns the one character instrument name for a given APID
#########################################################################
sub instrument_for_apid {
my $self = shift;
my $apid = shift;
if( $apid <= 100 ) { return "s" }
if($apid >= 289 && $apid <= 571 ) { return "b" }
if($apid >= 576 && $apid <= 1151) { return "u" }
if($apid >=1152 && $apid <= 1439) { return "x" }
return "unknown";
} # end of instrument for apid method
sub is_grism {
my ($self, $path, $type) = @_;
my @parts = $self->parse($path, $type);
my $grism = $parts[1] =~ /^g(u|v)$/;
return $grism;
}
sub filter_name_for_code {
my ($self, $code) = @_;
my $codes = $Subs::UvotNames::filterCodes;
my $names = $Subs::UvotNames::filterNames;
for (my $i = 0; $i < @$codes; ++$i) {
if ($codes->[$i] eq $code) {
return $names->[$i];
}
}
return 'UNKNOWN';
}
sub filter_code_for_name {
my ($self, $name) = @_;
my $codes = $Subs::UvotNames::filterCodes;
my $names = $Subs::UvotNames::filterNames;
for (my $i = 0; $i < @$names; ++$i) {
if ($names->[$i] eq $name) {
return $codes->[$i];
}
}
return 'qq';
}
sub getExisting
{
my ($self, @args) = @_;
my @gotten = $self->get(@args);
my @exist;
foreach my $name (@gotten) {
if (-f $name) {
push(@exist, $name);
}
}
return @exist;
}
1;