File Coverage

Bio/Prospect/CBT/Exception.pm

Criterion	Covered	Total	%
statement	40	49	81.6
branch	9	24	37.5
condition	2	9	22.2
subroutine	11	12	91.6
pod	6	6	100.0
total	68	100	68.0

=head1 NAME

CBT::Exception -- base class for exceptions
S<$Id: Exception.pm,v 1.2 2003/05/12 22:24:00 rkh Exp $>

=head1 SYNOPSIS

 package MyModule::Exception;
 use base CBT::Exception;

 package MyModule;
 ...
 if ($failed)
   { throw MyModule::Exception; }
 ...


=head1 DESCRIPTION

B<CBT::Exception> is a base class for exceptions.  It may be used
as-is or as a base class for other exceptions.  It is based on Error.pm
with enhancements for providing more informative feedback and run-time
control of feedback levels.

At the time of this writing, one really needs two components to use
exceptions: 1) an exception class, 2) the language extensions which enable
the try...catch...finally syntax.  This module provides a base class for
(1); `use CBT::Exceptions' for (2).

A B<CBT::Exception> instance has these attributes:

=over 4

=item error

error is a short (1 line) description of the problem.  Consider using $!
if nothing else.

=item detail (optional)

detail provides more details about the nature of the problem.  The
contents of this field are word-wrapped.

=item advice (optional)

advice provides advice about how to rememdy the error.  The contents of
this field are word-wrapped.

=back 4

When thrown, a B<CBT::Exception> looks like this:

 ! MyModule::Exception occurred: invalid argument
 Detail: you provided 0 for your IQ; the valid range is 1..10
 Advice: soak your head

=head1 ROUTINES & METHODS

=cut


package CBT::Exception;
use strict;
use warnings;

use CBT::debug;
our $VERSION = CBT::debug::RCSVersion( '$Revision: 1.2 $ ' );
CBT::debug::identify_file() if ($CBT::debug::trace_uses);

use base qw(Error);
use Text::Wrap;
use Carp;

our $show_stacktrace = $CBT::debug || $ENV{EX_STACKTRACE} || 0;
our $show_advice = exists $ENV{EX_ADVICE} ? $ENV{EX_ADVICE} : 1;


sub new
  {
=pod

=over

=item B<::new( {error=E<gt>...,
                detail=E<gt>...,
                advice=E<gt>...} )>

=item B<::new( error, detail, advice )>

creates a new exception with the spe

=back

=cut
  my $self = shift;
  my %ex;
  if (ref $_[0])							# throw Ex ( {...} )
	{
	%ex = %{$_[0]};
	$ex{error} = $ex{text} if not exists $ex{error} and exists $ex{text};
	}
  else										# throw Ex (  ...  )
	{
	$ex{error} = shift if @_;
	$ex{detail} = shift if @_;
	$ex{advice} = shift if @_;
	}

  if (not defined $ex{error})
	{
	if ($!)
	  { $ex{error} = $! }
	else
	  {
	  croak("Exception created without error string\n") if $ENV{DEBUG};
	  $ex{error} = 'unknown error';
	  }
	}
  #$ex{detail} = $! if (not defined $ex{detail} and $!);


  my @args = ();
  local $Error::Debug = exists $ex{stacktrace} ? $ex{stacktrace}
	: $show_stacktrace;
  local $Error::Depth = $Error::Depth + 1;
  $self->SUPER::new(%ex, @args);
  }



## INTERNAL FUNCTIONS
sub stringify($)
  {
  my $self = shift;
  my $r = "! " . (ref($self)||$self) . " occurred: " . $self->error() . "\n";
  if ( $self->detail() )
	{ $r .= "Detail:" . wrap("\t", "\t", $self->detail()) . "\n" }
  if ( $show_advice and $self->advice() )
	{ $r .= "Advice:" . wrap("\t", "\t", $self->advice()) . "\n" }
  if ( $show_stacktrace )
	{ $r .= "Trace:\t" . $self->stacktrace() . "\n"; }
  return $r;
  }
sub error($)   { $_[0]->{error};  }
sub detail($)  { $_[0]->{detail}; }
sub advice($)  { $_[0]->{advice}; }

# backward compatibility
sub text($)    { $_[0]->error();  }


1;



=pod

=head1 SEE ALSO

Error.pm -- where all the hard work's done

=head1 AUTHOR

 Reece Hart E<lt>[e-mail]<gt>
 http://www.in-machina.com/~reece/

=cut



## TODO-
## -- on-the-fly exception class creation, e.g.,
##    throw YetUnamedException ('you blew it') by overloading throw?
## -- consider carefully which exception classes to generate
##    perhaps Dave could research this, using java and python as examples
## -- -level field to control severity w/ run-time control of
##    warning level and fatal level thresholds.