X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FException.pm;h=1f56cb5d44799cea7f5773a0d7d2e6eea1e0c871;hb=0c11ad0ee5c8407f6b87d6e15c62a1b445076dc0;hp=058020298b711567cede6265f0cec31465491e3d;hpb=8091aa9182ff763aa607dd82f4d61b99f8adab37;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Exception.pm b/lib/DBIx/Class/Exception.pm index 0580202..1f56cb5 100644 --- a/lib/DBIx/Class/Exception.pm +++ b/lib/DBIx/Class/Exception.pm @@ -1,70 +1,95 @@ package DBIx::Class::Exception; use strict; -use vars qw[@ISA $DBIC_EXCEPTION_CLASS]; -use UNIVERSAL::require; +use warnings; -BEGIN { - push( @ISA, $DBIC_EXCEPTION_CLASS || 'DBIx::Class::Exception::Base' ); -} - -package DBIx::Class::Exception::Base; +use DBIx::Class::Carp (); -use strict; -use Carp (); +use overload + '""' => sub { shift->{msg} }, + fallback => 1; =head1 NAME -DBIx::Class::Exception - DBIC Exception Class +DBIx::Class::Exception - Exception objects for DBIx::Class + +=head1 DESCRIPTION -=head1 SYNOPSIS +Exception objects of this class are used internally by +the default error handling of L +and derivatives. - DBIx::Class::Exception->throw( qq/Fatal exception/ ); +These objects stringify to the contained error message, and use +overload fallback to give natural boolean/numeric values. -See also L. +=head1 METHODS -=head1 DESCRIPTION +=head2 throw -This is a generic Exception class for DBIx::Class. You can easily -replace this with any mechanism implementing 'throw' by setting -$DBix::Class::Exception::DBIC_EXCEPTION_CLASS +=over 4 -=head1 METHODS +=item Arguments: $exception_scalar, $stacktrace -=head2 throw( $message ) +=back -=head2 throw( message => $message ) +This is meant for internal use by L's C +code, and shouldn't be used directly elsewhere. -=head2 throw( error => $error ) +Expects a scalar exception message. The optional argument +C<$stacktrace> tells it to output a full trace similar to L. -Throws a fatal exception. + DBIx::Class::Exception->throw('Foo'); + try { ... } catch { DBIx::Class::Exception->throw(shift) } =cut sub throw { - my $class = shift; - my %params = @_ == 1 ? ( error => $_[0] ) : @_; + my ($class, $msg, $stacktrace) = @_; - my $message = $params{message} || $params{error} || $! || ''; + # Don't re-encapsulate exception objects of any kind + die $msg if ref($msg); - local $Carp::CarpLevel = (caller(1) eq 'NEXT' ? 2 : 1); + # all exceptions include a caller + $msg =~ s/\n$//; - Carp::croak($message); + if(!$stacktrace) { + # 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; + + die $self; } -=head1 AUTHOR +=head2 rethrow + +This method provides some syntactic sugar in order to +re-throw exceptions. -Marcus Ramberg +=cut + +sub rethrow { + die shift; +} -=head1 THANKS +=head1 AUTHOR AND CONTRIBUTORS -Thanks to the L framework, where this module was borrowed -from. +See L and L in DBIx::Class -=head1 COPYRIGHT +=head1 LICENSE -This program is free software, you can redistribute it and/or modify -it under the same terms as Perl itself. +You may distribute this code under the same terms as Perl itself. =cut