Commit | Line | Data |
70350518 |
1 | use strict; |
d7ded411 |
2 | use warnings; |
70350518 |
3 | |
4 | use Test::More; |
d7ded411 |
5 | use Test::Warn; |
3b7f3eac |
6 | use Test::Exception; |
70350518 |
7 | use lib qw(t/lib); |
8 | use DBICTest; |
9 | |
a47e1233 |
10 | my $schema = DBICTest->init_schema(); |
70350518 |
11 | |
a62cf8d4 |
12 | my $code = sub { |
13 | my ($artist, @cd_titles) = @_; |
d7ded411 |
14 | |
a62cf8d4 |
15 | $artist->create_related('cds', { |
16 | title => $_, |
17 | year => 2006, |
18 | }) foreach (@cd_titles); |
d7ded411 |
19 | |
a62cf8d4 |
20 | return $artist->cds->all; |
21 | }; |
22 | |
171dadd7 |
23 | # Test checking of parameters |
24 | { |
dd7d4b43 |
25 | throws_ok (sub { |
171dadd7 |
26 | (ref $schema)->txn_do(sub{}); |
dd7d4b43 |
27 | }, qr/storage/, "can't call txn_do without storage"); |
28 | |
29 | throws_ok ( sub { |
171dadd7 |
30 | $schema->txn_do(''); |
dd7d4b43 |
31 | }, qr/must be a CODE reference/, '$coderef parameter check ok'); |
171dadd7 |
32 | } |
33 | |
a62cf8d4 |
34 | # Test successful txn_do() - scalar context |
35 | { |
57c18b65 |
36 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
37 | |
a62cf8d4 |
38 | my @titles = map {'txn_do test CD ' . $_} (1..5); |
39 | my $artist = $schema->resultset('Artist')->find(1); |
40 | my $count_before = $artist->cds->count; |
41 | my $count_after = $schema->txn_do($code, $artist, @titles); |
42 | is($count_after, $count_before+5, 'successful txn added 5 cds'); |
43 | is($artist->cds({ |
44 | title => "txn_do test CD $_", |
45 | })->first->year, 2006, "new CD $_ year correct") for (1..5); |
57c18b65 |
46 | |
47 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
48 | } |
49 | |
50 | # Test successful txn_do() - list context |
51 | { |
57c18b65 |
52 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
53 | |
a62cf8d4 |
54 | my @titles = map {'txn_do test CD ' . $_} (6..10); |
55 | my $artist = $schema->resultset('Artist')->find(1); |
56 | my $count_before = $artist->cds->count; |
57 | my @cds = $schema->txn_do($code, $artist, @titles); |
58 | is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context'); |
59 | is($artist->cds({ |
60 | title => "txn_do test CD $_", |
61 | })->first->year, 2006, "new CD $_ year correct") for (6..10); |
57c18b65 |
62 | |
63 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
64 | } |
65 | |
66 | # Test nested successful txn_do() |
67 | { |
57c18b65 |
68 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
69 | |
a62cf8d4 |
70 | my $nested_code = sub { |
71 | my ($schema, $artist, $code) = @_; |
72 | |
73 | my @titles1 = map {'nested txn_do test CD ' . $_} (1..5); |
74 | my @titles2 = map {'nested txn_do test CD ' . $_} (6..10); |
75 | |
76 | $schema->txn_do($code, $artist, @titles1); |
77 | $schema->txn_do($code, $artist, @titles2); |
78 | }; |
79 | |
80 | my $artist = $schema->resultset('Artist')->find(2); |
81 | my $count_before = $artist->cds->count; |
82 | |
dd7d4b43 |
83 | lives_ok (sub { |
a62cf8d4 |
84 | $schema->txn_do($nested_code, $schema, $artist, $code); |
dd7d4b43 |
85 | }, 'nested txn_do succeeded'); |
a62cf8d4 |
86 | |
a62cf8d4 |
87 | is($artist->cds({ |
88 | title => 'nested txn_do test CD '.$_, |
89 | })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); |
90 | is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); |
57c18b65 |
91 | |
92 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
93 | } |
94 | |
95 | my $fail_code = sub { |
96 | my ($artist) = @_; |
97 | $artist->create_related('cds', { |
98 | title => 'this should not exist', |
99 | year => 2005, |
100 | }); |
101 | die "the sky is falling"; |
102 | }; |
103 | |
104 | # Test failed txn_do() |
105 | { |
57c18b65 |
106 | |
107 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
108 | |
109 | my $artist = $schema->resultset('Artist')->find(3); |
110 | |
dd7d4b43 |
111 | throws_ok (sub { |
57c18b65 |
112 | $schema->txn_do($fail_code, $artist); |
dd7d4b43 |
113 | }, qr/the sky is falling/, 'failed txn_do threw an exception'); |
57c18b65 |
114 | |
57c18b65 |
115 | my $cd = $artist->cds({ |
116 | title => 'this should not exist', |
117 | year => 2005, |
118 | })->first; |
119 | ok(!defined($cd), q{failed txn_do didn't change the cds table}); |
120 | |
121 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
122 | } |
123 | |
124 | # do the same transaction again |
125 | { |
126 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
127 | |
a62cf8d4 |
128 | my $artist = $schema->resultset('Artist')->find(3); |
129 | |
dd7d4b43 |
130 | throws_ok (sub { |
a62cf8d4 |
131 | $schema->txn_do($fail_code, $artist); |
dd7d4b43 |
132 | }, qr/the sky is falling/, 'failed txn_do threw an exception'); |
a62cf8d4 |
133 | |
a62cf8d4 |
134 | my $cd = $artist->cds({ |
135 | title => 'this should not exist', |
136 | year => 2005, |
137 | })->first; |
138 | ok(!defined($cd), q{failed txn_do didn't change the cds table}); |
57c18b65 |
139 | |
140 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
141 | } |
142 | |
143 | # Test failed txn_do() with failed rollback |
144 | { |
57c18b65 |
145 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
146 | |
a62cf8d4 |
147 | my $artist = $schema->resultset('Artist')->find(3); |
148 | |
149 | # Force txn_rollback() to throw an exception |
150 | no warnings 'redefine'; |
58d387fe |
151 | no strict 'refs'; |
57c18b65 |
152 | |
153 | # die in rollback, but maintain sanity for further tests ... |
154 | local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{ |
155 | my $storage = shift; |
156 | $storage->{transaction_depth}--; |
157 | die 'FAILED'; |
158 | }; |
a62cf8d4 |
159 | |
dd7d4b43 |
160 | throws_ok ( |
161 | sub { |
162 | $schema->txn_do($fail_code, $artist); |
163 | }, |
164 | qr/the sky is falling.+Rollback failed/s, |
165 | 'txn_rollback threw a rollback exception (and included the original exception' |
166 | ); |
a62cf8d4 |
167 | |
168 | my $cd = $artist->cds({ |
169 | title => 'this should not exist', |
170 | year => 2005, |
171 | })->first; |
172 | isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }. |
173 | q{changed the cds table}); |
174 | $cd->delete; # Rollback failed |
175 | $cd = $artist->cds({ |
176 | title => 'this should not exist', |
177 | year => 2005, |
178 | })->first; |
179 | ok(!defined($cd), q{deleted the failed txn's cd}); |
57c18b65 |
180 | $schema->storage->_dbh->rollback; |
a62cf8d4 |
181 | } |
182 | |
183 | # Test nested failed txn_do() |
184 | { |
57c18b65 |
185 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
186 | |
a62cf8d4 |
187 | my $nested_fail_code = sub { |
188 | my ($schema, $artist, $code1, $code2) = @_; |
189 | |
190 | my @titles = map {'nested txn_do test CD ' . $_} (1..5); |
191 | |
192 | $schema->txn_do($code1, $artist, @titles); # successful txn |
193 | $schema->txn_do($code2, $artist); # failed txn |
194 | }; |
195 | |
196 | my $artist = $schema->resultset('Artist')->find(3); |
197 | |
dd7d4b43 |
198 | throws_ok ( sub { |
a62cf8d4 |
199 | $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code); |
dd7d4b43 |
200 | }, qr/the sky is falling/, 'nested failed txn_do threw exception'); |
a62cf8d4 |
201 | |
a62cf8d4 |
202 | ok(!defined($artist->cds({ |
203 | title => 'nested txn_do test CD '.$_, |
204 | year => 2006, |
205 | })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5); |
206 | my $cd = $artist->cds({ |
207 | title => 'this should not exist', |
208 | year => 2005, |
209 | })->first; |
210 | ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); |
211 | } |
a62cf8d4 |
212 | |
291bf95f |
213 | # Grab a new schema to test txn before connect |
214 | { |
215 | my $schema2 = DBICTest->init_schema(no_deploy => 1); |
dd7d4b43 |
216 | lives_ok (sub { |
291bf95f |
217 | $schema2->txn_begin(); |
218 | $schema2->txn_begin(); |
dd7d4b43 |
219 | }, 'Pre-connection nested transactions.'); |
c52c3466 |
220 | |
221 | # although not connected DBI would still warn about rolling back at disconnect |
222 | $schema2->txn_rollback; |
223 | $schema2->txn_rollback; |
a211cb63 |
224 | $schema2->storage->disconnect; |
291bf95f |
225 | } |
a211cb63 |
226 | $schema->storage->disconnect; |
3b7f3eac |
227 | |
3b7f3eac |
228 | # Test txn_scope_guard |
229 | { |
3b7f3eac |
230 | my $schema = DBICTest->init_schema(); |
231 | |
232 | is($schema->storage->transaction_depth, 0, "Correct transaction depth"); |
233 | my $artist_rs = $schema->resultset('Artist'); |
234 | throws_ok { |
235 | my $guard = $schema->txn_scope_guard; |
236 | |
237 | |
238 | $artist_rs->create({ |
239 | name => 'Death Cab for Cutie', |
240 | made_up_column => 1, |
241 | }); |
d7ded411 |
242 | |
3b7f3eac |
243 | $guard->commit; |
5ee678c8 |
244 | } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/s, "Error propogated okay"; |
3b7f3eac |
245 | |
246 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
247 | |
dd7d4b43 |
248 | my $inner_exception = ''; # set in inner() below |
249 | throws_ok (sub { |
3b7f3eac |
250 | outer($schema, 1); |
dd7d4b43 |
251 | }, qr/$inner_exception/, "Nested exceptions propogated"); |
3b7f3eac |
252 | |
253 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
254 | |
aab0d3b7 |
255 | lives_ok (sub { |
d7ded411 |
256 | warnings_exist ( sub { |
257a1d3b |
257 | # The 0 arg says don't die, just let the scope guard go out of scope |
d7ded411 |
258 | # forcing a txn_rollback to happen |
259 | outer($schema, 0); |
771298cf |
260 | }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected'); |
aab0d3b7 |
261 | ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); |
262 | }, 'rollback successful withot exception'); |
3b7f3eac |
263 | |
264 | sub outer { |
265 | my ($schema) = @_; |
aab0d3b7 |
266 | |
3b7f3eac |
267 | my $guard = $schema->txn_scope_guard; |
268 | $schema->resultset('Artist')->create({ |
269 | name => 'Death Cab for Cutie', |
270 | }); |
271 | inner(@_); |
3b7f3eac |
272 | } |
273 | |
274 | sub inner { |
275 | my ($schema, $fatal) = @_; |
aab0d3b7 |
276 | |
277 | my $inner_guard = $schema->txn_scope_guard; |
278 | is($schema->storage->transaction_depth, 2, "Correct transaction depth"); |
3b7f3eac |
279 | |
280 | my $artist = $artist_rs->find({ name => 'Death Cab for Cutie' }); |
281 | |
3b7f3eac |
282 | eval { |
257a1d3b |
283 | $artist->cds->create({ |
3b7f3eac |
284 | title => 'Plans', |
257a1d3b |
285 | year => 2005, |
3b7f3eac |
286 | $fatal ? ( foo => 'bar' ) : () |
287 | }); |
288 | }; |
289 | if ($@) { |
290 | # Record what got thrown so we can test it propgates out properly. |
291 | $inner_exception = $@; |
292 | die $@; |
293 | } |
294 | |
aab0d3b7 |
295 | # inner guard should commit without consequences |
296 | $inner_guard->commit; |
3b7f3eac |
297 | } |
298 | } |
d7ded411 |
299 | |
300 | # make sure the guard does not eat exceptions |
301 | { |
302 | my $schema = DBICTest->init_schema(); |
303 | throws_ok (sub { |
304 | my $guard = $schema->txn_scope_guard; |
305 | $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); |
306 | |
307 | $schema->storage->disconnect; # this should freak out the guard rollback |
308 | |
309 | die 'Deliberate exception'; |
310 | }, qr/Deliberate exception.+Rollback failed/s); |
311 | } |
312 | |
83f26263 |
313 | # make sure it warns *big* on failed rollbacks |
314 | { |
c6e27318 |
315 | my $schema = DBICTest->init_schema(); |
c6e27318 |
316 | |
36099e8c |
317 | # something is really confusing Test::Warn here, no time to debug |
318 | =begin |
319 | warnings_exist ( |
320 | sub { |
771298cf |
321 | my $guard = $schema->txn_scope_guard; |
322 | $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); |
323 | |
324 | $schema->storage->disconnect; # this should freak out the guard rollback |
771298cf |
325 | }, |
83f26263 |
326 | [ |
327 | qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, |
328 | qr/\*+ ROLLBACK FAILED\!\!\! \*+/, |
329 | ], |
330 | 'proper warnings generated on out-of-scope+rollback failure' |
331 | ); |
36099e8c |
332 | =cut |
333 | |
334 | my @want = ( |
335 | qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, |
336 | qr/\*+ ROLLBACK FAILED\!\!\! \*+/, |
337 | ); |
338 | |
339 | my @w; |
340 | local $SIG{__WARN__} = sub { |
341 | if (grep {$_[0] =~ $_} (@want)) { |
342 | push @w, $_[0]; |
343 | } |
344 | else { |
345 | warn $_[0]; |
346 | } |
347 | }; |
348 | { |
349 | my $guard = $schema->txn_scope_guard; |
350 | $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); |
351 | |
352 | $schema->storage->disconnect; # this should freak out the guard rollback |
353 | } |
354 | |
355 | is (@w, 2, 'Both expected warnings found'); |
c6e27318 |
356 | } |
357 | |
257a1d3b |
358 | # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard |
359 | { |
360 | my $factory = DBICTest->init_schema (AutoCommit => 0); |
361 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
362 | my $dbh = $factory->storage->dbh; |
363 | |
364 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
365 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
366 | |
367 | |
368 | lives_ok ( sub { |
369 | my $guard = $schema->txn_scope_guard; |
370 | $schema->resultset('CD')->delete; |
371 | $guard->commit; |
372 | }, 'No attempt to start a transaction with scope guard'); |
373 | |
374 | is ($schema->resultset('CD')->count, 0, 'Deletion successful'); |
375 | } |
376 | |
377 | # make sure AutoCommit => 0 on external handles behaves correctly with txn_do |
378 | { |
379 | my $factory = DBICTest->init_schema (AutoCommit => 0); |
380 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
381 | my $dbh = $factory->storage->dbh; |
382 | |
383 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
384 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
385 | |
386 | |
387 | lives_ok ( sub { |
388 | $schema->txn_do (sub { $schema->resultset ('CD')->delete }); |
389 | }, 'No attempt to start a atransaction with txn_do'); |
390 | |
391 | is ($schema->resultset('CD')->count, 0, 'Deletion successful'); |
392 | } |
393 | |
d7ded411 |
394 | done_testing; |