Subs::BATDB (version 0.0)

package Subs::BATDB;
##############################################################################
#
# DESCRIPTION: 
#
# HISTORY: $Log: BATDB.pm,v $
# HISTORY: Revision 1.10  2007/02/10 22:28:33  apsop
# HISTORY: Set orig obs to seq obs for tdrss failed triggers.
# HISTORY:
# HISTORY: Revision 1.9  2007/02/08 14:31:34  apsop
# HISTORY: Fix bug in calculation of original observation id, segment was being set to wrong value.
# HISTORY:
# HISTORY: Revision 1.8  2007/01/31 20:46:10  apsop
# HISTORY: Add entries for the failed trigger event data.
# HISTORY:
# HISTORY: Revision 1.7  2006/08/02 19:46:00  apsop
# HISTORY: If aspect correction fails for individual snapshots, change from level 2 to level 1 error.
# HISTORY:
# HISTORY: Revision 1.6  2005/12/22 18:03:38  apsop
# HISTORY: Give module a version number to make the install scripts happy.
# HISTORY:
# HISTORY: Revision 1.5  2005/11/14 20:21:34  apsop
# HISTORY: Wrote out map built-in in long-hand in response to inexplicable behavior.
# HISTORY: Possible perl bug(?)
# HISTORY:
# HISTORY: Revision 1.4  2005/11/08 17:07:59  apsop
# HISTORY: Use Filename calls to get bat db file names.  Use caldb for alignfile in prefilter. Set RATE_CODE to INDEF for non-rate modes.  Clean up temp $gtifile.
# HISTORY:
# HISTORY: Revision 1.3  2005/08/30 13:55:51  apsop
# HISTORY: Change alignfile param to make in compatible with old version of aspect.  Change rate_code column to ratecode.
# HISTORY:
# HISTORY: Revision 1.2  2005/08/16 22:23:33  apsop
# HISTORY: Propagate original/true target, segment and observation numbers from
# HISTORY: Rich's database HK file instead of taking from job.par.
# HISTORY:
# HISTORY: Revision 1.1  2005/08/16 21:36:37  apsop
# HISTORY: Module for creating HEASARC BAT exposure database file.
# HISTORY:
#
# VERSION: 0.0
#
##############################################################################

use Subs::Sub;

@ISA = ("Subs::Sub");
use strict;

use Astro::FITS::CFITSIO qw(:constants);

use Util::HEAdas;
use Util::FITStable;
use Util::CoreTags;


sub new
{
	my $proto=shift;
	my $self=$proto->SUPER::new();

	$self->{DESCRIPTION} = 'Update BAT exposure database';

	return $self;
}


##################
# METHODS:
##################

sub body
{
	my $self=shift;

	my $log	  = $self->log();
	my $filename = $self->filename();
	my $procpar  = $self->procpar();
	my $jobpar   = $self->jobpar();

	# set up the database columns
	my @db = (
		{ name => 'name', # source name
			type => '80A',
			comment => 'Designation of the Pointed Source',
			# $jobpar->read('object')
		},
		{ name => 'orig_target_id', # Target_id
			type => '1J',
			null => -1,
			disp => 'I8',
			comment => 'Trigger Number as Originally Assigned',
				# $jobpar->read('target')
		},
		{ name => 'target_id', # True target_id
			type => '1J',
			null => -1,
			disp => 'I8',
			comment => 'Unique Trigger Number with Any Degeneracy Removed',
			# substr(0, 8, $jobpar->read('sequence'))
		},
		{ name => 'ra', # R.A.
			type => '1E',
			unit => 'deg',
			disp => 'F10.5',
			comment => 'Right Ascension (Pointing Position)',
			# $jobpar->read('ra')
		},
		{ name => 'dec', # Dec.
			type => '1e',
			unit => 'deg',
			disp => 'F10.5',
			comment => 'Declination (Pointing Position)',
			# $jobpar->read('dec')
		},
		{ name => 'roll_angle', # Roll
			type => '1E',
			unit => 'deg',
			disp => 'F10.5',
			comment => 'Roll Angle (degree)',
			# $jobpar->read('roll')
		},

		{ name => 'start_time', # Start time
			type => '24A',
			comment => 'Start Time of the Observation',
		},
		{ name => 'stop_time', # Stop  time
			type => '24A',
			comment => 'Stop Time of the Observation',
		},

		{ name => 'orig_obs_segment', # Obs seg
			type => '1J',
			disp => 'I3',
			null => -1,
			comment => 'Observation Segment as Originally Assigned',
				# $jobpar->read('obs')
		},
		{ name => 'obs_segment', # True Obs seg
			type => '1J',
			disp => 'I3',
			null => -1,
			comment => 'True Observation Segment (Corrected Value)',
				# substr(8, $jobpar->read('sequence'))
		},
		{ name => 'orig_obsid', # Obs number
			type => '11A',
			comment => 'Observation Number as Originally Assigned (OrigTarget_ID + Orig_Obs_Segment)',
			# $jobpar->read('target') . $jobpar->read('obs');
		},
		{ name => 'obsid', # True Obs num
			type => '11A',
			comment => 'Unique Observation Number (Target_ID + Obs_Segment)',
				# $jobpar->read('sequence')
		},

		{ name => 'exposure',
			type => '1E',
			comment => 'Total time in seconds for this record',
		},
		{ name => 'ratecode', # ratecode
			type => '4A',
			comment => 'Flag for rate modes.',
		},
		{ name => 'catnum', # Catnum
			type => '1J',
			disp => 'I8',
			comment => 'Target_Id number in the BAT catalog (Mask Tag & Pulsar mode)',
		},
		{ name => 'operation_mode', # Observing mode
			type => '80A',
			comment => 'Indicates Operating Mode of Instrument',
			# from DATAMODE
		},
		{ name => 'pointing_mode', # Spacecraft obs mode
			type => '80A',
			comment => 'Indicates Pointing Mode of Spacecraft',
			# from OBS_MODE
		},
		{ name => 'filename', # Filename
			type => '80A',
			comment => 'Name of the File Containing the Data for this Interval',
		},

	);

	my $attfile = $filename->get('attitude', 'swift');
	if (not $attfile) {
		$log->error(2, 'Unable to create BAT exposure database without attitude');
		return;
	}

	my $dbfile = $filename->get('badb', 'proc', '', 0);
# print "BAT exposure database will be named $dbfile\n";
	my $hkfile = $filename->get('hk', 'proc', 'badb', 0);

	unless (-f $hkfile) {
		$log->entry("Unable to locate BAT exposure database housekeeping file $hkfile");
		return;
	}

	my $batdb = Util::SimpleFITS->readonly($hkfile);
	my $status = $batdb->status;
	if (not $batdb or $status) {
		$log->error(2, "unable to open BAT catalog $hkfile [$status]");
		return;
	}

	$batdb->move(2);
	if ($batdb->status) {
		$log->error(2, 'unable to move to $hkfile database extension');
		return;
	}

	# slurp the BAT2FITS version
	my @records;
	$status = $batdb
			->loadTable(\@records)
			->status;

	if ($status) {
		$log->error(2, 'unable to read data');
		return;
	}

	my $db = Util::FITStable->new(\@db,
			log => $log,
			which => 'bat',
			);

	################################################
	# Add entries for the failed trigger event data
	################################################
	foreach my $tdfile ($filename->get('tdunfilter', 'bat', '*', '*')){
	  my %new_rec;
	  my $tdfits = Util::FITSfile->new($tdfile, 0);
	  $new_rec{CATNUM} = 0;
	  $new_rec{SOURCE_NAME} = 'Failed Trigger';
	  $new_rec{RA} = 'INDEF';
	  $new_rec{DEC} = 'INDEF';
	  $new_rec{ROLL_ANGLE} = 'INDEF';
	  $new_rec{ORIG_TARGET_ID} = $jobpar->read('target');
	  $new_rec{TARGET_ID}  = $tdfits->keyword('TARG_ID');
	  $new_rec{ORIG_OBS_SEGMENT} = $jobpar->read('obs');
	  $new_rec{OBS_SEGMENT} = $tdfits->keyword('SEG_NUM');
	  $new_rec{OPERATION_MODE} = 'Event';
	  $new_rec{POINTING_MODE} = 'SLEW_POINTING';
	  $new_rec{FILENAME} = $tdfile;

	  $tdfits->ext(1);
	  $new_rec{EXP_START} = $tdfits->keyword('TSTART');
	  $new_rec{EXP_STOP} = $tdfits->keyword('TSTOP');
	  $new_rec{START_TIME} = $new_rec{EXP_START};
	  $new_rec{STOP_TIME} = $new_rec{EXP_STOP};
	  $new_rec{INTEGRATION_TIME} = $tdfits->keyword('EXPOSURE');
	  $new_rec{INTERVAL} = $tdfits->keyword('TELAPSE');

	  push @records, \%new_rec;
	}

	###################################################
	# Compile the data needed for the BAT database file
	###################################################
	my $rows = @records;
	my @indef = ('INDEF') x $rows;
	$db->{rows} = $rows;

	# observation values
	my $object = $jobpar->read('object');

	# this is what the pipeline writes for RA_PNT, DEC_PNT...
	my $nomra = $jobpar->read('ra');
	my $nomdec = $jobpar->read('dec');
	foreach my $e (@records) {
		if ($e->{CATNUM} == 0) {
			$e->{SOURCE_NAME} = $object;
			$e->{RA} = $nomra;
			$e->{DEC} = $nomdec;
		}
#		if($e->{POINTING_MODE} eq 'SLEW'){
#			$e->{RA} = 'INDEF';
#			$e->{DEC} = 'INDEF';
#			$e->{ROLL_ANGLE} = 'INDEF';
#		}
	}

	my @object = map { "'$_->{SOURCE_NAME}'" } @records;
	$db->set(name => \@object);

	$db->set(orig_target_id => [ map { $_->{ORIG_TARGET_ID} } @records ]);
	$db->set(target_id => [ map { $_->{TARGET_ID} } @records ]);


	# find mean roll for each snapshot
	my $aspect = Util::HEAdas->new('aspect')
			->params({
				attfile => $attfile,
				alignfile => 'CALDB'
			});

	my $solved;
	my @gtidb = (
		{ name => 'START',
			type => '1D',
		},
		{ name => 'STOP',
			type => '1D',
		},

	);

	my $gtifile = 'aspect.gti';
	foreach my $e (@records) {
		if (defined($solved) and $solved->{INTERVAL} == $e->{INTERVAL}) {
			$e->{ROLL_ANGLE} = $solved->{ROLL_ANGLE};
#			if($e->{POINTING_MODE} eq 'SLEW'){
#			  $e->{RA} = $solved->{RA};
#			  $e->{DEC} = $solved->{DEC};
#			}
			next;
		}

		my $gti = Util::FITStable->new(\@gtidb,
				log => $log,
				which => 'GTI',
				);
		$gti->set(START => [ $e->{EXP_START} ]);
		$gti->set(STOP => [ $e->{EXP_STOP} ]);
		unlink($gtifile);
		$gti->write($gtifile);

		$aspect->params({ gtis => $gtifile });
		$aspect->seriousness(1);
		$aspect->run();
		if ($aspect->had_error) {
			$log->error([ 1, ASPECT_FAILED ],
					'unable to determine mean roll for snapshot');
		}
		else {
			$e->{ROLL_ANGLE} = $aspect->parfile()->read('roll');
#			if($e->{POINTING_MODE} eq 'SLEW'){
#			  $e->{RA} = $aspect->parfile()->read('ra');
#			  $e->{DEC} = $aspect->parfile()->read('dec');
#			}
			$solved = $e;
# print "roll from $e->{EXP_START} to $e->{EXP_STOP} is $e->{ROLL_ANGLE}\n";
		}
	}
	unlink($gtifile);

	my @ra = map { $_->{RA} } @records;
	my @dec = map { $_->{DEC} } @records;
	my @roll = map { $_->{ROLL_ANGLE} } @records;

	##################################################
	# Set rate code to 'INDEF' if not in a Rates mode
	##################################################
	foreach my $rec (@records){
	  $rec->{RATE_CODE} = 'INDEF' unless $rec->{OPERATION_MODE} =~ /Rates/;
	}

	####################################################################
	# Early observations (before PPSTs) had multiple pointings, so set
	# pointing to indef
	####################################################################
	if( $jobpar->read('tstart') > 124383600 ){
		$db->set(ra => \@ra);
		$db->set(dec => \@dec);
		$db->set(roll_angle => \@roll);
	}
	else{
		$db->set(ra => \@indef);
		$db->set(dec => \@indef);
		$db->set(roll_angle => \@indef);	  
	}

	# my @start = map { $db->timeString($_->{START_TIME}) } @records;
	# my @stop = map { $db->timeString($_->{STOP_TIME}) } @records;
	my @start;
	foreach my $e (@records) {
		push(@start, $db->timeString($e->{START_TIME}));
	}
	my @stop;
	foreach my $e (@records) {
		push(@stop, $db->timeString($e->{STOP_TIME}));
	}

	$db->set(start_time => \@start);
	$db->set(stop_time => \@stop);

	$db->set(orig_obs_segment => [ map { $_->{ORIG_OBS_SEGMENT} } @records]);
	$db->set(obs_segment => [ map { $_->{OBS_SEGMENT} } @records]);

	$db->set(orig_obsid => [ map { makeSequence($_) } @records ]);
	$db->set(obsid => [ map { makeSequence($_, 1) } @records ]);

	my @exposure = map { $_->{INTEGRATION_TIME} } @records;
	$db->set(exposure => \@exposure);

	my @catnum = map { $_->{CATNUM} } @records;
	$db->set(catnum => \@catnum);

	my @obs_mode = map { $_->{OPERATION_MODE} } @records;
	$db->set(operation_mode => \@obs_mode);

	my @rate_code = map { $_->{RATE_CODE} } @records;
	$db->set(ratecode => \@rate_code);

	my @pointing_mode = map { $_->{POINTING_MODE} } @records;
	$db->set(pointing_mode => \@pointing_mode);

	my @filename = map { $_->{FILENAME} } @records;
	$db->set(filename => \@filename);

	$db->write($dbfile);

} # end of body method


sub makeSequence
{
	my ($href, $true) = @_;
	my $key1 = $true ? 'TARGET_ID' : 'ORIG_TARGET_ID';
	my $key2 = $true ? 'OBS_SEGMENT' : 'ORIG_OBS_SEGMENT';
	sprintf('%08d%03d', $_->{$key1}, $_->{$key2});
}