view release on metacpan or  search on metacpan

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

package Bio::Phylo::Util::Exceptions;
use strict;
use warnings;
use base 'Exporter';
use Bio::Phylo::Util::StackTrace;
use Scalar::Util 'blessed';
use overload 'bool' => sub { 1 }, 'fallback' => 1, '""' => \&as_string;
our ( @EXPORT_OK, $AUTOLOAD ) = qw'throw';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {

        #		'error'       => $args{'error'},
        #		'description' => $args{'description'},
        'trace' => Bio::Phylo::Util::StackTrace->new,
        'time'  => CORE::time(),
        'pid'   => $$,
        'uid'   => $<,
        'euid'  => $>,
        'gid'   => $(,
        'egid'  => $),
        %args
    };
    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::Phylo::Util::Exceptions documentation for more
information.
------------------------- STACK TRACE ---------------------------
$trace	
-----------------------------------------------------------------
ERROR_HERE_DOC
}

sub throw (@) {

    # called as static method, with odd args
    my $self;
    if ( scalar @_ % 2 ) {
        my $class = shift;
        $self = $class->new(@_);
    }

    # called as function, with even args e.g. throw BadArgs => 'msg';
    else {
        my $type  = shift;
        my $class = __PACKAGE__ . '::' . $type;
        if ( $class->isa('Bio::Phylo::Util::Exceptions') ) {
            $self = $class->new( 'error' => shift, @_ );
        }
        else {
            $self = Bio::Phylo::Util::Exceptions::Generic->new(
                'error' => shift,
                @_
            );
        }
    }

    # 	if ( not $ENV{'PERL_DL_NONLAZY'} ) {
    # 		require Bio::Phylo;
    # 		$Bio::Phylo::Util::Logger::TRACEBACK = 1;
    # 		my $logger = Bio::Phylo->get_logger();
    # 		$logger->error($self->error);
    # 		$Bio::Phylo::Util::Logger::TRACEBACK = 0;
    # 	}