view release on metacpan or  search on metacpan

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

        ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.20';

# cheap and dirty clean up object so that we can maintain
# return contexts in rdfits and its delegates by having
# cleanup done during object destruction
{
    package Astro::FITS::CFITSIO::Simple::Cleanup;

    sub new { my $class = shift; bless {@_}, $class }
    sub set { $_[0]->{ $_[1] } = $_[2] }
    sub DESTROY {
        my $s = shift;
        tie my $status, 'Astro::FITS::CFITSIO::CheckStatus';
        $s->{fptr}->perlyunpacking( $s->{packing} )
          if defined $s->{packing};
        $s->{fptr}->movabs_hdu( $s->{hdunum}, undef, $status )
          if defined $s->{hdunum};
    }
}



# HDU types we recognize
our %HDUType = (
    img    => IMAGE_HDU,
    image  => IMAGE_HDU,
    binary => BINARY_TBL,
    bintbl => BINARY_TBL,
    ascii  => ASCII_TBL,
    any    => ANY_HDU,
    table  => undef,        # the CFITSIO flags aren't really bits
);

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(