Astro::FITS::Header::CFITSIO - Manipulates FITS headers from a FITS file

  use Astro::FITS::Header::CFITSIO;

  $header = new Astro::FITS::Header::CFITSIO( Cards => \@array );
  $header = new Astro::FITS::Header::CFITSIO( File => $file );
  $header = new Astro::FITS::Header::CFITSIO( fitsID => $ifits );

  $header->writehdr( File => $file );
  $header->writehdr( fitsID => $ifits );

package Astro::FITS::Header::CFITSIO;

# ---------------------------------------------------------------------------

# L O A D   M O D U L E S --------------------------------------------------

use strict;
use vars qw/ $VERSION /;

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

use Astro::FITS::CFITSIO qw / :longnames :constants /;
use Carp;

$VERSION = 3.01;

# C O N S T R U C T O R ----------------------------------------------------

sub configure {
  my $self = shift;

  my %args = ( ReadOnly => 0, @_ );

  # itialise the inherited status to OK.
  my $status = 0;
  my $ifits;

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

  # read the args hash
  if (exists $args{fitsID}) {
     $ifits = $args{fitsID};
  } elsif (exists $args{File}) {
     $ifits = Astro::FITS::CFITSIO::open_file( $args{File},
		  $args{ReadOnly} ? Astro::FITS::CFITSIO::READONLY() :
			            Astro::FITS::CFITSIO::READWRITE(),
					       $status );
  } else {
     croak("Arguement hash does not contain fitsID, File or Cards");
  }

  # file sucessfully opened?
  if( $status == 0 ) {

     # Get size of FITS header
     my ($numkeys, $morekeys);
     $ifits->get_hdrspace( $numkeys, $morekeys, $status);

     # Set the FITS array to empty
     my @fits = ();

     # read the cards. Note that CFITSIO doesn't include the END card
     # in it's counting
     for my $i (1 .. $numkeys) {
        $ifits->read_record($i, my $card, $status);
        push(@fits, $card);
     }

     # add an END card. previously this was extracted from CFITSIO
     # by reading an extra card.  however, the header may not have
     # been completed by CFITSIO, so that extra card might not exist.
     push @fits, Astro::FITS::Header::Item->new( Keyword => 'END')->card;

     if ($status == 0) {
        # Parse the FITS array
        $self->SUPER::configure( Cards => \@fits );
     } else {
        # Report bad exit status
        croak("Error $status reading FITS array");
     }

     # Look at the name of the file as it was passed in. If there is a FITS
     # extension specified, then this is a single fits image that you want
     # read.  If there isn't one specified, then we should read each of the
     # extensions that exist in the file, if in fact there are any.

     if ( exists $args{File} )
     {
       my $ext;
       fits_parse_extnum($args{File},$ext,$status);
       my @subfrms = ();
       if ($ext == -99) {
         my $nhdus;
         $ifits->get_num_hdus($nhdus,$status);
         foreach my $ihdu (1 .. $nhdus-1) {
	   my $subfr = sprintf("%s[%d]",$args{File},$ihdu);
	   my $sself = $self->new(File=>$subfr);
	   push @subfrms,$sself;
         }
       }
       $self->subhdrs(@subfrms);
     }
  }

  # clean up
  if ( $status != 0 ) {
     croak("Error $status opening FITS file");
  }

  # close file, but only if we opened it
  $ifits->close_file( $status )
    unless exists $args{fitsID};

  return;

}

# W R I T E H D R -----------------------------------------------------------

sub writehdr {
  my $self = shift;
  my %args = @_;

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

  # itialise the inherited status to OK.
  my $status = 0;
  my $ifits;

  # read the args hash
  if (exists $args{fitsID}) {
     $ifits = $args{fitsID};
  } elsif (exists $args{File}) {
     $ifits = Astro::FITS::CFITSIO::open_file( $args{File},
			 Astro::FITS::CFITSIO::READWRITE(), $status );
  } else {
     croak("Argument hash does not contain fitsID, File or Cards");
  }

  # file sucessfully opened?
  if( $status == 0 ) {

    # Get size of FITS header
    my ($numkeys, $morekeys);
    $ifits->get_hdrspace( $numkeys, $morekeys, $status);

    # delete the cards in the current header. as cards are deleted the
    # ones below it are shifted up (according to the CFITSIO docs).
    # we thus delete from the bottom up to avoid all of that work.
    $ifits->delete_record( $numkeys--, $status )
      while $numkeys;

    # write the new cards, not including END card if it exists
    my @cards = $self->cards;
    if ( defined (my $end_card = $self->index('END')) )
      { splice( @cards, $end_card, 1 ) }
    $ifits->write_record($_, $status ) foreach @cards;

  }

  # clean up
  if ( $status != 0 ) {
     croak("Error $status opening FITS file");
  }

  # close file, but only if we opened it
  $ifits->close_file( $status )
    unless exists $args{fitsID};

  return;

}

# T I M E   A T   T H E   B A R  --------------------------------------------

# L A S T  O R D E R S ------------------------------------------------------

1;