Another overhaul of transaction/savepoint handling
[dbsrgits/DBIx-Class-Historic.git] / t / storage / base.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 use Data::Dumper;
10
11 {
12     package DBICTest::ExplodingStorage::Sth;
13     use strict;
14     use warnings;
15
16     sub execute { die "Kablammo!" }
17
18     sub bind_param {}
19
20     package DBICTest::ExplodingStorage;
21     use strict;
22     use warnings;
23     use base 'DBIx::Class::Storage::DBI::SQLite';
24
25     my $count = 0;
26     sub sth {
27       my ($self, $sql) = @_;
28       return bless {},  "DBICTest::ExplodingStorage::Sth" unless $count++;
29       return $self->next::method($sql);
30     }
31
32     sub connected {
33       return 0 if $count == 1;
34       return shift->next::method(@_);
35     }
36 }
37
38 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
39
40 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
41     'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
42
43 my $storage = $schema->storage;
44 $storage->ensure_connected;
45
46 throws_ok {
47     $schema->storage->throw_exception('test_exception_42');
48 } qr/\btest_exception_42\b/, 'basic exception';
49
50 throws_ok {
51     $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
52 } qr/prepare_cached failed/, 'exception via DBI->HandleError, etc';
53
54 bless $storage, "DBICTest::ExplodingStorage";
55 $schema->storage($storage);
56
57 lives_ok {
58     $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
59 } 'Exploding $sth->execute was caught';
60
61 is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
62   "And the STH was retired");
63
64
65 # testing various invocations of connect_info ([ ... ])
66
67 my $coderef = sub { 42 };
68 my $invocations = {
69   'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
70       args => [
71           'foo',
72           'bar',
73           undef,
74           {
75             on_connect_do => [qw/a b c/],
76             PrintError => 0,
77           },
78           {
79             AutoCommit => 1,
80             on_disconnect_do => [qw/d e f/],
81           },
82           {
83             unsafe => 1,
84             auto_savepoint => 1,
85           },
86         ],
87       dbi_connect_info => [
88           'foo',
89           'bar',
90           undef,
91           {
92             %{$storage->_default_dbi_connect_attributes || {} },
93             PrintError => 0,
94             AutoCommit => 1,
95           },
96       ],
97   },
98
99   'connect_info ([ \%code, \%extra_attr ])' => {
100       args => [
101           $coderef,
102           {
103             on_connect_do => [qw/a b c/],
104             PrintError => 0,
105             AutoCommit => 1,
106             on_disconnect_do => [qw/d e f/],
107           },
108           {
109             unsafe => 1,
110             auto_savepoint => 1,
111           },
112         ],
113       dbi_connect_info => [
114           $coderef,
115       ],
116   },
117
118   'connect_info ([ \%attr ])' => {
119       args => [
120           {
121             on_connect_do => [qw/a b c/],
122             PrintError => 1,
123             AutoCommit => 0,
124             on_disconnect_do => [qw/d e f/],
125             user => 'bar',
126             dsn => 'foo',
127           },
128           {
129             unsafe => 1,
130             auto_savepoint => 1,
131           },
132       ],
133       dbi_connect_info => [
134           'foo',
135           'bar',
136           undef,
137           {
138             %{$storage->_default_dbi_connect_attributes || {} },
139             PrintError => 1,
140             AutoCommit => 0,
141           },
142       ],
143       warn => qr/\QYou provided explicit AutoCommit => 0 in your connection_info/,
144   },
145   'connect_info ([ \%attr_with_coderef ])' => {
146       args => [ {
147         dbh_maker => $coderef,
148         dsn => 'blah',
149         user => 'bleh',
150         on_connect_do => [qw/a b c/],
151         on_disconnect_do => [qw/d e f/],
152       } ],
153       dbi_connect_info => [
154         $coderef
155       ],
156       warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/,
157   },
158 };
159
160 for my $type (keys %$invocations) {
161
162   # we can not use a cloner portably because of the coderef
163   # so compare dumps instead
164   local $Data::Dumper::Sortkeys = 1;
165   my $arg_dump = Dumper ($invocations->{$type}{args});
166
167   warnings_exist (
168     sub { $storage->connect_info ($invocations->{$type}{args}) },
169      $invocations->{$type}{warn} || (),
170     'Warned about ignored attributes',
171   );
172
173   is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
174
175   is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
176   ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
177
178   is_deeply (
179     [$storage->on_connect_do, $storage->on_disconnect_do ],
180     [ [qw/a b c/], [qw/d e f/] ],
181     "$type correctly parsed DBIC specific on_[dis]connect_do",
182   );
183 }
184
185 done_testing;
186
187 1;