Subs::SortTdrss (version 0.0)


package Subs::SortTdrss;
##############################################################################
#
# DESCRIPTION: 
#
# HISTORY: 
# HISTORY: $Log: SortTdrss.pm,v $
# 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. 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 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::Sub;

@ISA = ("Subs::Sub");
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 $tdrss = $filename->{INFO}->{tdrss};
    my @tdrss_types = keys %{$tdrss};

    ####################################################
    # 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(' ', 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 => 'FLUX',
		      },
		      { 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 => 'DN',
		      },
		     );

    
    # 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();
    foreach my $id (keys %obsids) {

      ################################################
      # 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";
      close HEAD;

      $log->entry("Processing obs $id");
      
      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';
	my @tfiles = $filename->any($type);
        my %files;
        @files{@tfiles} = (1) x @tfiles;
	foreach my $file (grep !/ms.${burst_grep}.*\.fits$/, @tfiles){
	  $log->entry("Appending file $file to $other_file.");
          $append->params({infile => $file .'[0]'})
                 ->run();
          unlink $file;
	  delete $files{$file};
        }
        push @all_files, keys(%files);
      }

      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');
	  $start = $other_fits->keyword('TRIGTIME')
	    unless $start;
	  $tstart = $start 
	    if ( $start && $start < $tstart );
	}
	$tstart = $jobpar->read('tstart')
	  if $tstart < 1.E10;
	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);

      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('tdimage', 'xrt', '', 0) )[0];
      if( $file && -f $file ){
	my $fits = Util::FITSfile->new($file, 0);
	%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 = (%alert_keys, %ack_keys, %nack_keys, %xce_keys, %xno_keys, %xim_keys, %fom_keys, %fosc_keys);

      #############################
      # No keywords, no tdrss.
      #############################
      next unless %all_keys;

      ################################################
      # Compile the data needed for the tdrss db file
      ################################################
      # 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{RA} && $xce_keys{DEC} ){
	  $ra = $xce_keys{RA};
	  $dec = $xce_keys{DEC};
	  $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);
      }
      
      {
	#########################################################
	# Take this opportunity to fill in the DATE_OBS keyword
	# in the tdrss reference file
	#########################################################
	my ($time, $timeSeconds, $Ttime);
	unless( $alert_keys{TRIGTIME} && $alert_keys{UTCCTIME} ) {
	  $time = 'INDEF';
	  $timeSeconds = 'INDEF';
	  $Ttime = dbTimeString( $all_keys{'PKTTIME'} );
	} else {
	  $timeSeconds = $alert_keys{TRIGTIME} + $alert_keys{UTCCTIME};
	  $time = $Ttime = dbTimeString($timeSeconds);
	}	  
	$Ttime =~ s/ /T/;
	$tdref->keyword('DATE-OBS', $Ttime);

	$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')));
      
      my $outfile = $filename->get('tddb', 'proc', '', 0);
      
      $db->write($outfile);
    }
    unlink($headfile);

} # end of body method