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