Sketches of tests that should ultimately pass
[dbsrgits/DBIx-Class.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   throws_ok (sub {
26     (ref $schema)->txn_do(sub{});
27   }, qr/storage/, "can't call txn_do without storage");
28
29   throws_ok ( sub {
30     $schema->txn_do('');
31   }, qr/must be a CODE reference/, '$coderef parameter check ok');
32 }
33
34 # Test successful txn_do() - scalar context
35 {
36   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
37
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);
46
47   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
48 }
49
50 # Test successful txn_do() - list context
51 {
52   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
53
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);
62
63   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
64 }
65
66 # Test nested successful txn_do()
67 {
68   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
69
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
83   lives_ok (sub {
84     $schema->txn_do($nested_code, $schema, $artist, $code);
85   }, 'nested txn_do succeeded');
86
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');
91
92   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
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 {
106
107   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
108
109   my $artist = $schema->resultset('Artist')->find(3);
110
111   throws_ok (sub {
112     $schema->txn_do($fail_code, $artist);
113   }, qr/the sky is falling/, 'failed txn_do threw an exception');
114
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
128   my $artist = $schema->resultset('Artist')->find(3);
129
130   throws_ok (sub {
131     $schema->txn_do($fail_code, $artist);
132   }, qr/the sky is falling/, 'failed txn_do threw an exception');
133
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});
139
140   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
141 }
142
143 # Test failed txn_do() with failed rollback
144 {
145   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
146
147   my $artist = $schema->resultset('Artist')->find(3);
148
149   # Force txn_rollback() to throw an exception
150   no warnings 'redefine';
151   no strict 'refs';
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   };
159
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   );
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});
180   $schema->storage->_dbh->rollback;
181 }
182
183 # Test nested failed txn_do()
184 {
185   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
186
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
198   throws_ok ( sub {
199     $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
200   }, qr/the sky is falling/, 'nested failed txn_do threw exception');
201
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 }
212
213 # Grab a new schema to test txn before connect
214 {
215     my $schema2 = DBICTest->init_schema(no_deploy => 1);
216     lives_ok (sub {
217         $schema2->txn_begin();
218         $schema2->txn_begin();
219     }, 'Pre-connection nested transactions.');
220
221     # although not connected DBI would still warn about rolling back at disconnect
222     $schema2->txn_rollback;
223     $schema2->txn_rollback;
224     $schema2->storage->disconnect;
225 }
226 $schema->storage->disconnect;
227
228 # Test txn_scope_guard
229 {
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     });
242
243    $guard->commit;
244   } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/s, "Error propogated okay";
245
246   ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
247
248   my $inner_exception = '';  # set in inner() below
249   throws_ok (sub {
250     outer($schema, 1);
251   }, qr/$inner_exception/, "Nested exceptions propogated");
252
253   ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
254
255   lives_ok (sub {
256     warnings_exist ( sub {
257       # The 0 arg says don't die, just let the scope guard go out of scope
258       # forcing a txn_rollback to happen
259       outer($schema, 0);
260     }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected');
261     ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
262   }, 'rollback successful withot exception');
263
264   sub outer {
265     my ($schema) = @_;
266
267     my $guard = $schema->txn_scope_guard;
268     $schema->resultset('Artist')->create({
269       name => 'Death Cab for Cutie',
270     });
271     inner(@_);
272   }
273
274   sub inner {
275     my ($schema, $fatal) = @_;
276
277     my $inner_guard = $schema->txn_scope_guard;
278     is($schema->storage->transaction_depth, 2, "Correct transaction depth");
279
280     my $artist = $artist_rs->find({ name => 'Death Cab for Cutie' });
281
282     eval {
283       $artist->cds->create({
284         title => 'Plans',
285         year => 2005,
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
295     # inner guard should commit without consequences
296     $inner_guard->commit;
297   }
298 }
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
313 # make sure it warns *big* on failed rollbacks
314 {
315   my $schema = DBICTest->init_schema();
316
317   # something is really confusing Test::Warn here, no time to debug
318 =begin
319   warnings_exist (
320     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     [
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   );
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');
356 }
357
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
394 done_testing;