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