view release on metacpan or  search on metacpan

lib/Astro/FITS/HdrTrans/UKIRTDB.pm  view on Meta::CPAN

  return $return;

}

=item B<to_SPEED_GAIN>

=cut

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;
}

=item B<to_STANDARD>

Converts either the C<STANDARD> header (if it exists) or uses the
C<OBJECT> or C<RECIPE> headers to determine if an observation is of a
standard.  If the C<OBJECT> header starts with either B<BS> or B<FS>,
I<or> the DR recipe contains the word STANDARD, it is assumed to be a
standard.

=cut

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;

}

=item B<to_UTDATE>

=cut

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

  if ( exists( $FITS_headers->{'UT_DATE'} ) ) {
    my $datestr = $FITS_headers->{'UT_DATE'};
    $return = _parse_date($datestr);
    die "Error parsing date \"$datestr\"" unless defined $return;
    $return = $return->strftime('%Y%m%d');
  }

  return $return;

}

=item B<to_UTSTART>

Strips the optional 'Z' from the C<DATE-OBS> header, or if that header does
not exist, combines the C<UT_DATE> and C<RUTSTART> headers into a unified
C<UTSTART> header.

=cut

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;
}

=item B<from_UTSTART>