File Coverage

blib/lib/Throwable.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch	1	4	25.0
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	32	37	86.4

package Throwable;
# ABSTRACT: a role for classes that can be thrown
$Throwable::VERSION = '0.201';
use Moo::Role;
use Sub::Quote ();
use Scalar::Util ();
use Carp ();

#pod =head1 SYNOPSIS
#pod
#pod   package Redirect;
#pod   # NOTE: Moo can also be used here instead of Moose
#pod   use Moose;
#pod   with 'Throwable';
#pod
#pod   has url => (is => 'ro');
#pod
#pod ...then later...
#pod
#pod   Redirect->throw({ url => $url });
#pod
#pod =head1 DESCRIPTION
#pod
#pod Throwable is a role for classes that are meant to be thrown as exceptions to
#pod standard program flow.  It is very simple and does only two things: saves any
#pod previous value for C<$@> and calls C.
#pod
#pod Throwable is implemented with L, so you can stick to Moo or use L,
#pod as you prefer.
#pod
#pod =attr previous_exception
#pod
#pod This attribute is created automatically, and stores the value of C<$@> when the
#pod Throwable object is created.  This is done on a I.  C<$@> is
#pod subject to lots of spooky action-at-a-distance.  For now, there are clearly
#pod ways that the previous exception could be lost.
#pod
#pod =cut

our %_HORRIBLE_HACK;

has 'previous_exception' => (
  is       => 'ro',
  default  => Sub::Quote::quote_sub(q<
    if (defined $Throwable::_HORRIBLE_HACK{ERROR}) {
      $Throwable::_HORRIBLE_HACK{ERROR}
    } elsif (defined $@ and (ref $@ or length $@)) {
      $@;
    } else {
      undef;
    }
  >),
);

#pod =method throw
#pod
#pod   Something::Throwable->throw({ attr => $value });
#pod
#pod This method will call new, passing all arguments along to new, and will then
#pod use the created object as the only argument to C.
#pod
#pod If called on an object that does Throwable, the object will be rethrown.
#pod
#pod =cut

sub throw {
  my ($inv) = shift;

  if (Scalar::Util::blessed($inv)) {
    Carp::confess "throw called on Throwable object with arguments" if @_;
    die $inv;
  }

  local $_HORRIBLE_HACK{ERROR} = $@;
  my $throwable = $inv->new(@_);
  die $throwable;
}

#pod =method new_with_previous
#pod
#pod   die Something::Throwable->new_with_previous({ attr => $value });
#pod
#pod Constructs an exception object and return it, while trying to mae sure that any
#pod values in $@ are safely stored in C without being stomped
#pod by evals in the construction process.
#pod
#pod This is more reliable than calling C directly, but doesn't include the
#pod forced C in C.
#pod
#pod =cut

sub new_with_previous { local $_HORRIBLE_HACK{ERROR} = $@; shift->new(@_) }

no Moo::Role;
1;

__END__