view release on metacpan or  search on metacpan

lib/Bio/NEXUS/Util/Exceptions.pm  view on Meta::CPAN

		$skip++;
	}
	return $skip;
}

# fields in frame:
#  [
#  0   'main',
# +1   '/Users/rvosa/Desktop/exceptions.pl',
# +2   102,
# +3   'Object::this_dies',
#  4   1,
#  5   undef,
#  6   undef,
#  7   undef,
#  8   2,
#  9   'UUUUUUUUUUUU',
# +10  bless( {}, 'Object' ),
# +11  'very',
# +12  'violently'
#  ],

sub as_string {
	my $self = shift;
	my $string = "";
	for my $frame ( @$self ) {
		my $method = $frame->[3];
		my @args;
		for my $i ( 10 .. $#{ $frame } ) {
			push @args, $frame->[$i];
		}
		my $file = $frame->[1];
		my $line = $frame->[2];
		no warnings 'uninitialized';
		$string .= $method . "(" . join(', ', map { "'$_'" } @args ) . ") called at $file line $line\n";
	}
	return $string;
}

package Bio::NEXUS::Util::Exceptions;
BEGIN {
	require Exporter;
	use vars qw($AUTOLOAD @EXPORT_OK @ISA);
	@ISA=qw(Exporter);
	@EXPORT_OK=qw(throw);
}
use strict;
use overload 'bool' => sub { 1 }, 'fallback' => 1, '""' => \&as_string;

sub new {
	my $class = shift;
	my %args = @_;
	my $self = {
		'error'       => $args{'error'},
		'description' => $args{'description'},
		'trace'       => Bio::NEXUS::Util::StackTrace->new,
		'time'        => CORE::time(),
		'pid'         => $$,
		'uid'         => $<,
		'euid'        => $>,
		'gid'         => $(,
		'egid'        => $),
	};
	return bless $self, $class;
}

sub as_string {
	my $self = shift;
	my $error = $self->error;
	my $description = $self->description;
	my $class = ref $self;
	my $trace = join "\n", map { "STACK: $_" } split '\n', $self->trace->as_string;
	return <<"ERROR_HERE_DOC";
-------------------------- EXCEPTION ----------------------------
Message: $error

An exception of type $class
was thrown.

$description

Refer to the Bio::NEXUS::Util::Exceptions documentation for more
information.
------------------------- STACK TRACE ---------------------------
$trace	
-----------------------------------------------------------------
ERROR_HERE_DOC
}

sub throw ($$) {
	# called as static method
	if ( scalar @_ == 3 ) {
		my $class = shift;
		my $self = $class->new(@_);
		die $self;	
	}
	# called as function, e.g. throw BadArgs => 'msg';
	elsif ( scalar @_ == 2 ) {
		my $type = shift;
		my $class = __PACKAGE__ . '::' . $type;
		my $self;
		eval {
			$self = $class->new( 'error' => shift );
		};
		if ( $@ ) {
			die Bio::NEXUS::Util::Exceptions::API->new( 'error' => "Can't throw errors of type $type: $@" );
		}
		else {
			die $self;
		}
	}
}

sub rethrow {
	my $self = shift;
	die $self;
}

sub caught {
	my $class = shift;
	if ( @_ ) {
		$class = shift;