File Coverage

blib/lib/Data/Seek/Exception.pm

Criterion	Covered	Total	%
statement	29	35	82.8
branch			n/a
condition	0	3	0.0
subroutine	8	11	72.7
pod	0	6	0.0
total	37	55	67.2

# Data::Seek Exception Class
package Data::Seek::Exception;

use Data::Dumper ();
use Scalar::Util ();

use Data::Object::Class;

use overload fallback => 1, '""' => \&as_string;

our $VERSION = '0.06'; # VERSION

has 'code', is => 'ro';
has 'file', is => 'ro';
has 'line', is => 'ro';

has 'message' => (
    is      => 'ro',
    default => sub { 'An exception occurred in class (' . ref(shift) . ')' },
    lazy    => 1
);

has 'package',    is => 'ro';
has 'subroutine', is => 'ro';

sub as_string {
    my $self = shift;

    return sprintf "%s at %s line %s\n",
        $self->message, $self->file, $self->line;
}

sub caught {
    my $class = shift;
    my $e     = shift;

    return ! ref $class
        && Scalar::Util::blessed($e)
        && UNIVERSAL::isa($e, $class);
}

sub dumper {
    local $Data::Dumper::Terse = 1;
    return Data::Dumper::Dumper(pop);
}

sub rethrow {
    die shift;
}

sub throw {
    my ($class, %args) = @_;

    $args{subroutine} = (caller(1))[3];
    $args{package}    = (caller(0))[0];
    $args{file}       = (caller(0))[1];
    $args{line}       = (caller(0))[2];

    die $class->new(%args);
}

sub throw_subclass {
    my ($class, $subspace, %args) = @_;
    my $subclass = join '::', $class, $subspace;

    # gen exception sub-class dynamically if not loaded
    eval "package ${subclass}; use parent '@{[$class]}'; 1;";

    # throw generated exception
    @_ = ($class, %args);
    goto $subclass->can('throw');
}

1;