lib/DBIx/Class/Exception.pm

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