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