Astro-FITS-CFITSIO-CheckStatus

 view release on metacpan or  search on metacpan

CheckStatus.pm  view on Meta::CPAN

exception (via B<Carp::croak>) containing the B<CFITISO> error message
if the value is non-zero.  

The drawback to this approach is that only the (sometimes)
impenetrable B<CFITSIO> error message is available.  If the
tied variable is set equal to a string (which should not pass the
B<Scalar::Util::look_like_number()> test) or a subroutine, the string
or return value from the subroutine is prepended to the B<CFITSIO>
error message.  For example

  Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits',
	   Astro::FITS::CFITSIO::READONLY(), $status = "Bad Open:" );

will result in:

  Bad Open: CFITSIO error: could not open the named file

The prefixing value may also be specified with the the B<utxt()>
method (see L<Class Methods>).  Whenever the status variable is set to
zero, the prefixing value is forgotten.  As Astro::FITS::CFITSIO sets
the status variable (whether zero or not) after every call to a

t/croak.t  view on Meta::CPAN

use_ok 'Astro::FITS::CFITSIO::CheckStatus;';

use Astro::FITS::CFITSIO;

my $status;

# try the default croak
tie $status, 'Astro::FITS::CFITSIO::CheckStatus';
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(),$status );
};
ok ($@ && $@ =~ "CFITSIO error: could not open the named file");


untie $status;
# try a user defined croak like thing.
tie $status, 'Astro::FITS::CFITSIO::CheckStatus', 
  sub { die "An awful thing happened: @_" };

eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(),$status );
};
ok ($@ && $@ =~ "An awful thing");


# try the class method
tied($status)->set_croak( sub { die "A really awful thing happend: @_" } );
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(),$status );
};
ok ($@ && $@ =~ "A really awful thing");

t/etxt.t  view on Meta::CPAN

use Test::More tests => 2;

use_ok 'Astro::FITS::CFITSIO::CheckStatus;';

use Astro::FITS::CFITSIO;

tie my $status, 'Astro::FITS::CFITSIO::CheckStatus', undef;
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(), $status ) or
	   die( "Bad Open: ", tied($status)->etxt );
};
ok ($@ && $@ =~ "Bad Open.*: could not open the named file");

t/log4perl.t  view on Meta::CPAN

  Log::Log4perl::easy_init( { layout => '%l %m %n',
			      file => $file,
			    } );

  $logger = Log::Log4perl->get_logger;
  tie my $status, 'Astro::FITS::CFITSIO::CheckStatus', $logger;
  my $line;

  eval {
    $line = __LINE__ + 1;
    Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
				     Astro::FITS::CFITSIO::READONLY(),$status );
  };

  seek($file,0,0);
  local $/ = undef;
  my $txt = <$file>;

  ok( $@ && 
      $@ =~ /line $line/ && 
      $txt =~ m{t/log4perl.t \($line\)}, 'Log::Log4perl' );

t/utxt.t  view on Meta::CPAN

use Test::More tests => 8;

use_ok 'Astro::FITS::CFITSIO::CheckStatus;';

use Astro::FITS::CFITSIO;

my $status;

tie $status, 'Astro::FITS::CFITSIO::CheckStatus';
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(), $status = "Bad Open: " );
};

ok ($@ && $@ =~ "Bad Open: could not open the named file");

# check DON'T reset text
tied($status)->reset_ustr(0);
$status = 0;
ok( tied($status)->utxt eq "Bad Open: " );

t/utxt.t  view on Meta::CPAN

tied($status)->reset_ustr(1);
$status = 0;
ok( ! defined tied($status)->utxt );



untie $status;

tie $status, 'Astro::FITS::CFITSIO::CheckStatus';
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(), 
	   $status = sub { "CODE Bad Open: "}  );
};

ok ($@ && $@ =~ "CODE Bad Open: could not open the named file");

# check DON'T reset sub
tied($status)->reset_usub(0);
$status = 0;
ok( ref tied($status)->utxt eq 'CODE' );

# check DO reset text
tied($status)->reset_usub(1);
$status = 0;
ok( ! defined tied($status)->utxt );

# method call
tied($status)->utxt( "String utxt: " );
eval {
Astro::FITS::CFITSIO::open_file( 'file_does_not_exist.fits', 
	   Astro::FITS::CFITSIO::READONLY(), 
	   $status );
};

ok ($@ && $@ =~ "String utxt: could not open the named file");