Subs::BATFinish (version 0.0)


package Subs::BATFinish;
##############################################################################
#
# DESCRIPTION: This creates an HTML report of XRT exposures. It is largely
# DESCRIPTION: a translation of the FITS head/tail HK files.  This module
# DESCRIPTION: also creates merged enable/disable and gain/offset maps for
# DESCRITPION: the observation.
#
# HISTORY: 
# HISTORY: $Log: BATFinish.pm,v $
# HISTORY: Revision 1.9  2006/03/24 14:32:14  apsop
# HISTORY: Use ftcopy to copy hk files, to ensure that files get unzipped.
# HISTORY:
# HISTORY: Revision 1.8  2006/01/12 15:35:47  apsop
# HISTORY: When creating the 'merged' BAT calibration files, make of copy of the
# HISTORY: input map in the event there is only one instead of renaming just in
# HISTORY: case someone cares about the input file.
# HISTORY:
# HISTORY: Revision 1.7  2006/01/05 23:26:06  apsop
# HISTORY: Implemented merging of BAT detector enable/disable and gain/offset maps
# HISTORY: for the observation and pruned the work-around that saved them with
# HISTORY: index numbers.
# HISTORY:
# HISTORY: Revision 1.6  2005/11/08 17:03:20  apsop
# HISTORY: Fix bug in retrieval of bat rate files, and add calculation of pulsar mode exposure.
# HISTORY:
# HISTORY: Revision 1.5  2005/09/19 13:28:28  apsop
# HISTORY: Add seq number to report title.
# HISTORY:
# HISTORY: Revision 1.4  2005/03/07 22:43:56  apsop
# HISTORY: Changes to deal with UNDEF values in the input fits files.
# HISTORY:
# HISTORY: Revision 1.3  2004/12/05 23:35:54  apsop
# HISTORY: Only select short event files for calculating the exposure.
# HISTORY:
# HISTORY: Revision 1.2  2004/11/19 21:46:48  apsop
# HISTORY: New version of xrt2fits.
# HISTORY:
# HISTORY: Revision 1.1  2004/10/29 20:34:32  apsop
# HISTORY: Rename module from BATReport, and add code to remove unneeded bat event files.
# HISTORY:
# HISTORY: Revision 1.7  2004/09/03 12:37:23  apsop
# HISTORY: Give mask tagged lc their own type and file class.  Use DURATION for html table, but EXPOSURE for parameters.
# HISTORY:
# HISTORY: Revision 1.6  2004/09/02 00:04:35  apsop
# HISTORY: Put in handling of rate files and mask tagged rate files.
# HISTORY:
# HISTORY: Revision 1.5  2004/05/06 20:02:34  dah
# HISTORY: Add version number back into the header comments.
# HISTORY:
# HISTORY: Revision 1.4  2004/04/16 20:21:18  dah
# HISTORY: Begin using embedded history records
# HISTORY:
#
# VERSION: 0.0
#
#
##############################################################################


use Subs::Sub;
use Subs::HTMLPage;

@ISA = ('Subs::HTMLPage');
use strict;

use FileHandle;
use File::Copy;


sub new {
    my $proto=shift;

    my $file=$proto->filename()->get('report', 'bat');
    my $seq = $proto->jobpar()->read('sequence') .".". $proto->jobpar()->read('seqprocnum');
    my $self=$proto->SUPER::new($file, "BAT Exposure Report for $seq");

    $self->{DESCRIPTION}='BAT cleanup and HTML Exposure Report';

    return $self;
}

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

##############################################################################
#
##############################################################################
sub body {
    my $self=shift;

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

    #################################################
    # Delete bat event files that we are not keeping 
    #################################################

    unlink grep /evsh(ps|sl|as)/, $filename->get('unfiltered', 'bat', 'evsh??', '*');
    unlink grep /evsh(ps|sl|as)/, $filename->get('event', 'bat', 'evsh??', '*');

    my $survey_expo=0.0;
    my $unf_expo=0.0;
    my $evt_expo=0.0;
    my $rate_expo=0.0;
    my $masktag_expo=0.0;
    my $pulsar_expo=0.0;
    
    my $gtisum=Util::Stool->new('compute_exposure')
                          ->verbose(0);

    my @rows=();
    ############################################
    # collect information about the event files
    ############################################
    foreach my $file ($filename->get('unfiltered', 'bat', 'evshsp', '*')) {

        my $fits=Util::FITSfile->new($file);
        my $tstart=$fits->keyword('TSTART');
        my $tstop =$fits->keyword('TSTOP');
        my $row={};
        $row->{START}=sprintf('%.06f',$tstart);
        $row->{DURATION}=$tstop-$tstart;
        $row->{MODE}='Event';
        
        push @rows, ($row);

        ##############################
        # calculate the exposure
        ##############################
        $unf_expo += $gtisum->command_line($file.'\[GTI\]')
                            ->run()
                            ->stdout();
    }

    ############################################
    # collect information about the dph files
    ############################################
    foreach my $file ($filename->get('rawdph', 'bat', '*', '*')) {

        my $fits=Util::FITSfile->new($file, 1);
        my $tstart=$fits->keyword('TSTART');
        my $tstop=$fits->keyword('TSTOP');
        my $row={};
        $row->{START}=sprintf('%.06f',$tstart);;
        $row->{DURATION}=$tstop-$tstart;
        $row->{MODE}='Survey';

        push @rows, ($row);

        $survey_expo += $fits->keyword('EXPOSURE');
    }

    ############################################
    # collect information about the rate files
    ############################################
    my ($tmin, $tmax) = (0, 0);
    foreach my $file ($filename->get('rawlc', 'bat', 'rt*', '*')) {
        my $fits=Util::FITSfile->new($file, 1);
        my $tstart=$fits->keyword('TSTART');
        my $tstop=$fits->keyword('TSTOP');
        my $row={};
        $row->{START}=sprintf('%.06f',$tstart);;
        $row->{DURATION}=$tstop-$tstart;
        $row->{MODE}=$fits->keyword('DATAMODE');

        push @rows, ($row);
    }

    my $rate_file = $filename->get('lightcurve', 'bat', 'ms', 0);
    if( -f $rate_file ){
      my $fits=Util::FITSfile->new($rate_file, 1);
      $rate_expo = $fits->keyword('EXPOSURE');
    } 

    ###############################################
    # collect information about the mask tag files
    ###############################################
    my @mt_files = $filename->get('mtlc', 'bat', '', '*');
    my $mt_count = @mt_files;
    foreach my $file (@mt_files) {
        my $fits=Util::FITSfile->new($file, 1);
        my $tstart=$fits->keyword('TSTART');
        my $tstop =$fits->keyword('TSTOP');
        my $row={};
        $row->{START}=sprintf('%.06f',$tstart);
        $row->{DURATION}=$tstop-$tstart;
        $row->{MODE}='Mask Tagged Source ' . $fits->keyword('CATNUM');

        push @rows, ($row);

	$masktag_expo += $fits->keyword('EXPOSURE');
    }

    #########################
    # now do the pulsar files
    #########################
    my @pl_files = $filename->get('pulsar', 'bat', '', '*');
    my $pl_count = @pl_files;
    foreach my $file (@pl_files) {
        my $fits=Util::FITSfile->new($file, 1);
        my $tstart=$fits->keyword('TSTART');
        my $tstop =$fits->keyword('TSTOP');
        my $row={};
        $row->{START}=sprintf('%.06f',$tstart);
        $row->{DURATION}=$tstop-$tstart;
        $row->{MODE}=$fits->keyword('DATAMODE');

        push @rows, ($row);

	$pulsar_expo += $fits->keyword('EXPOSURE');
    }

    ###########################################
    # and now the filtered event data
    ###########################################
    foreach my $file ($filename->get('event', 'bat', '*', '*')) {

        $evt_expo += $gtisum->command_line($file.'\[GTI\]')
                            ->run()
                            ->stdout();
    }
    
    ################################################
    # record the total exposures
    ################################################
    $log->entry("Total survey exposure $survey_expo");
    $log->entry("Total unfiltered event exposure $unf_expo");
    $log->entry("Total   filtered event exposure $evt_expo");
    
    $jobpar->set({bat_survey => sprintf('%.03f', $survey_expo),
                  bat_evt    => sprintf('%.03f', $evt_expo),
                  bat_unf    => sprintf('%.03f', $unf_expo),
		  bat_rate   => sprintf('%.03f', $rate_expo),
		  bat_mtag   => sprintf('%.03f', $masktag_expo),
		  bat_pulse  => sprintf('%.03f', $pulsar_expo),
		  bat_n_mtag => $mt_count});

    ##############################
    # sort the table rows by time
    ##############################
    @rows = sort {$a->{START} <=> $b->{START} } @rows;

    #########################
    # write the HTML table 
    #########################
    $self->begin_table('Start Time',
                       'Duration (s)',
                       'Mode');
                       
    foreach my $row (@rows) {
    
        $self->table_row($row->{START}, $row->{DURATION}, $row->{MODE});
    }

    $self->end_table();

    $self->merge_maps;

} # end of body method



################################################################################
# create merged enable/disable and gain/offset maps for the observation
################################################################################
sub merge_maps
{
    my ($self) = @_;

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

    my $sequence = $jobpar->read('sequence');

    my $queuefile = "$sequence.queue";
    if (not -f $queuefile) {
        $log->error(1, "missing $queuefile: unable to merge gain offset files");
        return;
    }

    my $fh = FileHandle->new($queuefile);
    if (not $fh) {
        $log->error(1, "unable to open $queuefile [$!]");
        return;
    }

    my @lines = <$fh>;
    undef($fh);

    my @records;
    foreach my $line (@lines) {
        if ($line =~ /^B/) {
            my @fields = split(' ', $line);
            my @keys = qw(TAG SEQUENCE START STOP);
            if (@fields == 4) {
                my %record;
                @record{@keys} = @fields;
                push(@records, \%record);
            }
            else {
                $log->error(1,
                    "$queuefile has bogus record $line");
            }
        }
    }

    my @info = (
        {
            desc => 'gain offset',
            intype => 'bgaoff',
            outtype => 'gocb',
        },
        {
            desc => 'detector enable',
            intype => 'bdetflag',
            outtype => 'decb',
        },
    );

    foreach my $info (@info) {
        $info->{records} = \@records;
        $self->merge_maps_aux($info);
    }
}


sub merge_maps_aux
{
    my ($self, $info) = @_;

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

    my @collected;

    $log->entry("creating merged $info->{desc} map");

    foreach my $record (@{ $info->{records} }) {

        my $middle = ($record->{START} + $record->{STOP}) / 2;

        my $file = $filename->fetch_from_repository(
                    $info->{intype}, 'b', '', $middle);         

        if (not $file or not -f $file) {
            $log->entry("warning: no $info->{desc} map for time $middle");
        }
        else {
            push(@collected, [ $middle, $file ]);
        }
    }

    my $mergefile = $filename->get('hk', 'b', $info->{outtype}, 0);

    my @sorted = sort { $a->[0] <=> $b->[0] } @collected;
    my %unique;
    my @unique;

    foreach my $entry (@sorted) {
        my $path = $entry->[1];
        if (not $unique{$path}) {
            $unique{$path} = 1;
            push(@unique, $entry);
        }
    }

    if (not @unique) {
        $log->entry("warning: no $info->{desc} maps to merge");
    }
    elsif (@unique == 1) {
        my $copy = Util::HEAdas->new('ftcopy')
                ->params({
                    infile => $unique[0][1],
                    outfile => $mergefile,
                })
                ->run;

        if (not -f $mergefile) {
            $log->error(2,
                "unable to copy $unique[0][1] into $mergefile");
        }
    }
    else {
        my $infiles = join(',', map { $_->[1] } @unique);

        my $ftmerge = Util::HEAdas->new('ftmerge')
                ->params({
                    infile => $infiles,
                    outfile => $mergefile,
                })
                ->run;

        if (not -f $mergefile) {
            $log->error(2,
                "unable to merge $infiles into $mergefile");
        }
    }
}


1;