1use strict;
2use warnings;
3
4use Test::More;
5use Test::Warn;
6use Test::Exception;
7use lib qw(t/lib);
8use DBICTest;
9
10my $schema = DBICTest->init_schema();
11
12my $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
95my $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
394done_testing;
395