view release on metacpan or  search on metacpan

lib/Astro/FITS/Header/NDF.pm  view on Meta::CPAN

containing multiple NDFs at the top level, either the .HEADER NDF or
the first NDF containing a FITS header is deemed to be the primary
header, and all other headers a subsidiary headers indexed by the name
of the NDF in the container.

It stores information about a FITS header block in an object. Takes an
hash as an argument, with either an array reference pointing to an
array of FITS header cards, array of C<Astro::FITS::Header::Item>
objects, or a filename, or (alternatively) an NDF identifier.

Currently, subheader support is readonly.

=cut

use strict;
use Carp;
use File::Spec;
use NDF qw/ :ndf :dat :err :hds :msg /;

use base qw/ Astro::FITS::Header /;

use vars qw/ $VERSION /;

$VERSION = '3.09';

=head1 METHODS

=over 4

=item B<configure>

Reads a FITS header from an NDF.

  $hdr->configure( Cards => \@cards );
  $hdr->configure( ndfID => $indf );
  $hdr->configure( File => $filename );

Accepts an NDF identifier or a filename. If both C<ndfID> and C<File> keys
exist, C<ndfID> key takes priority.

If the file is actually an HDS container, an attempt will be made
to read a ".HEADER" NDF inside that container (this is the standard
layout of UKIRT (and some JCMT) data files). If an extension is specified
explicitly (that is not ".sdf") that path is treated as an explicit path
to an NDF. If an explicit path is specified no attempt is made to locate
other NDFs in the HDS container.

If the NDF can be opened successfully but there is no .MORE.FITS
extension, an empty header is returned rather than throwing an error.

=cut

sub configure {
  my $self = shift;

  my %args = @_;

  my ($indf, $started);
  my $task = ref($self);

  return $self->SUPER::configure(%args)
    if exists $args{Cards} or exists $args{Items};

  # Store the definition of good locally
  my $status = &NDF::SAI__OK;
  my $good = $status;


  # Start error system (this may be the first time we hit
  # starlink)
  err_begin( $status );

  # did we start NDF
  my $ndfstarted;
  my $FileName = "";

  # Read the args hash
  if (exists $args{ndfID}) {
    $indf = $args{ndfID};

    # Need to work out the file name
    ndf_msg( "NDF", $indf );
    msg_load( " ", "^NDF", $FileName, my $len, $status );

  } elsif (exists $args{File}) {
    # Remove trailing .sdf
    my $file = $args{File};
    $FileName = $file;
    $file =~ s/\.sdf$//;

    # NDF currently (c.2008) has troubles with spaces in paths
    # we work around this by changing to the directory before
    # opening the file
    my ($vol, $dir, $root) = File::Spec->splitpath( $file );
    my $cwd;
    if ($dir =~ /\s/) {
      # only bother if there is a space
      $cwd = File::Spec->rel2abs( File::Spec->curdir );
      # if the chdir fails we will try to open the file
      # with NDF anyway using the path. Otherwise we change the
      # filename to be the root
      if (chdir($dir)) {
        $file = $root;
      }
    }

    # Start NDF
    ndf_begin();
    $ndfstarted = 1;

    # First we need to find whether we have an HDS container or a
    # straight NDF. Rather than simply trying an ndf_find on both
    # (which causes leaks in the NDF system circa 2001) we explicitly
    # open it using HDS unless it has a "." in it.
    if ($file =~ /\./) {
      # an NDF
      ndf_find(&NDF::DAT__ROOT(), $file, $indf, $status);
    } else {
      # Try HDS
      hds_open( $file, 'READ', my $hdsloc, $status);

lib/Astro/FITS/Header/NDF.pm  view on Meta::CPAN

        if (defined $cwd) {
          chdir($cwd) or carp "Could not return to current working directory";
        }


      }
    }

  } else {

    $status = &NDF::SAI__ERROR;
    err_rep(' ',
            "$task: Argument hash does not contain ndfID, File or Cards",
            $status);

  }

  if ($status == $good) {

    # See if the extension exists
    ndf_xstat( $indf, "FITS", my $there, $status);

    if ($status == $good && $there) {

      # Find the FITS extension
      ndf_xloc($indf, 'FITS', 'READ', my $xloc, $status);

      if ($status == $good) {

        # Variables...
        my (@dim, $ndim, $nfits, $maxdim);

        # Get the dimensions of the FITS array
        # Should only be one-dimensional
        $maxdim = 7;
        dat_shape($xloc, $maxdim, @dim, $ndim, $status);

        if ($status == $good) {

          if ($ndim != 1) {
            $status = &SAI__ERROR;
            err_rep(' ',"$task: Dimensionality of FITS array should be 1 but is $ndim", $status);

          }

        }

        # Set the FITS array to empty
        my @fits = ();     # Note that @fits only exists in this block

        # Read the FITS extension
        dat_get1c($xloc, $dim[0], @fits, $nfits, $status);

        # Annul the locator
        dat_annul($xloc, $status);

        # Check status and read into hash
        if ($status == $good) {

          # Parse the FITS array
          $self->SUPER::configure( Cards => \@fits );

        } else {

          err_rep(' ',"$task: Error reading FITS array", $status);

        }

      } else {

        # Add my own message to status
        err_rep(' ', "$task: Error locating FITS extension",
                $status);
      }
    } elsif ($status != $good) {
      err_rep(' ', "$task: Error determining presence of FITS extension",
              $status);
    } else {
      # simply is not there but file is okay
    }

    # Close the NDF identifier (if we opened it)
    ndf_annul($indf, $status) if exists $args{File};
  }

  # Shutdown
  ndf_end($status) if $ndfstarted;

  # Handle errors
  if ($status != $good) {
    my ( $oplen, @errs );
    do {
      err_load( my $param, my $parlen, my $opstr, $oplen, $status );
      push @errs, $opstr;
    } until ( $oplen == 1 );
    err_annul($status);
    err_end( $status );
    croak "Error during header read from NDF $FileName:\n" . join "\n", @errs;
  }
  err_end($status);

  # It is possible to annul the errors before exiting if we want
  # or to flush them out.
  return;

}


=item B<writehdr>

Write a FITS header to an NDF.

  $hdr->writehdr( ndfID => $indf );
  $hdr->writehdr( File => $file );

Accepts an NDF identifier or a filename.  If both C<ndfID> and C<File> keys
exist, C<ndfID> key takes priority.

Throws an exception (croaks) on error.

=cut