view release on metacpan or  search on metacpan

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

package Astro::FITS::CFITSIO::Utils;

# ABSTRACT: FITS utility routines

use v5.10;
use strict;
use warnings;

our $VERSION = '0.14';

use Astro::FITS::Header::Item;

{
    package    #
      Astro::FITS::CFITSIO::Utils::Item;

    use parent 'Astro::FITS::Header::Item';

    sub new {
        my $class = shift;
        $class = ref $class || $class;

        my ( $keyw, $value );
        # clean up input list, removing things that the superclass won't
        # understand. must be a better way to do this.
        my %args;
        my @o_args = @_;
        my @args;

        while ( ( $keyw, $value ) = splice( @o_args, 0, 2 ) ) {
            if ( $keyw =~ /^(?:hdu_num|)$/i ) {
                $args{ lc $keyw } = $value;
            }
            else {
                push @args, $keyw, $value;
            }
        }

        my $self = $class->SUPER::new( @args );

        # handle the attributes that we know about
        $self->$keyw( $value ) while ( ( $keyw, $value ) = each %args );

        return $self;
    }

    sub hdu_num {
        my $self = shift;
        if ( @_ ) {
            $self->{hdu_num} = uc( shift );
        }
        return $self->{hdu_num};
    }

}

use Astro::FITS::Header::CFITSIO;
use Astro::FITS::CFITSIO qw[ READONLY CASEINSEN
  ANY_HDU ASCII_TBL BINARY_TBL
  BAD_HDU_NUM END_OF_FILE
];
use Astro::FITS::CFITSIO::CheckStatus;
use Params::Validate qw( validate_with SCALAR );

use parent 'Exporter';

our %EXPORT_TAGS = (
    'all' => [ qw(
          keypar
          keyval
          colkeys
          croak_status
        ) ] );

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


sub _croak {
    require Carp;
    goto &croak;
}

# Preloaded methods go here.

# this is just a convenience wrapper around keypar
sub keyval {
    my $opts = ( @_ && 'HASH' eq ref $_[-1] ) ? pop @_ : undef;

    keypar( @_, { defined $opts ? %$opts : (), Value => 1 } );
}



#  $k1 = keypar( $file, $kw1 );
#   implicit OnePerHDU = 1, Accumulate = 0
#   $k1 = first matching card

#  @k =  keypar( $file, $kw1 );
#   implicit OnePerHDU = 0, Accumulate = 1