File Coverage

lib/Unexpected/TraitFor/Throwing.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	14	14	100.0
condition	5	5	100.0
subroutine	12	12	100.0
pod	4	4	100.0
total	75	75	100.0

package Unexpected::TraitFor::Throwing;

use namespace::autoclean;

use Carp                    ( );
use English               qw( -no_match_vars );
use Scalar::Util          qw( blessed );
use Unexpected::Functions qw( is_one_of_us parse_arg_list );
use Unexpected::Types     qw( Maybe Object );
use Moo::Role;

requires qw( BUILD );

# Private functions
my $_cache_key = sub {
   # uncoverable branch true
   return $PID.'-'.(exists $INC{ 'threads.pm' } ? threads->tid() : 0);
};

my $_exception_cache = {};

# Public attributes. Lifted from Throwable
has 'previous_exception' => is => 'ro', isa => Maybe[Object],
   builder               => sub { $_exception_cache->{ $_cache_key->() } };

# Construction
after 'BUILD' => sub {
   my $self = shift; my $e = $self->clone; delete $e->{previous_exception};

   $_exception_cache->{ $_cache_key->() } = $e;

   return;
};

# Private methods
my $_is_object_ref = sub {
   my ($self, @args) = @_; blessed $self or return 0;

   scalar @args and Carp::confess
      'Trying to throw an Exception object with arguments';
   return 1;
};

# Public methods
sub caught {
   my ($self, @args) = @_;

   $self->$_is_object_ref( @args ) and return $self;

   my $attr  = parse_arg_list @args;
   my $error = $attr->{error} ||= $EVAL_ERROR; $error or return;

   return (is_one_of_us $error) ? $error : $self->new( $attr );
}

sub clone {
   my ($self, $args) = @_;

   my $class = blessed $self or $self->throw( 'Clone is an object method' );

   return bless { %{ $self }, %{ $args // {} } }, $class;
}

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

   $self->$_is_object_ref( @args ) and die $self;
   is_one_of_us $args[ 0 ]         and die $args[ 0 ];
                                       die $self->new( @args );
}

sub throw_on_error {
   my $e; $e = shift->caught( @_ ) and die $e; return;
}

1;

__END__