Cleanup/improve the leaktest a bit
[dbsrgits/DBIx-Class-Historic.git] / t / storage / base.t
CommitLineData
efe6365b 1use strict;
6b5e61af 2use warnings;
efe6365b 3
4use Test::More;
6b5e61af 5use Test::Warn;
f3d405dc 6use Test::Exception;
efe6365b 7use lib qw(t/lib);
8use DBICTest;
92fe2181 9use Data::Dumper;
efe6365b 10
baa31d2f 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
fcf741b1 38my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
efe6365b 39
40is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
41 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
42
baa31d2f 43my $storage = $schema->storage;
44$storage->ensure_connected;
45
f3d405dc 46throws_ok {
19fb8520 47 $schema->storage->throw_exception('test_exception_42');
f3d405dc 48} qr/\btest_exception_42\b/, 'basic exception';
19fb8520 49
f3d405dc 50throws_ok {
19fb8520 51 $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
f3d405dc 52} qr/prepare_cached failed/, 'exception via DBI->HandleError, etc';
19fb8520 53
baa31d2f 54bless $storage, "DBICTest::ExplodingStorage";
55$schema->storage($storage);
56
f3d405dc 57lives_ok {
19fb8520 58 $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
f3d405dc 59} 'Exploding $sth->execute was caught';
baa31d2f 60
61is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
62 "And the STH was retired");
63
9a0891be 64
92fe2181 65# testing various invocations of connect_info ([ ... ])
66
67my $coderef = sub { 42 };
68my $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 {
3a4c1d89 92 %{$storage->_default_dbi_connect_attributes || {} },
92fe2181 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/],
3a4c1d89 122 PrintError => 1,
123 AutoCommit => 0,
92fe2181 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 {
3a4c1d89 138 %{$storage->_default_dbi_connect_attributes || {} },
139 PrintError => 1,
140 AutoCommit => 0,
92fe2181 141 },
142 ],
6c925c72 143 warn => qr/\QYou provided explicit AutoCommit => 0 in your connection_info/,
92fe2181 144 },
8fd069b9 145 'connect_info ([ \%attr_with_coderef ])' => {
146 args => [ {
147 dbh_maker => $coderef,
6b5e61af 148 dsn => 'blah',
149 user => 'bleh',
8fd069b9 150 on_connect_do => [qw/a b c/],
151 on_disconnect_do => [qw/d e f/],
152 } ],
153 dbi_connect_info => [
154 $coderef
155 ],
6b5e61af 156 warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/,
8fd069b9 157 },
92fe2181 158};
159
160for 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
6b5e61af 167 warnings_exist (
168 sub { $storage->connect_info ($invocations->{$type}{args}) },
169 $invocations->{$type}{warn} || (),
170 'Warned about ignored attributes',
171 );
92fe2181 172
6b5e61af 173 is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
92fe2181 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}
baa31d2f 184
6b5e61af 185done_testing;
186
efe6365b 1871;