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/;
   7 use Scalar::Util qw/blessed/;
   8
   9 use overload
  10     '""' => sub { shift->{msg} },
  11     fallback => 1;
  12
  13 =head1 NAME
  14
  15 DBIx::Class::Exception - Exception objects for DBIx::Class
  16
  17 =head1 DESCRIPTION
  18
  19 Exception objects of this class are used in internally by
  20 he default error handling of L<DBIx::Class::Schema/throw_exception>
  21 to prevent confusing and/or redundant re-application of L<Carp>'s
  22 stack trace information.
  23
  24 These objects stringify to the contained error message, and use
  25 overload fallback to give natural boolean/numeric values.
  26
  27 =head1 METHODS
  28
  29 =head2 throw
  30
  31 =over 4
  32
  33 =item Arguments: $exception_scalar, $stacktrace
  34
  35 =back
  36
  37 This is meant for internal use by L<DBIx::Class>'s C<throw_exception>
  38 code, and shouldn't be used directly elsewhere.
  39
  40 Expects a scalar exception message.  The optional argument
  41 C<$stacktrace> tells it to use L<Carp/longmess> instead of
  42 L<Carp::Clan/croak>.
  43
  44   DBIx::Class::Exception->throw('Foo');
  45   eval { ... }; DBIx::Class::Exception->throw($@) if $@;
  46
  47 =cut
  48
  49 sub throw {
  50     my ($class, $msg, $stacktrace) = @_;
  51
  52     # Don't re-encapsulate multiple times
  53     die $msg if blessed($msg) && $msg->isa('DBIx::Class::Exception');
  54
  55     # use Carp::Clan's croak if we're not stack tracing
  56     if(!$stacktrace) {
  57         local $@;
  58         eval { croak $msg };
  59         $msg = $@
  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;