package Subs::SortTdrss;
##############################################################################
#
# DESCRIPTION:
#
# HISTORY:
# HISTORY: $Log: SortTdrss.pm,v $
# HISTORY: Revision 1.36 2016/08/02 17:11:45 apsop
# HISTORY: Fix calculation of BAT GTIs for low significance triggers using scaled map
# HISTORY:
# HISTORY: Revision 1.35 2015/10/22 18:16:52 apsop
# HISTORY: Do not use TRIGTIME when determining TSTART/DATE-OBS for mssdi.fits.
# HISTORY:
# HISTORY: Revision 1.34 2007/03/16 17:53:30 apsop
# HISTORY: Test trigtime to see if it is in the future, and reject if true.
# HISTORY:
# HISTORY: Revision 1.33 2007/03/15 21:30:50 apsop
# HISTORY: Only write the database file once.
# HISTORY:
# HISTORY: Revision 1.32 2006/12/07 14:34:08 apsop
# HISTORY: Fix bug in previous change when trigger time in seconds is not defined.
# HISTORY:
# HISTORY: Revision 1.31 2006/12/06 19:05:16 apsop
# HISTORY: Donnot use trigger time with values before the launch when determining date-obs of mspob files.
# HISTORY:
# HISTORY: Revision 1.30 2006/09/10 19:54:26 apsop
# HISTORY: Fix bug in handling of bursts observations with nonzero segment number.
# HISTORY:
# HISTORY: Revision 1.29 2006/06/15 22:18:53 apsop
# HISTORY: When setting obs date for diag file, consider times before launch as bad.
# HISTORY:
# HISTORY: Revision 1.28 2006/05/11 17:23:53 apsop
# HISTORY: Test for 99? using sequence number, not obs seg number
# HISTORY:
# HISTORY: Revision 1.27 2006/04/27 15:59:19 apsop
# HISTORY: Handle the unusual case where the higher-level tdrss products are produced in non-AT observations. More code to try and get a decent observation dates into the tdrss products.
# HISTORY:
# HISTORY: Revision 1.26 2006/04/14 18:41:43 apsop
# HISTORY: More heroics for determining DATE-OBS in tdrss data.
# HISTORY:
# HISTORY: Revision 1.25 2005/12/19 16:21:46 apsop
# HISTORY: Use sequence param instead of target and obs when testing for current sequence in tdrss data. Add OBJECT and DATE-OBS keywords to primary headers of tdrss files.
# HISTORY:
# HISTORY: Revision 1.24 2005/11/17 16:56:49 apsop
# HISTORY: Use PKT1TIME from xrt images if PKTTIME not available.
# HISTORY:
# HISTORY: Revision 1.23 2005/11/08 19:02:34 apsop
# HISTORY: Fix bug which was causing xrt positions not to be used in db. Change for new xrt tdrss image file names.
# HISTORY:
# HISTORY: Revision 1.22 2005/10/04 15:38:24 apsop
# HISTORY: Deal with case where diagnostic file has a tstart of zero, based on extension trigger times.
# HISTORY:
# HISTORY: Revision 1.21 2005/09/28 17:32:57 apsop
# HISTORY: Add log entry when deleting tdrss messages.
# HISTORY:
# HISTORY: Revision 1.20 2005/08/02 22:05:23 apsop
# HISTORY: Special handling of tdrss messages for 990+ segments.
# HISTORY:
# HISTORY: Revision 1.19 2005/07/15 15:42:23 apsop
# HISTORY: Change to using target+obs to determine if tdrss messages go with this sequence.
# HISTORY:
# HISTORY: Revision 1.18 2005/06/01 15:57:07 apsop
# HISTORY: Remove false trigger messages if not final processing. Put all tdrss messages in diag file for non-bat-trigger targets. Fix bug in setting start time in diag files. Use info from all trdrss messages to determine trigger time.
# HISTORY:
# HISTORY: Revision 1.17 2005/04/19 15:30:46 apsop
# HISTORY: Fix bug which was causing lightcurve files to be sucked into diag file.
# HISTORY:
# HISTORY: Revision 1.16 2005/03/28 20:12:47 apsop
# HISTORY: Fix bug in selecting out only files with a particular obsid.
# HISTORY:
# HISTORY: Revision 1.15 2005/03/25 19:52:49 apsop
# HISTORY: Fix up circumstances for when reference file is created.
# HISTORY:
# HISTORY: Revision 1.14 2005/03/17 13:39:17 apsop
# HISTORY: Fix bug in reading of jobpar for tstart value
# HISTORY:
# HISTORY: Revision 1.13 2005/03/15 19:26:28 apsop
# HISTORY: Check for presence of xrt no position message when making tdrss cat file.
# HISTORY: Fix bug in checking for empty diag file. Write DATE-OBS to primary hdu of diag file.
# HISTORY:
# HISTORY: Revision 1.13 2005/03/15 19:03:26 apsop
# HISTORY: Check for presence of xrt no position message when making tdrss cat file.
# HISTORY:
# HISTORY: Revision 1.12 2004/12/03 13:37:12 apsop
# HISTORY: Make compatible with test pipeline: st versus sw
# HISTORY:
# HISTORY: Revision 1.11 2004/11/12 14:21:09 apsop
# HISTORY: Change to using PKTIME as alternate source for DATE-OBS in the tdref file.
# HISTORY:
# HISTORY: Revision 1.10 2004/11/11 23:59:47 apsop
# HISTORY: Add some log entries
# HISTORY:
# HISTORY: Revision 1.9 2004/11/09 23:51:13 apsop
# HISTORY: Combine non-science tdrss messages into one trend data file. New alogorithm for writing
# HISTORY: DATE-OBS keyword into mspob.fits file which guarantees a value is always written.
# HISTORY:
# HISTORY: Revision 1.8 2004/11/02 21:23:02 apsop
# HISTORY: Write DATE* keywords into tdref files.
# HISTORY:
# HISTORY: Revision 1.7 2004/10/29 20:31:55 apsop
# HISTORY: Fix bugs in source of info
# HISTORY:
# HISTORY: Revision 1.6 2004/10/27 12:44:33 apsop
# HISTORY: Fix bug in extracting pointing RA from FOM message.
# HISTORY:
# HISTORY: Revision 1.5 2004/10/25 14:53:17 apsop
# HISTORY: Use Bobs new FITStable utility to write db table file.
# HISTORY:
# HISTORY: Revision 1.4 2004/10/17 21:19:16 apsop
# HISTORY: Get date and proc version from sources that are actually availabe.
# HISTORY:
# HISTORY: Revision 1.3 2004/10/15 14:59:29 apsop
# HISTORY: Add bat_trigger_stop column and fix format of xrt_time column.
# HISTORY:
# HISTORY: Revision 1.2 2004/10/13 02:13:49 apsop
# HISTORY: Remove redundant tdrss messages, and create tdrss database fits file.
# HISTORY:
# HISTORY: Revision 1.1 2004/09/14 18:55:08 apsop
# HISTORY: First version of module.
# HISTORY:
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################
use Subs::SwiftSub;
@ISA = ("Subs::SwiftSub");
use strict;
use Util::HEAdas;
use Util::Date;
use Util::FITStable;
sub new {
my $proto=shift;
my $self=$proto->SUPER::new();
$self->{DESCRIPTION}="Sort and organize TDRSS messages";
return $self;
}
##################
# METHODS:
##################
sub dbTimeString
{
my ($s) = @_;
my $date = Util::Date->new($s);
my $s1 = $date->date;
my $s2 = $date->time;
my $str = qq('$s1 $s2');
return $str;
}
sub body {
my $self=shift;
my $log =$self->log();
my $filename=$self->filename();
my $procpar =$self->procpar();
my $jobpar =$self->jobpar();
my $EXCLUDE = 'PKTTIME,PKTSEC,PKTSUBS,APID';
my @burst_modes = ('al', 'ce', 'no', 'ap', 'di', 'ni', 'fc', 'sm', 'atlc');
my $burst_grep = '('. join('|', @burst_modes) .')';
my (@utcf_times, @utcf);
my $tdrss = $filename->{INFO}->{tdrss};
my @tdrss_types = sort keys %{$tdrss};
my $launch = Util::Date->new('2004-11-20T17:16:00');
####################################################
# Get a list of obsids that have tdrss messages
###################################################
my %obsids;
foreach my $type (@tdrss_types){
foreach my $file ($filename->any($type)){
if( $file =~ /^s[wt](\d{11})ms/ ){
$obsids{$1} = 1;
}else{
$log->error(1, "Is file $file really tdrss?");
}
}
}
$log->entry('Tdrss obs ids for this run: '. join(' ', sort keys %obsids) );
############################################################
# Step thru all the messages, and delete any with index > 1
# which contain identical info to the index=0 message
###########################################################
my $diff = Util::Ftool->new('fdiff')
->params({exclude => $EXCLUDE,
verbose => 'yes'});
foreach my $type (@tdrss_types){
foreach my $file ($filename->get($type, '*', '*', 0)){
$diff ->params({file1 => "$file\[0]"});
my ($inst, $mode, $index) = $filename->parse($file, $type);
my $id = ($file =~ /s[wt](\d{11})ms/)[0];
my @files = grep /${id}.*_\d+\./, $filename->get($type, $inst, $mode, '*');
foreach my $index_file (@files){
$diff->params({file2 => "$index_file\[0]"})
->run();
if( $diff->stdout() =~ /No differences/s ){
$log->entry("Deleting redundant tdrss file $index_file");
unlink $index_file;
}
}
}
}
# set up the database columns
my @dbAlert = (
# alert keys
{ name => 'ufcf_corr',
type => '1D',
unit => 's',
key => 'UTCCTIME',
},
{ name => 'trigger_satisfied',
type => '1I',
null => -1,
key => 'TRIGSATF',
},
{ name => 'rate_score',
type => '1E',
key => 'RATESCOR',
},
{ name => 'rate_score_snr',
type => '1E',
key => 'RATESNR',
},
{ name => 'bat_ra',
type => '1D',
unit => 'degree',
disp => 'F10.5',
key => 'BRA_OBJ',
},
{ name => 'bat_dec',
type => '1D',
unit => 'degree',
disp => 'F10.5',
key => 'BDEC_OBJ',
},
);
my @dbAckNack = (
{ name => 'trigger_satisfied1',
type => '1I',
key => 'TRIGSATF',
null => -1,
},
{ name => 'rate_score1',
type => '1E',
key => 'RATESCOR',
},
{ name => 'rate_score_snr1',
type => '1E',
key => 'RATESNR',
},
{ name => 'image_trigger',
type => '1A',
key => 'IMAGETRG',
},
{ name => 'catalog_source',
type => '1A',
key => 'CATSRC',
},
{ name => 'source_interested',
type => '1A',
key => 'INTEREST',
},
{ name => 'point_source',
type => '1A',
key => 'POINTSRC',
},
{ name => 'source_is_grb',
type => '1A',
key => 'GRBDETEC',
},
{ name => 'bat_theta',
type => '1D',
unit => 'degree',
key => 'BATTHETA',
disp => 'F10.5',
},
{ name => 'bat_phi',
type => '1D',
unit => 'degree',
key => 'BATPHI',
disp => 'F10.5',
},
{ name => 'bat_peak_rate',
type => '1D',
key => 'PEAKRATE',
},
{ name => 'bat_tot_counts',
type => '1J',
key => 'TOTCOUNT',
null => -1,
},
{ name => 'bat_back_counts',
type => '1J',
key => 'BACKCONT',
null => -1,
},
{ name => 'bat_net_counts',
type => '1J',
key => 'NETCOUNT',
null => -1,
},
{ name => 'bat_trigger_stop',
type => '1D',
key => 'TRIGSTOP',
},
{ name => 'image_significance',
type => '1E',
key => 'IMGSNR',
},
{ name => 'source_exposure',
type => '1E',
key => 'FOREXPO',
unit => 's',
},
{ name => 'back_exposure',
type => '1E',
key => 'BACKEXPO',
unit => 's',
},
);
my @dbFOM = (
{ name => 'new_at',
type => '1A',
key => 'NEWFOMAT',
},
{ name => 'fom_observe',
type => '1A',
key => 'FOM2OBS',
},
{ name => 'merit',
type => '1A',
key => 'FOMMERIT',
},
);
my @dbFOSC = (
{ name => 'pnt_ra',
type => '1D',
unit => 'degree',
key => 'RA_PNT',
disp => 'F10.5',
},
{ name => 'pnt_dec',
type => '1D',
unit => 'degree',
key => 'DEC_PNT',
disp => 'F10.5',
},
{ name => 'pnt_roll',
type => '1D',
unit => 'degree',
key => 'PA_PNT',
disp => 'F10.5',
},
{ name => 'sc_observe',
type => '1A',
key => 'SCREPLY',
},
{ name => 'wait_time',
type => '1D',
unit => 's',
key => 'WAITSEC',
},
{ name => 'wait_constraint',
type => '1D',
unit => 's',
key => 'PREDSEC',
},
);
my @dbXRTPosition = (
{ name => 'xrt_ra',
type => '1D',
disp => 'F10.5',
unit => 'degree',
key => 'XRA_OBJ',
},
{ name => 'xrt_dec',
type => '1D',
disp => 'F10.5',
unit => 'degree',
key => 'XDEC_OBJ',
},
{ name => 'rate_dn',
type => '1E',
key => 'RATEDN',
},
);
my @dbXRTImage = (
# XRT image
{ name => 'xrt_flux',
type => '1D',
key => 'SRCFLUX',
},
{ name => 'rate_dn1',
type => '1E',
key => 'RATEDN',
},
{ name => 'xrt_exposure',
type => '1D',
unit => 's',
key => 'EXPOSURE',
},
{ name => 'xrt_pos_err',
type => '1D',
key => 'ERRCTRD',
},
{ name => 'xrt_dn',
type => '1D',
key => 'TOTALDN',
},
);
# this collects all the groups together
my @db = (
{ name => 'target_id',
type => '1J',
disp => 'I8',
null => -1,
},
{ name => 'obs_segment',
type => '1J',
disp => 'I3',
null => -1,
},
{ name => 'obs_number',
type => '11A',
},
{ name => 'ra',
type => '1D',
disp => 'F10.5',
unit => 'degree',
},
{ name => 'dec',
type => '1D',
disp => 'F10.5',
unit => 'degree',
},
{ name => 'pos_flag',
type => '1I',
null => -1,
},
{ name => 'time',
type => '24A',
},
{ name => 'time_seconds',
type => '1D',
unit => 's',
},
@dbAlert,
{ name => 'time1',
type => '24A',
},
{ name => 'time_seconds1',
type => '1D',
unit => 's',
},
@dbAckNack,
@dbFOM,
@dbFOSC,
@dbXRTPosition,
{ name => 'xrt_time',
type => '24A',
},
@dbXRTImage,
# pipeline
{ name => 'processing_date',
type => '24A',
},
{ name => 'processing_version',
type => '40A',
},
{ name => 'num_processed',
type => '1I',
null => -1,
},
);
my $db = Util::FITStable->new(\@db,
log => $log,
which => 'tdrss',
);
my $headfile = 'tdrss_head.tmp';
my $create = Util::Ftool->new('fimgcreate')
->params({bitpix => 8,
naxes => '0',
datafile => 'none',
headfile => $headfile,
clobber => 'yes'});
my $append = Util::Ftool->new('fappend')
->params({pkeywds => 'yes'});
my $now = Util::Date->new();
my $this_obs = $jobpar->read('sequence');
my $final = $jobpar->{TIMELIST}->{final} || 0;
my $entries = 0;
# files to prevent from delivery to HEASARC
my @toast_files;
my @tdql_files;
foreach my $id (sort keys %obsids) {
$log->entry("Processing obs $id");
# if skipdb is true, $id will not be included in the database
my $skipdb = 0;
if (("$this_obs" ne "$id") and ((not $final) or ($this_obs =~ /99[0-9]$/)) ) {
$log->entry("Not final processing, so delete tdrss messages for $id.");
$skipdb = 1;
# this glob looks under-constrained:
# what if there are non-tdrss files with ${id}?
my @toast = sort glob("*${id}*");
push(@toast_files, @toast);
$log->entry("Will remove @toast");
}
################################################
# Make an index file for each tdrss observation
################################################
open HEAD, ">$headfile";
print HEAD "OBS_ID=$id / Observation ID\n";
print HEAD "DATE = ", $now->date(), 'T', $now->time(), "\n";
print HEAD "XOBS_ID=$this_obs / Generating sequence\n";
close HEAD;
my $other_file = $jobpar->read('mission').$id.'mssdi.fits';
$create->params({outfile => $other_file})
->run();
$append->params({outfile => $other_file});
my @all_files;
foreach my $type (@tdrss_types){
next if $type eq 'tdnosc';
next if $type eq 'tdmess';
my @tfiles = grep /${id}/, $filename->any($type);
push @all_files, @tfiles;
}
################################################################
# Take all 'non-science' trdss messages and append them to the
# tdnosc file.
################################################################
{
###########################################################################
# If this is not a bat AT trigger target and there is no other tdrss data,
# put all the tdrss messages into this file, and then get out of Dodge.
###########################################################################
my $type = 'tdmess';
my @tfiles = grep /${id}/, $filename->any($type);
if (isSequenceBATTrigger($id) || @all_files) {
my %files;
@files{@tfiles} = (1) x @tfiles;
@tfiles = grep !/ms.${burst_grep}.*\.fits$/, @tfiles;
delete @files{@tfiles};
push @all_files, keys %files;
}
my @append_files = @tfiles;
foreach my $file (@append_files){
$log->entry("Appending file $file to $other_file.");
$append->params({infile => $file .'[0]'})
->run();
unlink $file;
}
}
my $other_fits = Util::FITSfile->new($other_file);
my $nhdus = $other_fits->nhdus();
if( $nhdus > 1 ){
my $tstart = 1.E10;
for(my $i=1; $i<$nhdus; $i++){
$other_fits->ext($i);
$other_fits->keyword('EXTNAME', $other_fits->keyword('MESGNAME'));
my $start = $other_fits->keyword('TSTART');
# do not use TRIGTIME as TSTART since this could be a follow-up to a
# trigger from long ago. Issue noted 2015-10-22 / 00147478010.
# $start = $other_fits->keyword('TRIGTIME')
# unless $start;
$tstart = $start
if ( $start && $start < $tstart && $start > $launch->seconds());
}
$tstart = $jobpar->read('tstart')
unless ($tstart < 1.E10 && $tstart > $launch->seconds());
my $first = Util::Date->new($tstart);
$other_fits->ext(0);
$other_fits->keyword('TSTART', $tstart);
$other_fits->keyword('DATE-OBS', $first->date().'T'.$first->time() );
}else{
unlink $other_file;
}
next unless @all_files;
my $ref_file = $jobpar->read('mission').$id.'mspob.cat';
$log->entry("Make trdss ref file $ref_file.");
$create->params({outfile => $ref_file})
->run();
my $tdref = Util::FITSfile->new($ref_file, 0);
push(@tdql_files, $ref_file, @all_files);
if ($skipdb) {
push(@toast_files, $ref_file);
}
my $first = Util::Date->new($jobpar->read('tstart'));
$tdref->keyword('TSTART', $jobpar->read('tstart'));
$tdref->keyword('DATE-OBS', $first->date().'T'.$first->time() );
#####################################################
# Get the keyword lists needed for the tdrss db file
#####################################################
my %alert_keys;
my $file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'al', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%alert_keys = $fits->keywords();
}
my %ack_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'ce', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%ack_keys = $fits->keywords();
}
my %nack_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'bat', 'no', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%nack_keys = $fits->keywords();
}
my %xce_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'xrt', 'ce', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%xce_keys = $fits->keywords();
}
my %xno_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'xrt', 'no', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%xno_keys = $fits->keywords();
}
my %xim_keys;
$file = ( grep /${id}/, $filename->get('tdskyimage', 'xrt', 'im', '*') )[0];
$file = ( grep /${id}/, $filename->get('tdrawimage', 'xrt', 'im', '*') )[0]
unless ($file && -f $file);
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
$fits->ext(1) if $fits->nhdus() > 1;
%xim_keys = $fits->keywords();
}
my %fom_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'fom', 'ap', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%fom_keys = $fits->keywords();
}
my %fosc_keys;
$file = ( grep /${id}/, $filename->get('tdmess', 'swift', 'ap', 0) )[0];
if( $file && -f $file ){
my $fits = Util::FITSfile->new($file, 0);
%fosc_keys = $fits->keywords();
}
my %all_keys = (%fosc_keys, %fom_keys, %xim_keys, %xno_keys, %xce_keys, %nack_keys,
%ack_keys, %alert_keys);
#############################
# No keywords, no tdrss.
#############################
if (not %all_keys) {
# 2019-10 add check for BAT failed trigger results
# tdhk includes msbevtssp.hk, msbevtlsp.hk, msbhd.hk
my @bfiles = grep /${id}/, $filename->get('tdhk', 'bat', '*', 0);
foreach my $bfile (@bfiles) {
if( $bfile && -f $bfile ){
my $bfits = Util::FITSfile->new($bfile, 0);
if (my $btime = $bfits->keyword('TSTART')) {
$all_keys{FAKETIME} = $btime;
$log->entry("using $bfile TSTART as time of record");;
last;
}
}
}
}
if (not %all_keys) {
$log->error(1, "no tdrss keywords available");
next;
}
######################################################################
# Determine best available time for DATE-OBS and tigger time.
# Truly heroic efforts are taken to try and extract a reasonable
# trigger time for the data. Nominally we should have TRIGTIME and
# UTCTIME. If there is no UTCTIME then use UTCF info in timing file.
# If there is no TRIGTIME then use PKTTIME or PKTTIME1 to get the
# DATE-OBS, but give up on the trigger time.
######################################################################
my ($time, $timeSeconds, $Ttime) = ('INDEF') x 3;
{
my $packet_time = 1E10;
if( $all_keys{'PKTTIME'} ){
$packet_time = $all_keys{'PKTTIME'};
}elsif( $all_keys{'PKT1TIME'} ){
$packet_time = $all_keys{'PKT1TIME'};
} elsif (my $faketime = $all_keys{FAKETIME}) {
$timeSeconds = $packet_time = $faketime;
$time = dbTimeString( $packet_time );
}
unless( $all_keys{TRIGTIME} && $all_keys{TRIGTIME} > $launch->seconds() &&
$all_keys{TRIGTIME} < $packet_time ){
$Ttime = dbTimeString( $packet_time );
} else {
$timeSeconds = $all_keys{TRIGTIME};
if( $all_keys{UTCCTIME} ){
$timeSeconds += $all_keys{UTCCTIME};
$time = $Ttime = dbTimeString($timeSeconds);
}else{
unless( @utcf ){
my $time_file = $filename->get('timedata', 'swift', '', 0);
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();
}
}
if( @utcf ){
my $itime = 0;
while( $timeSeconds > $utcf_times[$itime] &&
$itime < $#utcf_times){ $itime++ }
$timeSeconds += $utcf[$itime];
$time = $Ttime = dbTimeString($timeSeconds);
}else{
$Ttime = dbTimeString($timeSeconds);
}
}
}
}
################################################
# Compile the data needed for the tdrss db file
################################################
if (not $skipdb) {
$entries++;
# observation
{
$db->set(target_id => "'" . substr($id, 0, 8) . "'");
$db->set(obs_segment => "'" . substr($id, 8, 3) . "'");
$db->set(obs_number => "'$id'");
}
{
my ($ra, $dec, $posFlag);
# TODO: should this really be defined instead of boolean context?
if ($xce_keys{XRA_OBJ} && $xce_keys{XDEC_OBJ} ){
$ra = $xce_keys{XRA_OBJ};
$dec = $xce_keys{XDEC_OBJ};
$posFlag = 2;
}
else {
$ra = $ack_keys{BRA_OBJ} || 'INDEF';
$dec = $ack_keys{BDEC_OBJ} || 'INDEF';
$posFlag = ($ack_keys{BRA_OBJ} && $ack_keys{BDEC_OBJ}) ? 1 : 0;
}
$db->set(ra => $ra);
$db->set(dec => $dec);
$db->set(pos_flag => $posFlag);
}
$db->set(time => $time);
$db->set(time_seconds => $timeSeconds);
foreach my $e (@dbAlert) {
$db->set($e->{name} => \%ack_keys);
}
###############################################################
# Use ack or nack keywords, depending on which message we have
###############################################################
my %ack_nack_keys = $ack_keys{DATE} ? %ack_keys : %nack_keys;
{
my ($time1, $timeSeconds1);
unless ($ack_nack_keys{TRIGTIME} && $ack_nack_keys{UTCCTIME}) {
$time1 = 'INDEF';
$timeSeconds1 = 'INDEF';
} else {
$timeSeconds1 = $ack_nack_keys{TRIGTIME} + $ack_nack_keys{UTCCTIME};
$time1 = dbTimeString($timeSeconds1);
}
$db->set(time1 => $time1);
$db->set(time_seconds1 => $timeSeconds1);
}
foreach my $e (@dbAckNack) {
$db->set($e->{name} => \%ack_nack_keys);
}
########################################################################
# FOM
########################################################################
foreach my $e (@dbFOM) {
$db->set($e->{name} => \%fom_keys);
}
foreach my $e (@dbFOSC) {
$db->set($e->{name} => \%fosc_keys);
}
########################################################################
# XRT position
########################################################################
foreach my $e (@dbXRTPosition) {
$db->set($e->{name} => \%xce_keys);
}
{
my $time;
unless($xce_keys{FRAMTIME} && $xce_keys{UTCCTIME}) {
$time = 'INDEF';
}
else {
$time = dbTimeString($xce_keys{FRAMTIME} + $xce_keys{UTCCTIME});
}
$db->set(xrt_time => $time);
}
############
# XRT image
############
foreach my $e (@dbXRTImage) {
$db->set($e->{name} => \%xim_keys);
}
$db->set(processing_date => Util::Date->new->date);
$db->set(processing_version => $procpar->read('version'));
$db->set(num_processed => int($jobpar->read('seqprocnum')));
} # not $skipdb
$Ttime =~ s/ /T/;
$tdref->keyword('DATE-OBS', $Ttime);
$tdref->keyword('TSTART', $timeSeconds) unless $timeSeconds eq 'INDEF';
###############################################################
# Write appropriate OBJECT and DATE-OBS keywords into products
###############################################################
my $object = 'NON-BURST';
$object = $jobpar->read('object') if $this_obs==$id;
foreach my $tfile (@all_files) {
my $tfits = Util::FITSfile->new($tfile, 0);
$tfits->begin_many_keywords();
if( $Ttime!~/INDEF/ || ! $tfits->keyword('DATE-OBS') ){
$tfits->keyword('DATE-OBS', $Ttime);
}
$tfits->keyword('OBJECT', $object);
$tfits->keyword('XOBS_ID', $this_obs, 'Generating sequence');
$tfits->end_many_keywords();
}
}
unlink($headfile);
if ($entries) {
my $outfile = $filename->get('tddb', 'proc', '', 0);
$db->write($outfile);
}
# create QL tdrss archive and clean up @toast_files
if (@tdql_files) {
my $tdql = $filename->get('tdql', 'proc', '', 0);
$log->entry("create $tdql with @tdql_files");
my $tdql_list = 'tdql.list';
if ($self->splat($tdql_list, @tdql_files)) {
my $tar = qq(tar cvf $tdql --files-from=$tdql_list);
my $result = qx($tar);
if ($?) {
$log->error(1, "unable to create $tdql: $! [code=$?]");
}
}
$log->entry("removing @toast_files");
foreach my $toast (@toast_files) {
unlink($toast)
or $log->error(1, "unable to unlink $toast: $!");
}
}
} # end of body method
sub isSequenceBATTrigger
{
my ($seq) = @_;
my $isTrigger = 0;
if ($seq =~ /^(\d{8})(\d{3})$/) {
my $target = $1;
my $segment = $2;
if (($target > 100000 and $target < 3000000) and ($segment == 0)) {
$isTrigger = 1;
}
}
return $isTrigger;
}
sub splat
{
my ($self, $path, @lines) = @_;
if (open(SPLAT, '>', $path)) {
print SPLAT join("\n", @lines, '');
close(SPLAT);
return 1;
}
else {
$self->log->error(1, "unable to open $path: $!");
}
return undef;
}
1;