Preserve unblessed reference exceptions
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Exception.pm
1 package DBIx::Class::Exception;
2
3 use strict;
4 use warnings;
5
6 use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
7 use Try::Tiny;
8 use namespace::clean;
9
10 use overload
11     '""' => sub { shift->{msg} },
12     fallback => 1;
13
14 =head1 NAME
15
16 DBIx::Class::Exception - Exception objects for DBIx::Class
17
18 =head1 DESCRIPTION
19
20 Exception objects of this class are used internally by
21 the default error handling of L<DBIx::Class::Schema/throw_exception>
22 to prevent confusing and/or redundant re-application of L<Carp>'s
23 stack trace information.
24
25 These objects stringify to the contained error message, and use
26 overload fallback to give natural boolean/numeric values.
27
28 =head1 METHODS
29
30 =head2 throw
31
32 =over 4
33
34 =item Arguments: $exception_scalar, $stacktrace
35
36 =back
37
38 This is meant for internal use by L<DBIx::Class>'s C<throw_exception>
39 code, and shouldn't be used directly elsewhere.
40
41 Expects a scalar exception message.  The optional argument
42 C<$stacktrace> tells it to use L<Carp/longmess> instead of
43 L<Carp::Clan/croak>.
44
45   DBIx::Class::Exception->throw('Foo');
46   try { ... } catch { DBIx::Class::Exception->throw(shift) }
47
48 =cut
49
50 sub throw {
51     my ($class, $msg, $stacktrace) = @_;
52
53     # Don't re-encapsulate exception objects of any kind
54     die $msg if ref($msg);
55
56     # use Carp::Clan's croak if we're not stack tracing
57     if(!$stacktrace) {
58         try { croak $msg } catch { $msg = shift };
59     }
60     else {
61         $msg = Carp::longmess($msg);
62     }
63
64     my $self = { msg => $msg };
65     bless $self => $class;
66
67     die $self;
68 }
69
70 =head2 rethrow
71
72 This method provides some syntactic sugar in order to
73 re-throw exceptions.
74
75 =cut
76
77 sub rethrow {
78     die shift;
79 }
80
81 =head1 AUTHORS
82
83 Brandon L. Black <blblack@gmail.com>
84
85 =head1 LICENSE
86
87 You may distribute this code under the same terms as Perl itself.
88
89 =cut
90
91 1;