Cleanup shebang lines of all maint/example scripts, remove from tests entirely
[dbsrgits/DBIx-Class.git] / t / 34exception_action.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use lib qw(t/lib);
6 use DBICTest;
7
8 plan tests => 9;
9
10 # Set up the "usual" sqlite for DBICTest
11 my $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
17 sub throwex { $schema->resultset("Artist")->search(1,1,1); }
18 my $ex_regex = qr/Odd number of arguments to search/;
19
20 # Basic check, normal exception
21 eval { throwex };
22 my $e = $@; # like() seems to stringify $@
23 like($@, $ex_regex);
24
25 # Re-throw the exception with rethrow()
26 eval { $e->rethrow };
27 isa_ok( $@, 'DBIx::Class::Exception' );
28 like($@, $ex_regex);
29
30 # Now lets rethrow via exception_action
31 $schema->exception_action(sub { die @_ });
32 eval { throwex };
33 like($@, $ex_regex);
34
35 # Now lets suppress the error
36 $schema->exception_action(sub { 1 });
37 eval { throwex };
38 ok(!$@, "Suppress exception");
39
40 # Now lets fall through and let croak take back over
41 $schema->exception_action(sub { return });
42 eval { throwex };
43 like($@, $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(@_) });
65 eval { throwex };
66 like($@, qr/DBICTest::Exception is handling this: $ex_regex/);
67
68 # While we're at it, lets throw a custom exception through Storage::DBI
69 eval { $schema->storage->throw_exception('floob') };
70 like($@, qr/DBICTest::Exception is handling this: floob/);
71
72
73 # This usage is a bit unusual but it was actually seen in the wild
74 eval {
75
76   my $dbh = $schema->storage->dbh;
77   undef $schema;
78
79   $dbh->do ('glaring_syntax_error;');
80 };
81 like($@, qr/DBI Exception.+do failed/, 'Exception thrown even after $storage is destroyed');
82