package Util::SW0Filename;
##############################################################################
#
# DESCRIPTION: This class is the mission-specific filename generator for Swift.
#
# HISTORY:
# HISTORY: $Log: SW0Filename.pm,v $
# HISTORY: Revision 1.50 2016/07/21 14:20:09 apsop
# HISTORY: Updates for 3.17.05. CALDB patches for XRT 20160609 and clock v114. xrtwtcorr v0.2.2. Fix issue retrieving BAT scaled map.
# HISTORY:
# HISTORY: Revision 1.49 2014/08/15 09:41:45 apsop
# HISTORY: New functions filter_id_for_code and filter_code_for_id.
# HISTORY:
# HISTORY: Revision 1.48 2013/07/16 07:29:26 apsop
# HISTORY: New sub getNonGrismSkyImages.
# HISTORY:
# HISTORY: Revision 1.47 2007/07/25 20:16:09 apsop
# HISTORY: Write REPROC keyword if needed.
# HISTORY:
# HISTORY: Revision 1.46 2007/06/28 20:31:08 apsop
# HISTORY: Changes to shared repository to support files indexed by target number.
# HISTORY:
# HISTORY: Revision 1.45 2007/04/01 19:14:49 apsop
# HISTORY: Add version keyowrds to shared repository files before they are stored.
# HISTORY:
# HISTORY: Revision 1.44 2006/05/02 13:16:02 apsop
# HISTORY: Fix response to no repos file in fetch_from_repository.
# HISTORY:
# HISTORY: Revision 1.43 2006/04/03 16:02:46 apsop
# HISTORY: Fix bug in appending time index to repository file names.
# HISTORY:
# HISTORY: Revision 1.42 2006/02/07 16:39:24 apsop
# HISTORY: Allow for the parsing of gzipped files.
# HISTORY:
# HISTORY: Revision 1.41 2006/01/20 19:44:09 apsop
# HISTORY: Replace "met" flag with more descriptive "not_seqid" flag; Fix up repository file renaming.
# HISTORY:
# HISTORY: Revision 1.40 2006/01/18 16:39:27 apsop
# HISTORY: Add error message if no repository file found.
# HISTORY:
# HISTORY: Revision 1.39 2005/09/26 20:42:14 apsop
# HISTORY: Only sort repository files if there is more than one. Allows use of nonindexed repository files.
# HISTORY:
# HISTORY: Revision 1.38 2005/07/15 16:15:32 apsop
# HISTORY: Bug fix for previous commit.
# HISTORY:
# HISTORY: Revision 1.37 2005/07/15 15:44:11 apsop
# HISTORY: Fix file globbing so that it only matches numeric indexes in the file names.
# HISTORY:
# HISTORY: Revision 1.36 2005/06/01 13:35:47 apsop
# HISTORY: Fix bugs in exporting of repository files.
# HISTORY:
# 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: $Revision: 1.50 $
#
#
##############################################################################
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) eq 'TIME';
$index = '*[0-9][0-9]' if ($index && $index eq '*');
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'}->not_seqid($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 '_*[0-9][0-9]';
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) && @files > 1) {
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 = @_;
my $log = $self->log();
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);
# $log->entry("File name returned from repository is $file .");
unless($file && -f $file){
if (not $self->{MISSING_REPO_OK}) {
$log->error(2, "No file returned from repository, type $type, index $args[2]");
}
return () unless -f $file;
return $file;
}
###################################################
# Remove time index from file name
###################################################
my $new_name = $file;
$new_name =~ s/_[^_.]*\././;
rename $file, $new_name;
return ($new_name) if wantarray();
return $new_name;
} else {
$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();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
$inst = $self->instrument_code($inst);
my $repos_type = $self->{'INFO'}->{$inst}->{$type}->{'repository'};
delete $self->{'INFO'}->{$inst}->{$type}->{'repository'};
@files=$self->get($type, $inst, '*', '*') unless(@files);
$self->{'INFO'}->{$inst}->{$type}->{'repository'} = $repos_type;
if( $self->{REPOSITORY} && @files && $files[0] ) {
$log->entry("Exporting the following files to the shared repository: ".
join ' ', @files );
my $soft_version = $jobpar->read('softver');
my $cal_version = $jobpar->read('caldbver');
my $proc_version = $procpar->read('version');
my $seq_num = int($jobpar->read('seqprocnum'));
my $reprocess = $jobpar->read('reprocess');
############################################
# Rename the files to have the proper index
############################################
my @new_files;
foreach my $file (@files){
my $newname = $file;
my $fitsfile = Util::FITSfile->new($file, 0);
$fitsfile->begin_many_keywords();
$fitsfile->keyword('SOFTVER', $soft_version, 'HEASOFT and Swift versions');
$fitsfile->keyword('CALDBVER', $cal_version, 'CALDB index versions used');
$fitsfile->keyword('PROCVER', $proc_version, 'Processing script version' );
$fitsfile->keyword('SEQPNUM', $seq_num, 'Number of times the dataset processed' );
$fitsfile->keyword('REPROC', 'T', 'Is this from a bulk reprocessing run?') if $reprocess eq 'yes';
$fitsfile->end_many_keywords();
my $index;
if($repos_type eq 'OBSID'){
#########################
# Index by target number
#########################
$fitsfile->ext(0);
my $obsid = $fitsfile->keyword('OBS_ID');
require Util::BATCave;
$index = Util::BATCave::get_bscalemap_index($log, $obsid);
}elsif($repos_type eq 'TIME'){
###############################
# Index by time.
###############################
$fitsfile->ext(1);
$index = $fitsfile->keyword('TSTART');
######################################
# Truncate time to the nearest second
######################################
$index =~ s/\..*$//;
unless($index){
$log->error(1, "File $file does not have proper TSTART. Will not put in respository.");
next;
}
}else{
$log->error(2, "Repository type $repos_type not recognized.");
}
$newname =~ s/^([^\.]+)\.(.*)$/${1}_${index}.${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
#########################################################################
# Parse the path to see if this is a grism image
#########################################################################
sub is_grism {
my ($self, $path, $type) = @_;
my @parts = $self->parse($path, $type);
my $grism = $parts[1] =~ /^g(u|v)$/;
return $grism;
}
#########################################################################
# Return names of the sky image files, but not including the grism ones.
#########################################################################
sub getNonGrismSkyImages {
my ($self) = @_;
my @skyFiles = $self->get('filterimg', 'uvot', '*', '*');
my @nonGrism;
foreach my $skyFile (@skyFiles) {
next if $self->is_grism($skyFile, 'skyimage');
push(@nonGrism, $skyFile);
}
return @nonGrism;
}
############################################
# Convert between filter code and name or id
# as defined in UvotNames.pm
############################################
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 filter_id_for_code {
my ($self, $code) = @_;
my $codes = $Subs::UvotNames::filterCodes;
my $ids = $Subs::UvotNames::filterIDs;
for (my $i = 0; $i < @$codes; ++$i) {
if ($codes->[$i] eq $code) {
return $ids->[$i];
}
}
return 'UNKNOWN';
}
sub filter_code_for_id {
my ($self, $id) = @_;
my $codes = $Subs::UvotNames::filterCodes;
my $ids = $Subs::UvotNames::filterIDs;
for (my $i = 0; $i < @$ids; ++$i) {
if ($ids->[$i] eq $id) {
return $codes->[$i];
}
}
return 'qq';
}
######################################################
# Generate file names and only return those that exist
######################################################
sub getExisting
{
my ($self, @args) = @_;
my @gotten = $self->get(@args);
my @exist;
foreach my $name (@gotten) {
if (-f $name) {
push(@exist, $name);
}
}
return @exist;
}
#########################################################################
# add standard keywords to the headers of passed FITS files.
# The first parameter must be a Subs::Sub.
# Optionally, a hash reference of options can be passed as the second
# parameter.
#########################################################################
sub write_standard_keywords {
my $self = shift;
my $log = $self->log();
my $filename = $self->filename();
my $jobpar = $self->jobpar();
my $procpar = $self->procpar();
my %arg;
if (ref($_[0]) eq 'HASH') {
my $href = shift;
%arg = %$href;
}
my @file = @_;
#######################
# Setup for UTCF value
#######################
my $time_file = $filename->get('timedata', 'swift', '', 0);
my (@utcf_times, @utcf);
if( -f $time_file ){
my $time_fits = Util::FITSfile->new($time_file, 'UTCF');
@utcf_times = $time_fits->cols('TIME')->table();
@utcf = $time_fits->cols('UTCF')->table();
}
my $soft_version = $jobpar->read('softver');
my $cal_version = $jobpar->read('caldbver');
my $reprocess = $jobpar->read('reprocess');
############################
# Trigger time, if relevant
############################
my $trigtime = $jobpar->read('burst_time');
########################################################
# Predetermine ATTFLAG for UVOT ($uattflag) and non-UVOT ($oattflag) files
# - ATTFLAG has 3 digits: (0|1)xx=sat not used|used,
# x(0|1)x=pat not used|used (jump correction applied),
# xx(0|1)=uat not used|used (aspect correction applied)
# - Only used for BAT, UVOT, XRT, and some XRT TDRSS files
# - uat file (aspect corrected) is only used for UVOT files.
# - pat (jump corrected) or sat could have been used for any of them.
# - uat file would only have beeen USED during FINAL processing,
# (although UvotImages will usually create one anyway so just
# checking for its existence as we did originally is often wrong).
# - Else the pat file was used if it existed.
# - If not then the sat file.
# - uat could have been created from sat even if no pat (101)
# This will be added to any HDUs in this file that don't already
# have ATTFLAG, and compared to any that do.
# Note this assumes this actually is how attitude was calculated.
# Also, that if an attfile exists it was used (with the caveat above
# about uat only being used in FINAL).
########################################################
my $oattflag = '';
my $uattflag = '';
{
my $sat = (-e $filename->get('attitude', 's') ) ? '1' : '0';
my $pat = (-e $filename->get('attcorr', 'p') ) ? '1' : '0';
my $uat = ($jobpar->{TIMELIST}{final} and (-e $filename->get('attcorr', 'u'))) ? '1' : '0';
$oattflag = join('', $sat, $pat, '0');
$uattflag = join('', $sat, $pat, $uat);
}
# @attflag_msgs collects all messages about ATTFLAG
# so we can mail them all at once.
my @attflag_msgs;
####################################
# loop over all FITS files
####################################
my $file;
foreach $file (@file) {
$log->entry("Adding standard keywords to $file");
my $fits = Util::FITSfile->new($file);
my $is_tdrss = $file =~ /s[wt][t\d]\d{10}ms/;
my $is_batevt = $file =~ /s[wt][t\d]\d{10}bev/;
my $is_eng = $file =~ /s[wt][t\d]\d{10}.*en\.hk$/;
my $is_att = $file =~ /s[wt][t\d]\d{10}.at\.fits$/;
my $is_sm = $file =~ /s[wt][t\d]\d{10}bsmcb\.fits$/;
my $is_bat = $file =~ /s[wt][t\d]\d{10}b/;
my $is_uvot = $file =~ /s[wt][t\d]\d{10}u/;
my $is_xrt = $file =~ /s[wt][t\d]\d{10}x/;
##################################
# loop over HDUs in the FITS file
##################################
my $nhdus = $fits->nhdus();
unless ($nhdus) {
$log->error(2, "Cannot get number of HDUs for FITS file $file.");
next;
}
my $hdu;
for ( $hdu=0; $hdu<$nhdus; $hdu++ ) {
$fits->ext($hdu);
my $extname = $hdu==0 ? '' : $fits->keyword('EXTNAME');
################################
# write keywords to the file
################################
$fits->begin_many_keywords();
$fits->keyword('PROCVER', $procpar->read('version'),
'Processing script version' );
unless( $is_eng || ($extname && $extname=~/GTI/) ){
# NB: $soft_version is now so long that there isn't enough
# room left (~4 chars!) for a useful comment string.
$fits->keyword('SOFTVER', $soft_version);
$fits->keyword('CALDBVER', $cal_version,
'CALDB index versions used');
}
if($hdu==0){
$fits->keyword('TIMESYS', 'TT', 'time system');
$fits->keyword('MJDREFI', 51910, 'MJD reference day 01 Jan 2001 00:00:00');
$fits->keyword('MJDREFF', 7.428703700000000E-04,
'MJD reference (fraction of day) 01 Jan 2001 00:00:00');
$fits->keyword('CLOCKAPP', 'F', 'If clock correction are applied (F/T)');
$fits->keyword('TIMEUNIT', 's', 'Time unit for timing header keywords');
$fits->keyword('REPROC', 'T', 'Is this from a bulk reprocessing run?') if $reprocess eq 'yes';
}else{
$fits->keyword('TIERRELA', '1.0E-8', '[s/s] relative errors expressed as rate');
$fits->keyword('TIERABSO', '1.0', '[s] timing precision in seconds');
}
unless($is_tdrss || $is_sm){
# sprintf('%011d', $sequence) messed up on large sequence numbers (for perl using 32 bit integers)
my $sequence = $jobpar->read('sequence');
if (length($sequence) < 11) {
$sequence = '0' x (11 - length($sequence)) . $sequence;
}
my $seqtarg = substr($sequence, 0, 8);
my $seqseg = substr($sequence, 8, 3);
$fits->keyword('OBS_ID', "'$seqtarg$seqseg'",
'Observation ID' );
$fits->keyword('SEQPNUM', int($jobpar->read('seqprocnum')),
'Number of times the dataset processed' );
$fits->keyword('TARG_ID', int(sprintf("%d",$jobpar->read('target'))),
'Target ID');
$fits->keyword('SEG_NUM', int(sprintf("%d",$jobpar->read('obs'))),
'Segment number');
$fits->keyword('OBJECT', $jobpar->read('object'), 'Object name');
$fits->keyword('RA_OBJ', $jobpar->read('burst_ra'), '[deg] R.A. Object');
$fits->keyword('DEC_OBJ', $jobpar->read('burst_dec'), '[deg] Dec Object');
$fits->keyword('RA_PNT', $jobpar->read('ra'), '[deg] RA pointing');
$fits->keyword('DEC_PNT', $jobpar->read('dec'), '[deg] Dec pointing');
$fits->keyword('PA_PNT', $jobpar->read('roll'), '[deg] Position angle (roll)');
$fits->keyword('TRIGTIME', $trigtime, '[s] MET TRIGger Time for Automatic Target')
if $trigtime;
}
if($is_batevt){
$fits->keyword('CATSRC',
$jobpar->read('burst_cat_src') eq 'yes' ? 'T' : 'F');
}
if ( $is_att ) {
# attitude files sat, pat, uat: remove these keywords
# 2016-11-03 do not remove UTCFINIT which is now added to sw<>sat.fits
# and propagated from there to pat/uat
$fits->keyword('-ATTSTATU', ' ');
}
else {
# Optionally set ATTFLAG. This allows the same routine to be used
# by SW0WrapUp, XrtGrbLc and UvotProduct.
if ($arg{ATTFLAG}) {
###########################################################
# Set ATTFLAG if it wasn't already. Only do this for bat,
# uvot, and xrt files (all HDUs).
#
# If find one already in this HDU, leave as is but log it;
# complain if doesn't match what we expect for this file.
# If find one in another file type, also complain.
###########################################################
my $existattflag = $fits->keyword('ATTFLAG');
my $fhdu = "${file}[${hdu}" .
(defined($extname) ? " ${extname}" : "") . "]";
my $attflag = $is_uvot ? $uattflag : $oattflag;
if ( $is_bat || $is_uvot || $is_xrt ) {
if ( defined($existattflag) ) {
# Leave any existing ATTFLAG as it is, but complain
# if it disagrees with what we expect.
if ($existattflag ne $attflag) {
my $msg = "Expected ATTFLAG=${attflag}, found ${existattflag}, in $fhdu";
$log->error(1,$msg);
push @attflag_msgs, $msg;
} else {
## my $msg = "Found ATTFLAG=${existattflag} in $fhdu";
## $log->entry($msg);
## push @attflag_msgs, $msg;
}
} else {
# No existing ATTFLAG, so write the expected value.
# Note: comment gets truncated after 47 chars.
# Frank wanted this comment string.
$fits->keyword('ATTFLAG', "'$attflag'",
'Attitude file: 100=sat, x10=pat, xx1=uat');
## my $msg = "Set ATTFLAG=$attflag in $fhdu";
## $log->entry($msg);
## push @attflag_msgs, $msg;
}
} elsif ( ( ($file =~ /msxim_rw|msxpc_uf/)
&& ($extname eq 'ATTITUDE') )
|| ( ($file =~ /msxim_sk/)
&& ($extname =~ /^ATTITUDE|^LNG|^SHT/) )
|| ( ($file =~ /msxpc_cl/)
&& ($extname =~ /^ATTITUDE|^EVENTS/) )
) {
# There are a few non-instrument files/HDUs where we
# expect an ATTFLAG that was set earlier, so gripe if
# one's NOT there. *msx* = xrt tdrss messages, see
# XRT2FITS.pm and xrttdrss2 (XrtTdrss.pm).
if (! defined($existattflag)) {
my $msg = "Did not find an ATTFLAG in $fhdu";
$log->error(1,$msg); # should this be an entry?
push @attflag_msgs, $msg;
}
} elsif ( defined($existattflag) ) {
# Not a file/hdu where we wanted or expected an
# ATTFLAG, but we found one anyway!
my $msg = "Found ATTFLAG=${existattflag} in unexpected place $fhdu";
$log->error(1,$msg);
push @attflag_msgs, $msg;
}
}
#############################
# Determine and set UTCFINIT
#############################
my $tstart = $fits->keyword('TSTART');
unless( $tstart ){
my $date = $fits->keyword('DATE-OBS');
if( $date ){
my $start = Util::Date->new($date);
$tstart = $start->seconds();
}
}
if( $tstart && @utcf ){
my $itime = 0;
while( $tstart > $utcf_times[$itime] &&
$itime < $#utcf_times){ $itime++ }
$fits->keyword('UTCFINIT', $utcf[$itime], '[s] UTCF at TSTART');
}
}
$fits->end_many_keywords();
}
}
#####################################
# Mail any ATTFLAG errors to watchers
#####################################
if (@attflag_msgs > 0) {
my $seqnum = $jobpar->read('sequence') . '.'
. $jobpar->read('seqprocnum');
my $text = "Sequence $seqnum had the following ATTFLAG messages in write_standard_keywords:\n\n"
. join("\n", @attflag_msgs);
Util::Email::sendEmail( TO => $procpar->read('watchers'),
SUB => $self,
SUBJECT => "ATTFLAG messages in $seqnum",
TEXT => $text );
}
} # end of write_standard_keywords method
1;