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


line stmt bran cond sub pod time code
1             package Throwable;
2             # ABSTRACT: a role for classes that can be thrown
3             $Throwable::VERSION = '1.000';
4 1     1   10102 use Moo::Role;
  1         2  
  1         5  
5 1     1   951 use Sub::Quote ();
  1         5120  
  1         22  
6 1     1   6 use Scalar::Util ();
  1         2  
  1         13  
7 1     1   5 use Carp ();
  1         1  
  1         161  
8              
9             #pod =head1 SYNOPSIS
10             #pod
11             #pod package Redirect;
12             #pod # NOTE: Moo can also be used here instead of Moose
13             #pod use Moose;
14             #pod with 'Throwable';
15             #pod
16             #pod has url => (is => 'ro');
17             #pod
18             #pod ...then later...
19             #pod
20             #pod Redirect->throw({ url => $url });
21             #pod
22             #pod =head1 DESCRIPTION
23             #pod
24             #pod Throwable is a role for classes that are meant to be thrown as exceptions to
25             #pod standard program flow. It is very simple and does only two things: saves any
26             #pod previous value for C<$@> and calls C.
27             #pod
28             #pod Throwable is implemented with L, so you can stick to Moo or use L,
29             #pod as you prefer.
30             #pod
31             #pod =attr previous_exception
32             #pod
33             #pod This attribute is created automatically, and stores the value of C<$@> when the
34             #pod Throwable object is created. This is done on a I. C<$@> is
35             #pod subject to lots of spooky action-at-a-distance. For now, there are clearly
36             #pod ways that the previous exception could be lost.
37             #pod
38             #pod =cut
39              
40             our %_HORRIBLE_HACK;
41              
42             has 'previous_exception' => (
43             is => 'ro',
44             default => Sub::Quote::quote_sub(q<
45             if (defined $Throwable::_HORRIBLE_HACK{ERROR}) {
46             $Throwable::_HORRIBLE_HACK{ERROR}
47             } elsif (defined $@ and (ref $@ or length $@)) {
48             $@;
49             } else {
50             undef;
51             }
52             >),
53             );
54              
55             #pod =method throw
56             #pod
57             #pod Something::Throwable->throw({ attr => $value });
58             #pod
59             #pod This method will call new, passing all arguments along to new, and will then
60             #pod use the created object as the only argument to C.
61             #pod
62             #pod If called on an object that does Throwable, the object will be rethrown.
63             #pod
64             #pod =cut
65              
66             sub throw {
67 20     20 1 13553 my ($inv) = shift;
68              
69 20 50       71 if (Scalar::Util::blessed($inv)) {
70 0 0       0 Carp::confess "throw called on Throwable object with arguments" if @_;
71 0         0 die $inv;
72             }
73              
74 20         53 local $_HORRIBLE_HACK{ERROR} = $@;
75 20         492 my $throwable = $inv->new(@_);
76 20         125 die $throwable;
77             }
78              
79             #pod =method new_with_previous
80             #pod
81             #pod die Something::Throwable->new_with_previous({ attr => $value });
82             #pod
83             #pod Constructs an exception object and return it, while trying to mae sure that any
84             #pod values in $@ are safely stored in C without being stomped
85             #pod by evals in the construction process.
86             #pod
87             #pod This is more reliable than calling C directly, but doesn't include the
88             #pod forced C in C.
89             #pod
90             #pod =cut
91              
92 4     4 1 13424 sub new_with_previous { local $_HORRIBLE_HACK{ERROR} = $@; shift->new(@_) }
  4         104  
93              
94 1     1   6 no Moo::Role;
  1         1  
  1         6  
95             1;
96              
97             __END__