Astro::FITS::HdrTrans::UKIRTDB - UKIRT Database Table translations

  %generic_headers = translate_from_FITS(\%FITS_headers, \@header_array);

  %FITS_headers = transate_to_FITS(\%generic_headers, \@header_array);

 $Id$

package Astro::FITS::HdrTrans::UKIRTDB;

use 5.006;
use warnings;
use strict;
use Carp;

use Time::Piece;

# Inherit from Base
use base qw/ Astro::FITS::HdrTrans::JAC /;

use vars qw/ $VERSION /;

# Note that we use %02 not %03 because of historical reasons
$VERSION = "1.50";

# for a constant mapping, there is no FITS header, just a generic
# header that is constant
my %CONST_MAP = (
                 COORDINATE_UNITS => 'degrees',
                );

# NULL mappings used to override base class implementations
my @NULL_MAP = ();

# unit mapping implies that the value propogates directly
# to the output with only a keyword name change

my %UNIT_MAP = (
                AIRMASS_START        => "AMSTART",
                AIRMASS_END          => "AMEND",
                CAMERA               => "CAMLENS",
                CAMERA_NUMBER        => "CAMNUM",
                CONFIGURATION_INDEX  => "CNFINDEX",
                DEC_BASE             => "DECBASE",
                DEC_SCALE            => "PIXELSIZ",
                DEC_TELESCOPE_OFFSET => "DECOFF",
                DETECTOR_READ_TYPE   => "MODE",
                DR_GROUP             => "GRPNUM",
                DR_RECIPE            => "RECIPE",
                EQUINOX              => "EQUINOX",
                FILTER               => "FILTER",
                FILENAME             => "FILENAME",
                GAIN                 => "DEPERDN",
                GRATING_DISPERSION   => "GDISP",
                GRATING_ORDER        => "GORDER",
                INSTRUMENT           => "INSTRUME",
                NUMBER_OF_COADDS => 'NEXP',
                NUMBER_OF_EXPOSURES  => "NEXP",
                OBJECT               => "OBJECT",
                OBSERVATION_MODE     => "INSTMODE",
                OBSERVATION_NUMBER   => "RUN",
                OBSERVATION_TYPE     => "OBSTYPE",
                PROJECT              => "PROJECT",
                RA_SCALE             => "PIXELSIZ",
                RA_TELESCOPE_OFFSET  => "RAOFF",
                TELESCOPE            => "TELESCOP",
                WAVEPLATE_ANGLE      => "WPLANGLE",
                Y_BASE               => "DECBASE",
                X_DIM                => "DCOLUMNS",
                Y_DIM                => "DROWS",
                X_OFFSET             => "RAOFF",
                Y_OFFSET             => "DECOFF",
                X_SCALE              => "PIXELSIZ",
                Y_SCALE              => "PIXELSIZ",
                X_LOWER_BOUND        => "RDOUT_X1",
                X_UPPER_BOUND        => "RDOUT_X2",
                Y_LOWER_BOUND        => "RDOUT_Y1",
                Y_UPPER_BOUND        => "RDOUT_Y2"
               );


# Create the translation methods
__PACKAGE__->_generate_lookup_methods( \%CONST_MAP, \%UNIT_MAP, \@NULL_MAP );

sub can_translate {
  my $self = shift;
  my $FITS_headers = shift;
  if (exists $FITS_headers->{TELESCOP}
      && $FITS_headers->{TELESCOP} =~ /UKIRT/
      && exists $FITS_headers->{FILENAME}
      && exists $FITS_headers->{RAJ2000}) {
    return 1;
  }
}

sub to_INST_DHS {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{DHSVER} ) ) {
    $FITS_headers->{DHSVER} =~ /^(\w+)/;
    my $dhs = uc($1);
    $return = $FITS_headers->{INSTRUME} . "_$dhs";
  } else {
    my $dhs = "UKDHS";
    $return = $FITS_headers->{INSTRUME} . "_$dhs";
  }

  return $return;

}

sub to_EXPOSURE_TIME {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{'EXPOSED'} ) && defined( $FITS_headers->{'EXPOSED'} ) ) {
    $return = $FITS_headers->{'EXPOSED'};
  } elsif ( exists( $FITS_headers->{'DEXPTIME'} ) && defined( $FITS_headers->{'DEXPTIME'} ) ) {
    $return = $FITS_headers->{'DEXPTIME'};
  } elsif ( exists( $FITS_headers->{'EXP_TIME'} ) && defined( $FITS_headers->{'EXP_TIME'} ) ) {
    $return = $FITS_headers->{'EXP_TIME'};
  }
  return $return;
}

sub to_COORDINATE_TYPE {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{EQUINOX})) {
    if ($FITS_headers->{EQUINOX} =~ /1950/) {
      $return = "B1950";
    } elsif ($FITS_headers->{EQUINOX} =~ /2000/) {
      $return = "J2000";
    }
  }
  return $return;
}

sub to_GRATING_NAME {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{GRATING})) {
    $return = $FITS_headers->{GRATING};
  } elsif (exists($FITS_headers->{GRISM})) {
    $return = $FITS_headers->{GRISM};
  }
  return $return;
}

sub to_GRATING_WAVELENGTH {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{GLAMBDA})) {
    $return = $FITS_headers->{GLAMBDA};
  } elsif (exists($FITS_headers->{CENWAVL})) {
    $return = $FITS_headers->{CENWAVL};
  }
  return $return;
}

sub to_SLIT_ANGLE {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{'SANGLE'})) {
    $return = $FITS_headers->{'SANGLE'};
  } elsif (exists($FITS_headers->{'SLIT_PA'} )) {
    $return = $FITS_headers->{'SLIT_PA'};
  }
  return $return;

}

sub to_SLIT_NAME {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{'SLIT'})) {
    $return = $FITS_headers->{'SLIT'};
  } elsif (exists($FITS_headers->{'SLITNAME'} )) {
    $return = $FITS_headers->{'SLITNAME'};
  }
  return $return;

}

sub to_SPEED_GAIN {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{'SPD_GAIN'} ) ) {
    $return = $FITS_headers->{'SPD_GAIN'};
  } elsif ( exists( $FITS_headers->{'WAVEFORM'} ) ) {
    if ( $FITS_headers->{'WAVEFORM'} =~ /thermal/i ) {
      $return = 'thermal';
    } else {
      $return = 'normal';
    }
  }
  return $return;
}

sub to_STANDARD {
  my $self = shift;
  my $FITS_headers = shift;

  # Set false as default so we do not have to repeat this in the logic
  # below (could just use undef == false)
  my $return = 0;               # default false

  if ( exists( $FITS_headers->{'STANDARD'} ) &&
       length( $FITS_headers->{'STANDARD'} . "") > 0 ) {

    if ($FITS_headers->{'STANDARD'} =~ /^[tf]$/i) {
      # Raw header read from FITS header
      $return = (uc($FITS_headers->{'STANDARD'}) eq 'T');
    } elsif ($FITS_headers->{'STANDARD'} =~ /^[01]$/) {
      # Translated header either so a true logical
      $return = $FITS_headers->{'STANDARD'};
    }

  } elsif ( ( exists $FITS_headers->{OBJECT} &&
              $FITS_headers->{'OBJECT'} =~ /^[bf]s/i ) ||
            ( exists( $FITS_headers->{'RECIPE'} ) &&
              $FITS_headers->{'RECIPE'} =~ /^standard/i
            )) {
    # Either we have an object with name prefix of BS or FS or
    # our recipe looks suspiciously like a standard.
    $return = 1;

  }

  return $return;

}

sub to_UTDATE {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{'UT_DATE'} ) ) {
    $return = Time::Piece->strptime( $FITS_headers->{'UT_DATE'}, "%b %d %Y %I:%M%p" );
    $return = $return->strftime('%Y%m%d');
  }

  return $return;

}

sub to_UTSTART {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{'DATE_OBS'} ) ) {
    my $dateobs = $FITS_headers->{'DATE_OBS'};
    $return = $self->_parse_iso_date( $dateobs );
  } elsif (exists($FITS_headers->{'UT_DATE'}) && defined($FITS_headers->{'UT_DATE'}) &&
           exists($FITS_headers->{'RUTSTART'}) && defined( $FITS_headers->{'RUTSTART'} ) ) {
    # Use the default UTDATE translation but insert "-" for ISO parsing
    my $ut = $self->to_UTDATE($FITS_headers);
    $ut = join("-", substr($ut,0,4), substr($ut,4,2), substr($ut,6,2));
    my $hour = int($FITS_headers->{'RUTSTART'});
    my $minute = int( ( $FITS_headers->{'RUTSTART'} - $hour ) * 60 );
    my $second = int( ( ( ( $FITS_headers->{'RUTSTART'} - $hour ) * 60) - $minute ) * 60 );
    $return = $self->_parse_iso_date( $ut . "T$hour:$minute:$second" );
  }

  return $return;
}

sub from_UTSTART {
  my $self = shift;
  my $generic_headers = shift;
  my %return_hash;
  if (exists($generic_headers->{UTSTART})) {
    my $t = _parse_date( $generic_headers->{'UTSTART'} );
    my $month = $t->month;
    $month =~ /^(.{3})/;
    $month = $1;
    $return_hash{'UT_DATE'} = $month . " " . $t->mday . " " . $t->year;
    $return_hash{'RUTSTART'} = $t->hour + ($t->min / 60) + ($t->sec / 3600);
    $return_hash{'DATE_OBS'} = $generic_headers->{'UTSTART'};
  }
  return %return_hash;
}

sub to_UTEND {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;

  if ( exists( $FITS_headers->{'DATE_END'} ) ) {
    my $dateend = $FITS_headers->{'DATE_END'};
    $return = $self->_parse_iso_date( $dateend );
  } elsif (exists($FITS_headers->{'UT_DATE'}) && defined($FITS_headers->{'UT_DATE'}) &&
           exists($FITS_headers->{'RUTEND'}) && defined( $FITS_headers->{'RUTEND'} ) ) {
    # Use the default UTDATE translation but insert "-" for ISO parsing
    my $ut = $self->to_UTDATE($FITS_headers);
    $ut = join("-", substr($ut,0,4), substr($ut,4,2), substr($ut,6,2));
    my $hour = int($FITS_headers->{'RUTEND'});
    my $minute = int( ( $FITS_headers->{'RUTEND'} - $hour ) * 60 );
    my $second = int( ( ( ( $FITS_headers->{'RUTEND'} - $hour ) * 60) - $minute ) * 60 );
    $return = $self->_parse_iso_date( $ut . "T$hour:$minute:$second" );
  }

  return $return;
}

sub from_UTEND {
  my $self = shift;
  my $generic_headers = shift;
  my %return_hash;
  if (exists($generic_headers->{UTEND})) {
    my $t = _parse_date( $generic_headers->{'UTEND'} );
    my $month = $t->month;
    $month =~ /^(.{3})/;
    $month = $1;
    $return_hash{'UT_DATE'} = $month . " " . $t->mday . " " . $t->year;
    $return_hash{'RUTEND'} = $t->hour + ($t->min / 60) + ($t->sec / 3600);
    $return_hash{'DATE_END'} = $generic_headers->{'UTEND'};
  }
  return %return_hash;
}

sub to_X_BASE {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{RABASE})) {
    $return = $FITS_headers->{RABASE} * 15;
  }
  return $return;
}

sub from_X_BASE {
  my $self = shift;
  my $generic_headers = shift;
  my %return_hash;
  if (exists($generic_headers->{X_BASE})) {
    $return_hash{'RABASE'} = $generic_headers->{X_BASE} / 15;
  }
  return %return_hash;
}

sub to_RA_BASE {
  my $self = shift;
  my $FITS_headers = shift;
  my $return;
  if (exists($FITS_headers->{RABASE})) {
    $return = $FITS_headers->{RABASE} * 15;
  }
  return $return;
}

sub from_RA_BASE {
  my $self = shift;
  my $generic_headers = shift;
  my %return_hash;
  if (exists($generic_headers->{RA_BASE})) {
    $return_hash{'RABASE'} = $generic_headers->{RA_BASE} / 15;
  }
  return %return_hash;
}

sub _fix_dates {
  my ( $class, $FITS_headers ) = @_;

  if( defined( $FITS_headers->{'DATE_OBS'} ) ) {
    $FITS_headers->{'DATE-OBS'} = $class->_parse_iso_date( $FITS_headers->{'DATE_OBS'} );
  }
  if( defined( $FITS_headers->{'DATE_END'} ) ) {
    $FITS_headers->{'DATE-END'} = $class->_parse_iso_date( $FITS_headers->{'DATE_END'} );
  }

}

sub _parse_date {
  my $date = shift;

  # If we already have a Time::Piece return
  return bless $date, "Time::Piece"
    if UNIVERSAL::isa( $date, "Time::Piece");

  # We can use Time::Piece->strptime but it requires an exact
  # format rather than working it out from context (and we don't
  # want an additional requirement on Date::Manip or something
  # since Time::Piece is exactly what we want for Astro::Coords)
  # Need to fudge a little

  my $format;

  # Need to disambiguate ISO date from Sybase date
  if ($date =~ /\d\d\d\d-\d\d-\d\d/) {
    # ISO

    # All arguments should have a day, month and year
    $format = "%Y-%m-%d";

    # Now check for time
    if ($date =~ /T/) {
      # Date and time
      # Now format depends on the number of colons
      my $n = ( $date =~ tr/:/:/ );
      $format .= "T" . ($n == 2 ? "%T" : "%R");
    }
  } elsif ($date =~ /^\d\d\d\d\d\d\d\d\b/) {
    # YYYYMMDD format
    $format = "%Y%m%d";
  } else {
    # Assume Sybase date
    # Mar 15 2002  7:04AM
    $format = "%b %d %Y %I:%M%p";

  }

  # Now parse
  # Note that this time is treated as "local" rather than "gm"
  my $time = eval { Time::Piece->strptime( $date, $format ); };
  if ($@) {
    return undef;
  } else {
    # Note that the above constructor actually assumes the date
    # to be parsed is a local time not UTC. To switch to UTC
    # simply get the epoch seconds and the timezone offset
    # and run gmtime
    # Sometime around v1.07 of Time::Piece the behaviour changed
    # to return UTC rather than localtime from strptime!
    # The joys of backwards compatibility.
    if ($time->[Time::Piece::c_islocal]) {
      my $tzoffset = $time->tzoffset;
      my $epoch = $time->epoch;
      $time = gmtime( $epoch + $tzoffset->seconds );
    }

  }

}

1;