Commit | Line | Data |
efe6365b |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use lib qw(t/lib); |
6 | use DBICTest; |
92fe2181 |
7 | use Data::Dumper; |
efe6365b |
8 | |
baa31d2f |
9 | { |
10 | package DBICTest::ExplodingStorage::Sth; |
11 | use strict; |
12 | use warnings; |
13 | |
14 | sub execute { die "Kablammo!" } |
15 | |
16 | sub bind_param {} |
17 | |
18 | package DBICTest::ExplodingStorage; |
19 | use strict; |
20 | use warnings; |
21 | use base 'DBIx::Class::Storage::DBI::SQLite'; |
22 | |
23 | my $count = 0; |
24 | sub sth { |
25 | my ($self, $sql) = @_; |
26 | return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++; |
27 | return $self->next::method($sql); |
28 | } |
29 | |
30 | sub connected { |
31 | return 0 if $count == 1; |
32 | return shift->next::method(@_); |
33 | } |
34 | } |
35 | |
92fe2181 |
36 | plan tests => 17; |
efe6365b |
37 | |
fcf741b1 |
38 | my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); |
efe6365b |
39 | |
40 | is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite', |
41 | 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' ); |
42 | |
baa31d2f |
43 | my $storage = $schema->storage; |
44 | $storage->ensure_connected; |
45 | |
19fb8520 |
46 | eval { |
47 | $schema->storage->throw_exception('test_exception_42'); |
48 | }; |
49 | like($@, qr/\btest_exception_42\b/, 'basic exception'); |
50 | |
51 | eval { |
52 | $schema->resultset('CD')->search_literal('broken +%$#$1')->all; |
53 | }; |
54 | like($@, qr/prepare_cached failed/, 'exception via DBI->HandleError, etc'); |
55 | |
baa31d2f |
56 | bless $storage, "DBICTest::ExplodingStorage"; |
57 | $schema->storage($storage); |
58 | |
59 | eval { |
19fb8520 |
60 | $schema->resultset('Artist')->create({ name => "Exploding Sheep" }); |
baa31d2f |
61 | }; |
62 | |
63 | is($@, "", "Exploding \$sth->execute was caught"); |
64 | |
65 | is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count, |
66 | "And the STH was retired"); |
67 | |
9a0891be |
68 | |
92fe2181 |
69 | # testing various invocations of connect_info ([ ... ]) |
70 | |
71 | my $coderef = sub { 42 }; |
72 | my $invocations = { |
73 | 'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => { |
74 | args => [ |
75 | 'foo', |
76 | 'bar', |
77 | undef, |
78 | { |
79 | on_connect_do => [qw/a b c/], |
80 | PrintError => 0, |
81 | }, |
82 | { |
83 | AutoCommit => 1, |
84 | on_disconnect_do => [qw/d e f/], |
85 | }, |
86 | { |
87 | unsafe => 1, |
88 | auto_savepoint => 1, |
89 | }, |
90 | ], |
91 | dbi_connect_info => [ |
92 | 'foo', |
93 | 'bar', |
94 | undef, |
95 | { |
96 | PrintError => 0, |
97 | AutoCommit => 1, |
98 | }, |
99 | ], |
100 | }, |
101 | |
102 | 'connect_info ([ \%code, \%extra_attr ])' => { |
103 | args => [ |
104 | $coderef, |
105 | { |
106 | on_connect_do => [qw/a b c/], |
107 | PrintError => 0, |
108 | AutoCommit => 1, |
109 | on_disconnect_do => [qw/d e f/], |
110 | }, |
111 | { |
112 | unsafe => 1, |
113 | auto_savepoint => 1, |
114 | }, |
115 | ], |
116 | dbi_connect_info => [ |
117 | $coderef, |
118 | ], |
119 | }, |
120 | |
121 | 'connect_info ([ \%attr ])' => { |
122 | args => [ |
123 | { |
124 | on_connect_do => [qw/a b c/], |
125 | PrintError => 0, |
126 | AutoCommit => 1, |
127 | on_disconnect_do => [qw/d e f/], |
128 | user => 'bar', |
129 | dsn => 'foo', |
130 | }, |
131 | { |
132 | unsafe => 1, |
133 | auto_savepoint => 1, |
134 | }, |
135 | ], |
136 | dbi_connect_info => [ |
137 | 'foo', |
138 | 'bar', |
139 | undef, |
140 | { |
141 | PrintError => 0, |
142 | AutoCommit => 1, |
143 | }, |
144 | ], |
145 | }, |
146 | }; |
147 | |
148 | for my $type (keys %$invocations) { |
149 | |
150 | # we can not use a cloner portably because of the coderef |
151 | # so compare dumps instead |
152 | local $Data::Dumper::Sortkeys = 1; |
153 | my $arg_dump = Dumper ($invocations->{$type}{args}); |
154 | |
155 | $storage->connect_info ($invocations->{$type}{args}); |
9a0891be |
156 | |
92fe2181 |
157 | is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments"); |
158 | |
159 | |
160 | is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info"); |
161 | ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref"); |
162 | |
163 | is_deeply ( |
164 | [$storage->on_connect_do, $storage->on_disconnect_do ], |
165 | [ [qw/a b c/], [qw/d e f/] ], |
166 | "$type correctly parsed DBIC specific on_[dis]connect_do", |
167 | ); |
168 | } |
baa31d2f |
169 | |
efe6365b |
170 | 1; |