# Library of utility FUNCTIONS common to several modules.

package ModuleUtil;
use strict;
use English;
use Carp;
use ModuleResources;
use FITSUtils;
use File::Temp;
use Regexp::Common;
use List::Util qw(min max);

use vars qw( $VERSION );
$VERSION = 1.0;

#----------------------------
# output pattern of fimgstat
#----------------------------

#The sum of the selected image                 = 118590.000000
#The mean of the selected image                = 0.282422
#The standard deviation of the selected image  = 19.612485
#The number of points used in calculation      = 419904
#The minimum of selected image                 =    0.0
#The maximum of selected image                 = 5573.0
#The location of minimum is at pixel number    = (1,1)
#The location of maximum is at pixel number    = (325,322)

use vars qw( @Fimgstat_Patterns );
# Using an array rather than a hash because the input data is ordered
# so this will be quicker.
@Fimgstat_Patterns = (
	sum => qr/^The sum of the selected image\s*?=\s*?$RE{num}{real}{-keep}\s*$/
	,mean => qr/^The mean of the selected image\s*?=\s*?$RE{num}{real}{-keep}\s*$/
	,stddev => qr/^The standard deviation of the selected image\s*?=\s*?$RE{num}{real}{-keep}\s*$/
	,count => qr/^The number of points used in calculation\s*?=\s*?$RE{num}{int}{-keep}\s*?/
	,min => qr/^The minimum of selected image\s*?=\s*?$RE{num}{real}{-keep}\s*$/
	,max => qr/^The maximum of selected image\s*?=\s*?$RE{num}{real}{-keep}\s*$/
	,minpos => qr/^The location of minimum is at pixel number\s*?=\s*?\(($RE{num}{int},$RE{num}{int})\)\s*$/
	,maxpos => qr/^The location of maximum is at pixel number\s*?=\s*?\(($RE{num}{int},$RE{num}{int})\)\s*$/
);


#------------------------------
# output pattern of fstatistic
#------------------------------

# The sum of the selected column is                   0.0000000
# The mean of the selected column is                  0.0000000
# The standard deviation of the selected column is    0.0000000
# The minimum of selected column is                   0.0000000
# The maximum of selected column is                   0.0000000
# The number of points used in calculation is             4347

use vars qw( @Fstatistic_Patterns );
# Using an array rather than a hash because the input data is ordered
# so this will be quicker.
@Fstatistic_Patterns = (
	sum => qr/^\s*The sum of the selected column is\s*$RE{num}{real}{-keep}\s*$/
	,mean => qr/^\s*The mean of the selected column is\s*$RE{num}{real}{-keep}\s*$/
	,stddev => qr/^\s*The standard deviation of the selected column is\s*$RE{num}{real}{-keep}\s*$/
	,min => qr/^\s*The minimum of selected column is\s*$RE{num}{real}{-keep}\s*$/
	,max => qr/^\s*The maximum of selected column is\s*$RE{num}{real}{-keep}\s*$/
	,count => qr/^\s*The number of points used in calculation is\s*?$RE{num}{int}{-keep}\s*?/
);

sub isSourceOnChip
{
	# Use echeckregion to determine if a source is within the detector window or not.
    # Sometimes a source extraction region clips a chip giving enough events
    # to pass the .non-zero' events test but there is no RMF as the source is
    # in a void.
	# Returns : 1 = onchip, 0 = offchip
	my ($srcexp , $table , $output) = @_;

	my $status = &doCommand(
		'echeckregion'
		, srcexp => $srcexp
		, table => $table
		, output => $output
	) or exception();

	my $rtn = 0;

	if ( &fileExists( file => $output ) )
	{
		my $fh;
		open($fh , "<$output")
				or Exception->error('FILESYSTEM','Unable to open echeckregion output file.' , $output )
		;
		my @tmp = grep /Status\s+of\s+the\s+centre\s+of\s+the\s+input\s+region\s+is:/,(<$fh>);
		close($fh);

		if (@tmp)
		{
			$tmp[0] =~ /Status\s+of\s+the\s+centre\s+of\s+the\s+input\s+region\s+is:\s*(\d+)/;
			$rtn = $1;
		}
		# else assume the answr is no (0).
	}
	else
	{
		Msg->info("Unable to find output from echeckregion.");
		exception();
	}

	return $rtn;
}

sub parseFimgstatOutput
{
	my $f = shift;

	Exception->error('BADMETHODCALL','Called with non-existant file: ' , $f )
		unless ( -f $f )
	;

	# Search the output from fimgstat for what we want
	my $fh;
	open($fh , "<$f")
		or Exception->error('FILESYSTEM','Unable to open fimgstat output file.' , $f )
	;
	my @tmpstats = <$fh>;
	close($fh);

	my %h;
	my $i = 0;
	foreach my $line (@tmpstats)
	{
		for ( ; $i< @Fimgstat_Patterns ; $i+=2 )
		{
			my @q = $line =~ $Fimgstat_Patterns[$i+1];
			next unless @q;
			if ($q[0] !~ /,/)
			{
				$h{ $Fimgstat_Patterns[$i] } = $q[0];
			}
			else
			{
				$h{ $Fimgstat_Patterns[$i] } = [ split /,/,$q[0] ];
			}
			last;
		}
	}

	return %h;
}


sub getImageStats
{
# Call fimgstat and put the results into a hash
    my ($imgFile , $statFile) = @_;
    $statFile ||= File::Temp->new()->filename();

    unless ( -f $statFile)
    {
        &doCommand (
             'fimgstat', infile => "$imgFile"
             , threshlo => 'INDEF'
             , threshup => 'INDEF'
             , outfile => "$statFile"
             , clobber => 'Y'
             , mode => 'ql'
             , sum => 0.0
             , mean => 0.0
             , rms => 0.0
             , num => 0
             , min => 0.0
             , max => 0.0
             , xmin => 0
             , ymin => 0
             , xmax => 0
             , ymax => 0
            ) or exception()
            ;
    }

    my %h = &parseFimgstatOutput( $statFile );

    return %h;
}


sub isImageEmpty
{
	# get context for error reporting.
#
# Use fimgstat to determine if a file has sufficient range for implot.
# Return 1 = empty |0 = not empty
#
    my ($imgFile , $statFile) = @_;
    my $isEmpty = 0;
    my %h = &getImageStats($imgFile,$statFile);
    unless (defined $h{max} && defined $h{min} )
    {
        # We didn't find what we expected to find.
        Exception->error('FIMGSTAT','Unable to parse fimgstat output.');
    }

    if ( !$h{max}  ||  ( $h{max} - $h{min} ) <= 1.0 )
    {
        Msg->info("The image $imgFile is empty.");
        $isEmpty = 1;
    }

	return $isEmpty;
}




sub isImageLimit
{
#
# Use fimgstat to determine if image has sufficient counts for subsequent analysis
# Return 1 = below limit |0 = equal or above limit
# $imgLimit is number of limiting counts
    my ($imgFile , $statFile, $imgLimit) = @_;
    my $isLimit = 0;
    my %h = &getImageStats($imgFile,$statFile);
    unless (defined $h{max} && defined $h{min} )
    {
        # We didn't find what we expected to find.
        Exception->error('FIMGSTAT','Unable to parse fimgstat output.');
    }

    if ( $h{sum} < $imgLimit )
    {
	my $sum = $h{sum};
        Msg->info("The image $imgFile has $sum total counts, below limit $imgLimit");
        $isLimit = 1;
    }

	return $isLimit;
}






sub insertdb
{
	# Attatch an arbitrary data structure to the sequence database.
	# The structure can be retrieved using the given key.
	# Once created given key,value pair become read only.
	# %d = ()
	my ($key,$data) = (@_);

	# Turn an array reference key into a usable key
	if (UNIVERSAL::isa($key,'ARRAY') )
	{
		$key = join(':',@$key);
	}

	if (exists $ModuleResources::Seqdb->{_moduledb}{$key})
	{
		Exception->error("Attempt to amend read-only module database entry");
	}	

	$ModuleResources::Seqdb->{_moduledb}{$key} = Storable::dclone($data);
	return $key;
}

sub selectdb
{
	# Attatch an arbitrary data structure to the sequence database.
	# The structure can be retrieved using the given key.
	# Once created given key,value pair become read only.
	# %d = ()
	my ($key,$data) = (@_);

	# Turn an array reference key into a usable key
	if ( UNIVERSAL::isa($key,'ARRAY') )
	{
		$key = join(':',@$key);
	}

	if (exists $ModuleResources::Seqdb->{_moduledb}{$key})
	{
		return $ModuleResources::Seqdb->{_moduledb}{$key};
	}	
	return undef;
}

sub keepSafe
{
	# %d = ( file_identifier => [] , text => [] )
	# fileid == enough to find an existing file or create a new one.
	my %d = (@_);
	my $rtn = 0;

	my $safe = findFile( @{$d{file_identifier}} );
	unless ( $safe && fileExists($safe) )
	{
		$safe = newFile( @{$d{file_identifier}} );
	}

	if ($safe)
	{
		my @d = @{ $d{text} };
		foreach my $d (@d) { $d .= "\n"; }
		writeASCIIFile( name => $safe 
			, text => \@d
			, append => 1
		);
		$rtn = 1;
		
	}
	return $rtn;
}

sub ontimeFix
{
	my ($output , @image) = (@_);

	my @ontime = qw(
		ONTIME01 
		ONTIME02
		ONTIME03
		ONTIME04
		ONTIME05
		ONTIME06
		ONTIME07
		ONTIME08
		ONTIME09
		ONTIME10
		ONTIME11
		ONTIME12
	);

	Msg->mark();
	my %ontime = ();
	my $exposure = 0;

	foreach my $img (@image)
	{
		next unless -f $img;
		foreach my $kw ( @ontime )
		{
			my @opt = ($img,'PRIMARY',$kw);
			next unless FITSUtils::hasKeyword(@opt);
			my $v = FITSUtils::readKeyword(@opt);
			$ontime{$kw} += FITSUtils::readKeyword(@opt);;
			if ($exposure < $ontime{$kw})
			{
				$exposure = $ontime{$kw};
			}
		}
	}

	unless (keys %ontime)
	{
		Msg->info("No ONTIME values in input images.");
	}	
	return (%ontime , EXPOSURE => $exposure);
}


sub pnLowGainWarn
{
	my ( $file , $h ) = @_;

	my @ext = qw(
		EXPOSU01
		EXPOSU02
		EXPOSU03
		EXPOSU04
		EXPOSU05
		EXPOSU06
		EXPOSU07
		EXPOSU08
		EXPOSU09
		EXPOSU00
		EXPOSU11
		EXPOSU12
	);

	my @warn;
	foreach my $ext ( @ext )
	{
		next unless ( FITSUtils::hasExtension( $file , $ext ) ); 
		foreach my $kw (qw( GAINCAME WARN_106 ))
		{
			my @opt = ( $file , $ext , $kw );
			if ( FITSUtils::hasKeyword( @opt ) )
			{
				$h->{$ext}{$kw} = FITSUtils::readKeyword(@opt); 
			}
		}
		push @warn , $ext if ( ($h->{$ext}{GAINCAME} && $h->{$ext}{GAINCAME} eq 'LOW' ) 
			&& ( $h->{$ext}{WARN_106} && $h->{$ext}{WARN_106} =~ /CCDlowGain/i )
		);
	}
	return @warn;
}


sub select_rgssources
{
	my ($file , $extension , $haveEpicList , $rate_cutoff ) = (@_);

	# Select additional EPIC sources for spectral extraction from the RGS source list.
	# Returns a source selection expression for passing to rgsregions. 
	# Also works 

	my $primesrc = readFITSKeyword(
		file => $file
		, extension => $extension
		, keyword => "PRIMESRC"
	);
	my @idx;

	# Only if we are playing with an EPIC source list.
	# Doesn't make sense otherwise.
	if ( $haveEpicList )
	{
		my $data = readFITSTable(
			file => $file
			, extension => $extension 
			, colname => [qw( INDEX LABEL RATE FLAG )]
		);
		
		my $processables = 0;
		my $hasepic = 0;
		for my $i ( 0 .. $data->{-nrows} -1 )
		{
			# Skipables.
			# avoid where:
			# 	FLAG set
			#   avoid duplicating the PRIMESRC 
			#   too faint.
			#   non-EPIC source (PROPOSAL, ONAXIS , WHOLEFIELD etc)

			# Make sure it is processable.
			next if ( ( $data->{FLAG}[$i] ne 0 )
				|| ( $data->{LABEL}[$i] !~ /EPIC/ )
			);

			# Record the fact we have any EPIC sources at all.
			$hasepic ||= 1;

			next unless ( $data->{RATE}[$i] >  $rate_cutoff );
			# Count EPIC sources which pass the above.
			$processables++;
			
			# but avoid adding EPIC PRIMESRC to the list.
			next if ( $data->{INDEX}[$i] eq $primesrc  );
			push @idx, $i;
		}

		# Sort the list of indexes on RATE
		@idx = sort { $data->{RATE}[$a] <=> $data->{RATE}[$b] } @idx;
		#convert @idx to INDEX column values.
		@idx = map { $data->{INDEX}[$_]; }  @idx;

		doCommand('addattribute'
			, set => "$file:SRCLIST"
			, attributename => [ 'EPMINRTE' , 'EPRGSRCN' ]
			, attributetype => [ 'real' , 'integer' ]
			, attributecomment => [
				'EPIC source RATE Threshold'
				,'Number of EPIC source within RGS FOV and RATE > EPMINRTE and FLAG 0'
			]
			,integervalue => $processables
			,realvalue => $rate_cutoff
		) or exception();
	}
	my @rtn = (@idx) 
		? ( "INDEX==#PRIMESRC || INDEX==$idx[-1]" , $primesrc , $idx[-1] )
		: ( "INDEX==#PRIMESRC" , $primesrc )
	;
	return @rtn;
}

sub get_rgssources_param
{
	my ($file, $extension , $instrument) = (@_);

	# Select sources from RGS source list so details can be recorded in the source spectra

	my $primesrc = readFITSKeyword( file => $file
		, extension => $extension
		, keyword => "PRIMESRC"
	);
	my %rtn;

	my $data = readFITSTable(
		file => $file
		, extension => $extension
		, colname => [qw( INDEX LABEL RA DEC RATE PROCESS FLAG )]
	);
	
	my $processables = 0;
	my $hasepic = 0;
	for my $i ( 0 .. $data->{-nrows} -1 )
	{
		# Skipables.
		# avoid where:
		# 	FLAG set
		#   avoid duplicating the PRIMESRC 
		#   too faint.
		#   non-EPIC source (PROPOSAL, ONAXIS , WHOLEFIELD etc)

		# Make sure it is processable.
		next if ( ( $data->{PROCESS}[$i] =~ /$RE{boolean}{false}/i )
			|| ( ! hasFITSExtension( file => $file
			, extension => "${instrument}_SRC".$data->{INDEX}[$i]."_SPATIAL"
		)));
		
		# Keep EPIC source details to be recorded in the spectrum headers.
		$rtn{ $data->{INDEX}[$i] } = { 
				INDEX => $data->{INDEX}[$i] 
				,LABEL => $data->{LABEL}[$i] 
				,RA =>  $data->{RA}[$i] 
				,DEC =>  $data->{DEC}[$i] 
				,RATE =>  $data->{RATE}[$i] 
				,PROCESS =>  $data->{PROCESS}[$i] 
				,FLAG =>  $data->{FLAG}[$i] 
		};
	}

	return %rtn;
}





sub parseFstatisticOutput
{
	my $f = shift;

	Exception->error('BADMETHODCALL','Called with non-existant file: ' , $f )
		unless ( -f $f )
	;

	# Search the output from fstatistic for what we want
	my $fh;
	open($fh , "<$f")
		or Exception->error('FILESYSTEM','Unable to open fstatistic output file.' , $f )
	;
	my @tmpstats = <$fh>;
	close($fh);

	my %h;
	my $i = 0;
	foreach my $line (@tmpstats)
	{
		for ( ; $i< @Fstatistic_Patterns ; $i+=2 )
		{
			my @q = $line =~ $Fstatistic_Patterns[$i+1];
			next unless @q;
			if ($q[0] !~ /,/)
			{
				$h{ $Fstatistic_Patterns[$i] } = $q[0];
			}
			else
			{
				$h{ $Fstatistic_Patterns[$i] } = [ split /,/,$q[0] ];
			}
			last;
		}
	}

	return %h;
}

sub isColumnEmpty
{
	# get context for error reporting.
#
# Use fstatistic to determine if a table column is identically 0
# Return 1 = empty |0 = not empty
#

    my ($inFile , $colName, $statFile) = @_;
    my $isEmpty = 0;
    $statFile ||= File::Temp->new()->filename();

    unless ( -f $statFile)
    {
        &doCommand (
                    'fstatistic', infile => "$inFile"
                    , colname => "$colName"
                    , rows => "-"
                    , outfile => "$statFile"
                    ) or exception()
                    ;
    }

    my %h = &parseFstatisticOutput( $statFile );
    unless (defined $h{max} && defined $h{min} )
    {
        # We didn't find what we expected to find.
        Exception->error('FSTATISTIC','Unable to parse fstatistic output.');
    }

    if ( ($h{max}==0) &&  ($h{min}==0) )
    {
        Msg->info("The column $colName of $inFile is identically 0.");
        $isEmpty = 1;
    }

    return $isEmpty;
}


sub hasColumnNegValues
{
#
# Check if some value in column is negative
# Return 1 = Column[x] < 0 | 0 otherwise
#
# Remove NaN's before min test

    my ($file, $ext, $colname) = @_;
    my $colHasNegVal = 0;

    my $columnValues = readFITSColumn(
       file => $file
       , extension => $ext
       , column => $colname
       );

    # Remove NaN's from columnValues before getting min value
    my @columnValuesNew;
    foreach my $val (@$columnValues){
         push(@columnValuesNew, $val) unless ($val =~/NaN/i);
    }

    if (@columnValuesNew){

       my $columnValuesMin = min(@columnValuesNew);

       if ( $columnValuesMin < 0 ){ $colHasNegVal = 1; }

    } else {$colHasNegVal = 1;}

    return $colHasNegVal;
}


# Modules like ExpDetect were not originally set up for mosaics,
# although in principle they might be OK if the individual pointings
# are all very close to one another. This subroutine simply checks a
# reference image to determine whether its angular extent is larger
# than 0.82 deg along either axis as a simple test of whether it is a
# large mosaic or not.
#
# Limit size as input parameter ($sizeLimit). Default value: 0.82 deg (JVP)
sub isSmallMap
{
    #my $imFile = $_[0];
    my ($imFile , $sizeLimit) = @_;
    if (!$sizeLimit){ $sizeLimit = 0.82; }

    my $status = 0;

    return $status unless $imFile;

    #my $cunit1 = readFITSKeyword(file => $imFile, extension => 1, keyword => 'CUNIT1');
    #my $cunit2 = readFITSKeyword(file => $imFile, extension => 1, keyword => 'CUNIT2');
    #
    #Exception->error('Module', 'Supplied image file has the wrong axis units:', $imFile)
    #    unless ( ($cunit1 =~ m/deg/i) and ($cunit2 =~ m/deg/i) );

    info( "Warning: not checking units since some maps are lacking CUNIT keywords (e.g., expposure maps)");

    my $xsize = readFITSKeyword(file => $imFile, extension => 1, keyword => 'CDELT1') *
        readFITSKeyword(file => $imFile, extension => 1, keyword => 'NAXIS1');

    my $ysize = readFITSKeyword(file => $imFile, extension => 1, keyword => 'CDELT2') *
        readFITSKeyword(file => $imFile, extension => 1, keyword => 'NAXIS2');

    $xsize = abs($xsize);
    $ysize = abs($ysize);

    $status = 1 if ($xsize < $sizeLimit) and ($ysize < $sizeLimit);

    info("Dimensions of the test image $imFile are $xsize x $ysize. sizeLimit: $sizeLimit. isSmallMap=$status.");

    return $status;
}

# Basic statistics functions
# mean
sub mean {
    my (@data) = @_;
    my $sum;
    foreach (@data) {
        $sum += $_;
    }
    return ( $sum / @data );
}

# median
sub median {
    my (@data) = sort { $a <=> $b } @_;
    if ( scalar(@data) % 2 ) {
        return ( $data[ @data / 2 ] );
    } else {
        my ( $upper, $lower );
        $lower = $data[ @data / 2 ];
        $upper = $data[ @data / 2 - 1 ];
        return ( mean( $lower, $upper ) );
    }
}


# Function to read all the coefficients from EPICModes.fits file
# ( 'Observing modes Pileup and OoT data' )
# 2020-08-31  New column included 'max_rate_uhb'
#
sub coefficients {
    my ($file) = @_;

    my $dataPileupOoT = readFITSTable(
                                      file => $file
                                      , extension => 'EPICModes'
                                      , colname => [qw( INST PHSMODE MODE SASMODE A B C Deadtime pup_limit cnts_limit Modes_2 LifetimeOoT  FractionOoT max_rate_uhb)]
                                      );

    my %modes_pileup_data;
    for my $i ( 0 .. $dataPileupOoT->{-nrows} -1 ){
        my $inst        = $dataPileupOoT->{INST}[$i];
        my $phsmode     = $dataPileupOoT->{PHSMODE}[$i];
        my $mode        = $dataPileupOoT->{MODE}[$i];
        my $sasmode     = $dataPileupOoT->{SASMODE}[$i];
        my $A           = $dataPileupOoT->{A}[$i];
        my $B           = $dataPileupOoT->{B}[$i];
        my $C           = $dataPileupOoT->{C}[$i];
        my $Deadtime    = $dataPileupOoT->{Deadtime}[$i];
        my $pup_limit   = $dataPileupOoT->{pup_limit}[$i];
        my $cnts_limit  = $dataPileupOoT->{cnts_limit}[$i];
        my $Modes_2     = $dataPileupOoT->{Modes_2}[$i];
        my $LifetimeOoT = $dataPileupOoT->{LifetimeOoT}[$i];
        my $FractionOoT = $dataPileupOoT->{FractionOoT}[$i];
        my $max_rate_uhb = $dataPileupOoT->{max_rate_uhb}[$i];

        if ( $inst =~ /E1/ || $inst =~ /E2/ || $inst =~ /E3/){
             my $inst_;
             if ($inst =~ /E1/){$inst_ = 'EMOS1';}
             if ($inst =~ /E2/){$inst_ = 'EMOS2';}
             if ($inst =~ /E3/){$inst_ = 'EPN';}

             #my $inst_sasmode = $inst_ . "_" . $sasmode;
             #$modes_pileup_data{$inst_sasmode} = [$A, $B, $C, $Deadtime, $pup_limit, $cnts_limit];

	     $modes_pileup_data{$inst_}{$sasmode}{'a'}          = $A;
	     $modes_pileup_data{$inst_}{$sasmode}{'b'}          = $B;
	     $modes_pileup_data{$inst_}{$sasmode}{'c'}          = $C;
	     $modes_pileup_data{$inst_}{$sasmode}{'Deadtime'}   = $Deadtime;
	     $modes_pileup_data{$inst_}{$sasmode}{'pup_limit'}  = $pup_limit;
	     $modes_pileup_data{$inst_}{$sasmode}{'cnts_limit'} = $cnts_limit;

	     $modes_pileup_data{$inst_}{$sasmode}{'Modes_2'}     = $Modes_2;
	     $modes_pileup_data{$inst_}{$sasmode}{'LifetimeOoT'} = $LifetimeOoT;
	     $modes_pileup_data{$inst_}{$sasmode}{'FractionOoT'} = $FractionOoT;
	     $modes_pileup_data{$inst_}{$sasmode}{'max_rate_uhb'} = $max_rate_uhb;

        }
    }

    return %modes_pileup_data;

}



# sub to read a OM source list and
# get SRCID, RA_CORR and DEC_CORR from sources in the file
# that have at least one filter with a non-null count rate
# <filter>_CORR_RATE
sub readOMSrcList {
        my ($file) = @_;

        my @cols = qw( SRCID RA_CORR DEC_CORR );
        my @filters = qw( V B U UVW1 UVM2 UVW2 );
        foreach my $i (@filters){
            push @cols, $i . "_CORR_RATE";
        }

        my $data = readFITSTable(
                file => $file
                , extension => 'SRCLIST'
                , colname => [@cols]
                );
        my %srcList;
        for my $i ( 0 .. $data->{-nrows} -1 ){
            my $srcid        = $data->{SRCID}[$i];
            my $ra_corr      = $data->{RA_CORR}[$i];
            my $dec_corr     = $data->{DEC_CORR}[$i];
            #
            my $v_corr_rate     = $data->{V_CORR_RATE}[$i];
            my $b_corr_rate     = $data->{B_CORR_RATE}[$i];
            my $u_corr_rate     = $data->{U_CORR_RATE}[$i];
            my $uvw1_corr_rate  = $data->{UVW1_CORR_RATE}[$i];
            my $uvm2_corr_rate  = $data->{UVM2_CORR_RATE}[$i];
            my $uvw2_corr_rate  = $data->{UVW2_CORR_RATE}[$i];

            # Skip Sources with null rates in all filters
            if ( (defined($v_corr_rate) && $v_corr_rate !~ /NaN/) ||
                 (defined($b_corr_rate) && $b_corr_rate !~ /NaN/) ||
                 (defined($u_corr_rate) && $u_corr_rate !~ /NaN/) ||
                 (defined($uvw1_corr_rate) && $uvw1_corr_rate !~ /NaN/) ||
                 (defined($uvm2_corr_rate) && $uvm2_corr_rate !~ /NaN/) ||
                 (defined($uvw2_corr_rate) && $uvw2_corr_rate !~ /NaN/) ) {

                 #if ( $v_corr_rate    =~ /NaN/ && $b_corr_rate    =~ /NaN/ && $u_corr_rate    =~ /NaN/  &&
                 #     $uvw1_corr_rate =~ /NaN/ && $uvm2_corr_rate =~ /NaN/ && $uvw2_corr_rate =~ /NaN/ ){
                 #     next ; }

                 $srcList{$srcid}{'ra_corr'}   = $ra_corr;
                 $srcList{$srcid}{'dec_corr'}  = $dec_corr;
            }
        }

        return %srcList;
}

# sub to read a EPIC source list and
# get SRC_NUM, possible OM counterparts (OM_ID[1-5]), and SPECTRA, TSERIES
sub readEPICSrcList {
        my ($file) = @_;

        my $data = readFITSTable(
                file => $file
                , extension => 'SRCLIST'
                , colname => [qw( SRC_NUM OM_ID1 OM_ID2 OM_ID3 OM_ID4 OM_ID5 SPECTRA TSERIES)]
                #, colname => [@cols]
                );

        my %EPICsrcList;
        for my $i ( 0 .. $data->{-nrows} -1 ){
            my $src_num     = $data->{SRC_NUM}[$i];
            my $om_id1      = $data->{OM_ID1}[$i];
            my $om_id2      = $data->{OM_ID2}[$i];
            my $om_id3      = $data->{OM_ID3}[$i];
            my $om_id4      = $data->{OM_ID4}[$i];
            my $om_id5      = $data->{OM_ID5}[$i];
            my $spectra     = $data->{SPECTRA}[$i];
            my $tseries     = $data->{TSERIES}[$i];

            $EPICsrcList{$src_num}{'om_id1'}   = $om_id1;
            $EPICsrcList{$src_num}{'om_id2'}   = $om_id2;
            $EPICsrcList{$src_num}{'om_id3'}   = $om_id3;
            $EPICsrcList{$src_num}{'om_id4'}   = $om_id4;
            $EPICsrcList{$src_num}{'om_id5'}   = $om_id5;
            $EPICsrcList{$src_num}{'spectra'}  = $spectra;
            $EPICsrcList{$src_num}{'tseries'}  = $tseries;

        }

        return %EPICsrcList;
}


# sub to read the REGION extension from any
# any file with that extension
sub readRegion {
   my %d=@_;
   # Check arguments
   Exception->error('BADMETHODCALL',"Filename not supplied")
   unless $d{'file'};

   my $file=$d{'file'};

   my $region = readFITSTable(
                file => $file
                , extension => 'REGION'
                , colname => [qw( SHAPE X Y R )]
                );

   my %reg;
        for my $i ( 0 .. $region->{-nrows} -1 ){
            my $shape = $region->{SHAPE}[$i];
            my $x     = $region->{X}[$i];
            my $y     = $region->{Y}[$i];
            my $r     = $region->{R}[$i];

        $reg{'shape'}      = $shape;
        $reg{'x'}          = $x;
        $reg{'y'}          = $y;
        $reg{'r'}          = $r;
        }

   return %reg
}

# Get OM Filter shortname from filter
#
use vars qw( %Filters );
my %Filters = (
        'BLOCKED' => '9'
        , 'V' => 'V'
        , 'U' => 'U'
        , 'B' => 'B'
        , 'WHITE' => 'W'
        , 'GRISM2' => 'G'
        , 'GRISM1' => 'H'
        , 'UVW1' => 'L'
        , 'UVW2' => 'S'
        , 'UVM2' => 'M'
);
sub getfiltershortname
{
        my ($c,$f) = (@_);
        $f = uc($f);
        return exists(  $Filters{$f} )
                ? $Filters{$f}
                : exception( Exception->('BADOMFILTER','Unrecognized filter :',$f) );
        ;
}





1;