use strict;
use warnings;
-use Carp::Clan qw/^DBIx::Class/;
-use Scalar::Util qw/blessed/;
+use DBIx::Class::Carp ();
use overload
'""' => sub { shift->{msg} },
=head1 DESCRIPTION
-Exception objects of this class are used in internally by
-he default error handling of L<DBIx::Class::Schema/throw_exception>
-to prevent confusing and/or redundant re-application of L<Carp>'s
-stack trace information.
+Exception objects of this class are used internally by
+the default error handling of L<DBIx::Class::Schema/throw_exception>
+and derivatives.
These objects stringify to the contained error message, and use
overload fallback to give natural boolean/numeric values.
code, and shouldn't be used directly elsewhere.
Expects a scalar exception message. The optional argument
-C<$stacktrace> tells it to use L<Carp/longmess> instead of
-L<Carp::Clan/croak>.
+C<$stacktrace> tells it to output a full trace similar to L<Carp/confess>.
DBIx::Class::Exception->throw('Foo');
- eval { ... }; DBIx::Class::Exception->throw($@) if $@;
+ try { ... } catch { DBIx::Class::Exception->throw(shift) }
=cut
my ($class, $msg, $stacktrace) = @_;
# Don't re-encapsulate exception objects of any kind
- die $msg if blessed($msg);
+ die $msg if ref($msg);
+
+ # all exceptions include a caller
+ $msg =~ s/\n$//;
- # use Carp::Clan's croak if we're not stack tracing
if(!$stacktrace) {
- local $@;
- eval { croak $msg };
- $msg = $@
+ # skip all frames that match the original caller, or any of
+ # the dbic-wide classdata patterns
+ my ($ln, $calling) = DBIx::Class::Carp::__find_caller(
+ '^' . caller() . '$',
+ 'DBIx::Class',
+ );
+
+ $msg = "${calling}${msg} ${ln}\n";
}
else {
$msg = Carp::longmess($msg);
}
-
+
my $self = { msg => $msg };
bless $self => $class;