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