1use strict; 2use warnings; 3 4use Test::More; 5use lib qw(t/lib); 6use DBICTest; 7 8plan tests => 9; 9 10# Set up the "usual" sqlite for DBICTest 11my $schema = DBICTest->init_schema; 12 13# This is how we're generating exceptions in the rest of these tests, 14# which might need updating at some future time to be some other 15# exception-generating statement: 16 17sub throwex { $schema->resultset("Artist")->search(1,1,1); } 18my $ex_regex = qr/Odd number of arguments to search/; 19 20# Basic check, normal exception 21eval { throwex }; 22my $e = $@; # like() seems to stringify $@ 23like($@, $ex_regex); 24 25# Re-throw the exception with rethrow() 26eval { $e->rethrow }; 27isa_ok( $@, 'DBIx::Class::Exception' ); 28like($@, $ex_regex); 29 30# Now lets rethrow via exception_action 31$schema->exception_action(sub { die @_ }); 32eval { throwex }; 33like($@, $ex_regex); 34 35# Now lets suppress the error 36$schema->exception_action(sub { 1 }); 37eval { throwex }; 38ok(!$@, "Suppress exception"); 39 40# Now lets fall through and let croak take back over 41$schema->exception_action(sub { return }); 42eval { throwex }; 43like($@, $ex_regex); 44 45# Whacky useless exception class 46{ 47 package DBICTest::Exception; 48 use overload '""' => \&stringify, fallback => 1; 49 sub new { 50 my $class = shift; 51 bless { msg => shift }, $class; 52 } 53 sub throw { 54 my $self = shift; 55 die $self if ref $self eq __PACKAGE__; 56 die $self->new(shift); 57 } 58 sub stringify { 59 "DBICTest::Exception is handling this: " . shift->{msg}; 60 } 61} 62 63# Try the exception class 64$schema->exception_action(sub { DBICTest::Exception->throw(@_) }); 65eval { throwex }; 66like($@, qr/DBICTest::Exception is handling this: $ex_regex/); 67 68# While we're at it, lets throw a custom exception through Storage::DBI 69eval { $schema->storage->throw_exception('floob') }; 70like($@, qr/DBICTest::Exception is handling this: floob/); 71 72 73# This usage is a bit unusual but it was actually seen in the wild 74eval { 75 76 my $dbh = $schema->storage->dbh; 77 undef $schema; 78 79 $dbh->do ('glaring_syntax_error;'); 80}; 81like($@, qr/DBI Exception.+do failed/, 'Exception thrown even after $storage is destroyed'); 82 83