8a332848de462a9d48893458df92bf993a46cab9
[dbsrgits/DBIx-Class-Historic.git] / t / storage / reconnect.t
1 use strict;
2 use warnings;
3
4 use FindBin;
5 use File::Copy;
6 use Test::More;
7 use lib qw(t/lib);
8 use DBICTest;
9
10 my $db_orig = "$FindBin::Bin/../var/DBIxClass.db";
11 my $db_tmp  = "$db_orig.tmp";
12
13 # Set up the "usual" sqlite for DBICTest
14 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
15
16 # Make sure we're connected by doing something
17 my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
18 cmp_ok(@art, '==', 3, "Three artists returned");
19
20 # Disconnect the dbh, and be sneaky about it
21 # Also test if DBD::SQLite finaly knows how to ->disconnect properly
22 {
23   my $w;
24   local $SIG{__WARN__} = sub { $w = shift };
25   $schema->storage->_dbh->disconnect;
26   ok ($w !~ /active statement handles/, 'SQLite can disconnect properly');
27 }
28
29 # Try the operation again - What should happen here is:
30 #   1. S::DBI blindly attempts the SELECT, which throws an exception
31 #   2. It catches the exception, checks ->{Active}/->ping, sees the disconnected state...
32 #   3. Reconnects, and retries the operation
33 #   4. Success!
34 my @art_two = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
35 cmp_ok(@art_two, '==', 3, "Three artists returned");
36
37 ### Now, disconnect the dbh, and move the db file;
38 # create a new one and chmod 000 to prevent SQLite from connecting.
39 $schema->storage->_dbh->disconnect;
40 move( $db_orig, $db_tmp );
41 open DBFILE, '>', $db_orig;
42 print DBFILE 'THIS IS NOT A REAL DATABASE';
43 close DBFILE;
44 chmod 0000, $db_orig;
45
46 ### Try the operation again... it should fail, since there's no db
47 {
48     # Catch the DBI connection error
49     local $SIG{__WARN__} = sub {};
50     eval {
51         my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
52     };
53     ok( $@, 'The operation failed' );
54 }
55
56 ### Now, move the db file back to the correct name
57 unlink($db_orig);
58 move( $db_tmp, $db_orig );
59
60 SKIP: {
61     skip "Cannot reconnect if original connection didn't fail", 2
62         if ( $@ =~ /encrypted or is not a database/ );
63
64     ### Try the operation again... this time, it should succeed
65     my @art_four;
66     eval {
67         @art_four = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
68     };
69     ok( !$@, 'The operation succeeded' );
70     cmp_ok( @art_four, '==', 3, "Three artists returned" );
71 }
72
73 # check that reconnection contexts are preserved in txn_do / dbh_do
74
75 my $args = [1, 2, 3];
76
77 my $ctx_map = {
78   VOID => {
79     invoke => sub { shift->(); 1 },
80     wa => undef,
81   },
82   SCALAR => {
83     invoke => sub { my $foo = shift->() },
84     wa => '',
85   },
86   LIST => {
87     invoke => sub { my @foo = shift->() },
88     wa => 1,
89   },
90 };
91
92 for my $ctx (keys %$ctx_map) {
93
94   # start disconnected and then connected
95   $schema->storage->disconnect;
96   for (1, 2) {
97     my $disarmed;
98
99     $ctx_map->{$ctx}{invoke}->(sub { $schema->txn_do(sub {
100       is_deeply (\@_, $args, 'Args propagated correctly' );
101
102       is (wantarray(), $ctx_map->{$ctx}{wa}, "Correct $ctx context");
103
104       # this will cause a retry
105       $schema->storage->_dbh->disconnect unless $disarmed++;
106
107       isa_ok ($schema->resultset('Artist')->next, 'DBICTest::Artist');
108     }, @$args) });
109   }
110 };
111
112 done_testing;