X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FException.pm;h=a5e9945ec8f885d4ed3b45c5de792511c1a570ea;hb=97940e368df996e1fe6111fb14f560594dc4c0b2;hp=83e025500471e847b61e8b10b7c0e9e7e5c3911c;hpb=4981dc70e16bbd2036d351c1130b55f2d673a5f9;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Exception.pm b/lib/DBIx/Class/Exception.pm index 83e0255..a5e9945 100644 --- a/lib/DBIx/Class/Exception.pm +++ b/lib/DBIx/Class/Exception.pm @@ -3,8 +3,12 @@ package DBIx::Class::Exception; use strict; use warnings; -use Carp::Clan qw/^DBIx::Class/; -use Scalar::Util qw/blessed/; +# load Carp early to prevent tickling of the ::Internal stash being +# interpreted as "Carp is already loaded" by some braindead loader +use Carp (); +$Carp::Internal{ (__PACKAGE__) }++; + +use DBIx::Class::Carp (); use overload '""' => sub { shift->{msg} }, @@ -16,10 +20,9 @@ DBIx::Class::Exception - Exception objects for DBIx::Class =head1 DESCRIPTION -Exception objects of this class are used in internally by -he default error handling of L -to prevent confusing and/or redundant re-application of L's -stack trace information. +Exception objects of this class are used internally by +the default error handling of L +and derivatives. These objects stringify to the contained error message, and use overload fallback to give natural boolean/numeric values. @@ -37,44 +40,64 @@ overload fallback to give natural boolean/numeric values. This is meant for internal use by L's C code, and shouldn't be used directly elsewhere. -Expects a scalar exception message. The optional argument -C<$stacktrace> tells it to use L instead of -L. +Expects a scalar exception message. The optional boolean C<$stacktrace> +causes it to output a full trace similar to L. DBIx::Class::Exception->throw('Foo'); - eval { ... }; DBIx::Class::Exception->throw($@) if $@; + try { ... } catch { DBIx::Class::Exception->throw(shift) } =cut sub throw { my ($class, $msg, $stacktrace) = @_; - # Don't re-encapsulate multiple times - die $msg if blessed($msg) && $msg->isa('DBIx::Class::Exception'); + # Don't re-encapsulate exception objects of any kind + 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( + '^' . CORE::caller() . '$', + 'DBIx::Class', + ); + + $msg = "${calling}${msg} ${ln}\n"; } else { $msg = Carp::longmess($msg); } - + my $self = { msg => $msg }; bless $self => $class; die $self; } -=head1 AUTHORS +=head2 rethrow + +This method provides some syntactic sugar in order to +re-throw exceptions. + +=cut + +sub rethrow { + die shift; +} + +=head1 FURTHER QUESTIONS? -Brandon L. Black +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut