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