view release on metacpan or  search on metacpan

lib/Astro/FITS/CFITSIO/Simple.pm  view on Meta::CPAN

sub validHDUTYPE { exists $HDUType{ lc $_[0] } }
sub validHDUNUM  { $_[0] =~ /^\d+$/ && $_[0] > 0 }



# these are the Params::Validate specifications for rdfits
# they are specified separately here, so that parameters
# for _rdfitsTable and _rdfitsImage can be split out
# from the main option hash

our %rdfits_spec = (
    extname => { type => SCALAR, optional => 1 },
    extver  => {
        type    => SCALAR,
        depends => 'extname',
        default => 0
    },
    hdunum => {
        type      => SCALAR,
        callbacks => { 'illegal HDUNUM' => \&validHDUNUM, },
        optional  => 1
    },
    hdutype => {
        type      => SCALAR,
        callbacks => { 'illegal HDU type' => \&validHDUTYPE, },
        default   => 'any',
        optional  => 1
    },
    resethdu => { type => SCALAR, default => 0 },
);

sub rdfits {

    # strip off the options hash
    my $opts = 'HASH' eq ref $_[-1] ? pop : {};

    # first arg is fitsfilePtr or filename
    my $input = shift;

    croak( "input must be a fitsfilePtr or a file name\n" )
      unless defined $input
      && ( UNIVERSAL::isa( $input, 'fitsfilePtr' ) || !ref $input );


    # rdfits is a dispatch routine; we need to filter out the options
    # for the delegates (and vice versa).  final argument validation
    # is done by the the delegates

    # shallow copy, then delete non-rdfits options.
    my %rdfits_opts = %{$opts};
    delete @rdfits_opts{
        grep { !exists $rdfits_spec{ lc( $_ ) } }
          keys %rdfits_opts
    };

    # shallow copy, then delete rdfits options
    my %delegate_opts = %{$opts};
    delete @delegate_opts{ keys %rdfits_opts };

    # if there are additional arguments, guess that we're being
    # asked for some columns, and set the requested HDUTYPE to table
    $rdfits_opts{hdutype} = 'table' if @_;

    # validate arguments
    my %opt = validate_with(
        params         => [ \%rdfits_opts ],
        normalize_keys => sub { lc $_[0] },
        spec           => \%rdfits_spec
    );



    # CFITSIO file pointer
    my $fptr;

    tie my $status, 'Astro::FITS::CFITSIO::CheckStatus';

    my $cleanup;

    # get CFITSIO file pointer
    if ( UNIVERSAL::isa( $input, 'fitsfilePtr' ) ) {

        $fptr = $input;

        $cleanup = Astro::FITS::CFITSIO::Simple::Cleanup->new(
            fptr    => $fptr,
            packing => $fptr->perlyunpacking
        );

        if ( $opt{resethdu} ) {
            $fptr->get_hdu_num( my $hdunum );
            $cleanup->set( hdunum => $hdunum );
        }

    }
    else {
        $fptr = Astro::FITS::CFITSIO::open_file( $input, READONLY,
            $status = "could not open FITS file '$input'" );
    }

    # we're not unpacking;
    $fptr->perlyunpacking( 0 );

    # read in all of the extensions
    croak( "slurp not yet implemented!\n" )
      if $opt{slurp};

    # read in just one
    my $hdutype;

    # HDU specified by name
    if ( exists $opt{extname} ) {
        $fptr->movnam_hdu( ANY_HDU, $opt{extname}, $opt{extver},
            $status = "could not move to HDU '$opt{extname}:$opt{extver}'" );

        $fptr->get_hdu_type( $hdutype, $status );

        croak( "requested extension does not match requested HDU type\n" )
          unless match_hdutype( $opt{hdutype}, $hdutype );
    }