view release on metacpan or  search on metacpan

CheckStatus.pm  view on Meta::CPAN

package Astro::FITS::CFITSIO::CheckStatus;

use 5.006;
use strict;
use warnings;

use Carp;

our $VERSION = '0.03';


sub TIESCALAR
{
  my $class = shift;

  my $self = bless {}, $class;

  # the next argument tells us how to croak
  $self->set_croak( @_ ? shift : \&Carp::croak );

  $self->{value} = 0;
  $self->utxt( undef );
  $self->{etxt} = undef;
  $self->reset_ustr( 1 );
  $self->reset_usub( 1 );

  $self;
}

sub FETCH
{
  $_[0]->{value};
}

sub STORE
{
  require Scalar::Util;

  if ( defined $_[1] && ! ref $_[1] && Scalar::Util::looks_like_number( $_[1] ) )
  {
    # set to non-zero value
    if ( $_[0]->{value} = $_[1] )
    {
      require Astro::FITS::CFITSIO;

      Astro::FITS::CFITSIO::fits_get_errstatus($_[0]->{value}, $_[0]->{etxt});
      $_[0]->{croak}->( 
         defined $_[0]->{utxt} ? ( 'CODE' eq ref $_[0]->{utxt} ?
				   $_[0]->{utxt}->(@{$_[0]}{'value','etxt'}) :
				   $_[0]->{utxt}
				 ) : "CFITSIO error: ", $_[0]->{etxt} )
	if defined $_[0]->{croak};

    }

    # set to zero value
    else
    {
      $_[0]->{etxt} = undef;

      # reset utxt if the planets are aligned
      if ( 'CODE' eq ref $_[0]->{utxt} )
      {
	$_[0]->{utxt} = undef
	  if $_[0]->{reset_usub};
      }

      elsif ( $_[0]->{reset_ustr} )
      {
	$_[0]->{utxt} = undef;
      }
    }

  }

  else
  {
    $_[0]->{utxt} = $_[1];
  }
}

sub set_croak
{
  my $self = shift;

  my $old_croak = $self->{croak};

  if ( @_ )
  {
    my $croak = shift;

    # explicit undef to reset to no croaking?
    if ( ! defined $croak )
    {
      $self->{croak} = undef;
    }

    # Log::Log4perl::Logger object?
    elsif ( UNIVERSAL::isa( $croak, 'Log::Log4perl::Logger' ) )