Commit | Line | Data |
70350518 |
1 | use strict; |
bbdda281 |
2 | use warnings; |
70350518 |
3 | |
46e3af47 |
4 | # use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else |
5 | BEGIN { |
6 | if (my $lib_dirs = $ENV{DBICTEST_MSSQL_PERL5LIB}) { |
7 | unshift @INC, $_ for split /:/, $lib_dirs; |
8 | } |
9 | } |
10 | |
70350518 |
11 | use Test::More; |
8c52ffd3 |
12 | use Test::Exception; |
199fbc45 |
13 | use DBIx::Class::Optional::Dependencies (); |
70350518 |
14 | use lib qw(t/lib); |
15 | use DBICTest; |
eef2ff6c |
16 | |
17 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/}; |
18 | |
70350518 |
19 | plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test' |
eef2ff6c |
20 | unless ($dsn); |
21 | |
49b3a264 |
22 | |
23 | plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_sybase') |
24 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_sybase'); |
25 | |
77c7628c |
26 | { |
27 | my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version}; |
28 | ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') ); |
29 | } |
30 | |
b30f1a32 |
31 | my $schema; |
32 | |
bbdda281 |
33 | my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass) |
34 | ->storage |
35 | ->_supports_typeless_placeholders; |
36 | my @test_storages = ( |
37 | $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (), |
c29ce317 |
38 | 'DBI::Sybase::Microsoft_SQL_Server::NoBindVars', |
7379eb67 |
39 | ); |
8c52ffd3 |
40 | |
bbdda281 |
41 | for my $storage_type (@test_storages) { |
42 | $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
eef2ff6c |
43 | |
bbdda281 |
44 | if ($storage_type =~ /NoBindVars\z/) { |
45 | # since we want to use the nobindvar - disable the capability so the |
46 | # rebless happens to the correct class |
47 | $schema->storage->_use_typeless_placeholders (0); |
7379eb67 |
48 | } |
49 | |
c1e5a9ac |
50 | local $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN} = 1; # disable nobindvars warning |
51 | |
bbdda281 |
52 | $schema->storage->ensure_connected; |
b30f1a32 |
53 | |
54 | if ($storage_type =~ /NoBindVars\z/) { |
55 | is $schema->storage->disable_sth_caching, 1, |
56 | 'prepare_cached disabled for NoBindVars'; |
57 | } |
58 | |
c29ce317 |
59 | isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type"); |
7379eb67 |
60 | |
99083752 |
61 | SKIP: { |
62 | skip 'This version of DBD::Sybase segfaults on disconnect', 1 if DBD::Sybase->VERSION < 1.08; |
7379eb67 |
63 | |
99083752 |
64 | # start disconnected to test _ping |
65 | $schema->storage->_dbh->disconnect; |
66 | |
67 | lives_ok { |
68 | $schema->storage->dbh_do(sub { $_[1]->do('select 1') }) |
69 | } '_ping works'; |
70 | } |
ecdf1ac8 |
71 | |
72 | my $dbh = $schema->storage->dbh; |
7379eb67 |
73 | |
74 | $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL |
75 | DROP TABLE artist"); |
76 | $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL |
77 | DROP TABLE cd"); |
78 | |
79 | $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);"); |
80 | $dbh->do("CREATE TABLE cd (cdid INT IDENTITY PRIMARY KEY, artist INT, title VARCHAR(100), year VARCHAR(100), genreid INT NULL, single_track INT NULL);"); |
3ff5b740 |
81 | # Just to test compat shim, Auto is in Core |
7379eb67 |
82 | $schema->class('Artist')->load_components('PK::Auto::MSSQL'); |
eef2ff6c |
83 | |
84 | # Test PK |
7379eb67 |
85 | my $new = $schema->resultset('Artist')->create( { name => 'foo' } ); |
86 | ok($new->artistid, "Auto-PK worked"); |
eef2ff6c |
87 | |
88 | # Test LIMIT |
7379eb67 |
89 | for (1..6) { |
90 | $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } ); |
91 | } |
eef2ff6c |
92 | |
7379eb67 |
93 | my $it = $schema->resultset('Artist')->search( { }, |
94 | { rows => 3, |
95 | offset => 2, |
96 | order_by => 'artistid' |
97 | } |
98 | ); |
eef2ff6c |
99 | |
b4474f31 |
100 | # Test ? in data don't get treated as placeholders |
7379eb67 |
101 | my $cd = $schema->resultset('CD')->create( { |
102 | artist => 1, |
103 | title => 'Does this break things?', |
104 | year => 2007, |
105 | } ); |
106 | ok($cd->id, 'Not treating ? in data as placeholders'); |
107 | |
108 | is( $it->count, 3, "LIMIT count ok" ); |
109 | ok( $it->next->name, "iterator->next ok" ); |
110 | $it->next; |
111 | $it->next; |
112 | is( $it->next, undef, "next past end of resultset ok" ); |
eef2ff6c |
113 | |
5064f5c3 |
114 | # test MONEY column support |
7379eb67 |
115 | $schema->storage->dbh_do (sub { |
116 | my ($storage, $dbh) = @_; |
117 | eval { $dbh->do("DROP TABLE money_test") }; |
118 | $dbh->do(<<'SQL'); |
7379eb67 |
119 | CREATE TABLE money_test ( |
120 | id INT IDENTITY PRIMARY KEY, |
121 | amount MONEY NULL |
122 | ) |
5064f5c3 |
123 | SQL |
b30f1a32 |
124 | }); |
5064f5c3 |
125 | |
b30f1a32 |
126 | my $rs = $schema->resultset('Money'); |
5064f5c3 |
127 | |
7379eb67 |
128 | my $row; |
129 | lives_ok { |
130 | $row = $rs->create({ amount => 100 }); |
131 | } 'inserted a money value'; |
5064f5c3 |
132 | |
a33d2444 |
133 | cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip'; |
5064f5c3 |
134 | |
7379eb67 |
135 | lives_ok { |
136 | $row->update({ amount => 200 }); |
137 | } 'updated a money value'; |
5064f5c3 |
138 | |
a33d2444 |
139 | cmp_ok $rs->find($row->id)->amount, '==', 200, |
140 | 'updated money value round-trip'; |
5064f5c3 |
141 | |
7379eb67 |
142 | lives_ok { |
143 | $row->update({ amount => undef }); |
144 | } 'updated a money value to NULL'; |
5064f5c3 |
145 | |
c8365716 |
146 | is $rs->find($row->id)->amount, |
147 | undef, 'updated money value to NULL round-trip'; |
a467a0c9 |
148 | |
b90d7eba |
149 | $rs->delete; |
150 | |
151 | # test simple transaction with commit |
152 | lives_ok { |
153 | $schema->txn_do(sub { |
b30f1a32 |
154 | $rs->create({ amount => 300 }); |
b90d7eba |
155 | }); |
156 | } 'simple transaction'; |
157 | |
b30f1a32 |
158 | cmp_ok $rs->first->amount, '==', 300, 'committed'; |
b90d7eba |
159 | |
b30f1a32 |
160 | $rs->reset; |
b90d7eba |
161 | $rs->delete; |
162 | |
163 | # test rollback |
164 | throws_ok { |
165 | $schema->txn_do(sub { |
b30f1a32 |
166 | $rs->create({ amount => 700 }); |
b90d7eba |
167 | die 'mtfnpy'; |
168 | }); |
169 | } qr/mtfnpy/, 'simple failed txn'; |
170 | |
171 | is $rs->first, undef, 'rolled back'; |
b30f1a32 |
172 | |
b90d7eba |
173 | $rs->reset; |
b30f1a32 |
174 | $rs->delete; |
175 | |
176 | # test multiple active statements |
177 | { |
178 | $rs->create({ amount => 800 + $_ }) for 1..3; |
179 | |
180 | my @map = ( |
181 | [ 'Artist 1', '801.00' ], |
182 | [ 'Artist 2', '802.00' ], |
183 | [ 'Artist 3', '803.00' ] |
184 | ); |
185 | |
186 | my $artist_rs = $schema->resultset('Artist')->search({ |
187 | name => { -like => 'Artist %' } |
188 | });; |
189 | |
190 | my $i = 0; |
191 | |
192 | while (my $money_row = $rs->next) { |
193 | my $artist_row = $artist_rs->next; |
194 | |
195 | is_deeply [ $artist_row->name, $money_row->amount ], $map[$i++], |
196 | 'multiple active statements'; |
197 | } |
198 | $rs->reset; |
199 | $rs->delete; |
200 | } |
201 | |
c1e5a9ac |
202 | # test transaction handling on a disconnected handle |
203 | my $wrappers = { |
204 | no_transaction => sub { shift->() }, |
205 | txn_do => sub { my $code = shift; $schema->txn_do(sub { $code->() } ) }, |
206 | txn_begin => sub { $schema->txn_begin; shift->(); $schema->txn_commit }, |
207 | txn_guard => sub { my $g = $schema->txn_scope_guard; shift->(); $g->commit }, |
208 | }; |
209 | for my $wrapper (keys %$wrappers) { |
210 | $rs->delete; |
211 | |
212 | # a reconnect should trigger on next action |
213 | $schema->storage->_get_dbh->disconnect; |
214 | |
215 | lives_and { |
216 | $wrappers->{$wrapper}->( sub { |
217 | $rs->create({ amount => 900 + $_ }) for 1..3; |
218 | }); |
219 | is $rs->count, 3; |
220 | } "transaction on disconnected handle with $wrapper wrapper"; |
221 | } |
222 | |
223 | TODO: { |
224 | local $TODO = 'Transaction handling with multiple active statements will ' |
225 | .'need eager cursor support.'; |
226 | |
227 | # test transaction handling on a disconnected handle with multiple active |
228 | # statements |
229 | my $wrappers = { |
230 | no_transaction => sub { shift->() }, |
231 | txn_do => sub { my $code = shift; $schema->txn_do(sub { $code->() } ) }, |
232 | txn_begin => sub { $schema->txn_begin; shift->(); $schema->txn_commit }, |
233 | txn_guard => sub { my $g = $schema->txn_scope_guard; shift->(); $g->commit }, |
234 | }; |
235 | for my $wrapper (keys %$wrappers) { |
236 | $rs->reset; |
237 | $rs->delete; |
238 | $rs->create({ amount => 1000 + $_ }) for (1..3); |
239 | |
240 | my $artist_rs = $schema->resultset('Artist')->search({ |
241 | name => { -like => 'Artist %' } |
242 | });; |
243 | |
244 | $rs->next; |
245 | |
246 | my $map = [ ['Artist 1', '1002.00'], ['Artist 2', '1003.00'] ]; |
247 | |
248 | lives_and { |
249 | my @results; |
250 | |
251 | $wrappers->{$wrapper}->( sub { |
252 | while (my $money = $rs->next) { |
253 | my $artist = $artist_rs->next; |
254 | push @results, [ $artist->name, $money->amount ]; |
255 | }; |
256 | }); |
257 | |
258 | is_deeply \@results, $map; |
259 | } "transactions with multiple active statement with $wrapper wrapper"; |
260 | } |
261 | } |
a218ef4e |
262 | |
263 | # test RNO detection when version detection fails |
264 | SKIP: { |
265 | my $storage = $schema->storage; |
266 | my $version = $storage->_server_info->{normalized_dbms_version}; |
99083752 |
267 | |
268 | skip 'could not detect SQL Server version', 1 if not defined $version; |
a218ef4e |
269 | |
270 | my $have_rno = $version >= 9 ? 1 : 0; |
271 | |
bbdda281 |
272 | local $storage->{_dbh_details}{info} = {}; # delete cache |
4282b6f8 |
273 | |
a218ef4e |
274 | my $rno_detected = |
6a247f33 |
275 | ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0; |
a218ef4e |
276 | |
233c3a46 |
277 | ok (($have_rno == $rno_detected), |
a218ef4e |
278 | 'row_number() over support detected correctly'); |
279 | } |
0a064375 |
280 | |
281 | { |
282 | my $schema = DBICTest::Schema->clone; |
283 | $schema->connection($dsn, $user, $pass); |
284 | |
285 | like $schema->storage->sql_maker->{limit_dialect}, |
286 | qr/^(?:Top|RowNumberOver)\z/, |
287 | 'sql_maker is correct on unconnected schema'; |
288 | } |
7379eb67 |
289 | } |
5064f5c3 |
290 | |
559ae74c |
291 | # test op-induced autoconnect |
292 | lives_ok (sub { |
293 | |
294 | my $schema = DBICTest::Schema->clone; |
295 | $schema->connection($dsn, $user, $pass); |
296 | |
297 | my $artist = $schema->resultset ('Artist')->search ({}, { order_by => 'artistid' })->next; |
298 | is ($artist->id, 1, 'Artist retrieved successfully'); |
299 | }, 'Query-induced autoconnect works'); |
300 | |
c1e5a9ac |
301 | # test AutoCommit=0 |
302 | { |
303 | local $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK} = 1; |
304 | my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 0 }); |
305 | |
306 | my $rs = $schema2->resultset('Money'); |
307 | |
308 | $rs->delete; |
309 | $schema2->txn_commit; |
310 | |
311 | is $rs->count, 0, 'initially empty' |
312 | || diag ('Found row with amount ' . $_->amount) for $rs->all; |
313 | |
314 | $rs->create({ amount => 3000 }); |
315 | $schema2->txn_rollback; |
316 | |
317 | is $rs->count, 0, 'rolled back in AutoCommit=0' |
318 | || diag ('Found row with amount ' . $_->amount) for $rs->all; |
319 | |
320 | $rs->create({ amount => 4000 }); |
321 | $schema2->txn_commit; |
322 | |
323 | cmp_ok $rs->first->amount, '==', 4000, 'committed in AutoCommit=0'; |
324 | } |
325 | |
1a789a72 |
326 | done_testing; |
327 | |
3ff5b740 |
328 | # clean up our mess |
329 | END { |
7379eb67 |
330 | if (my $dbh = eval { $schema->storage->dbh }) { |
331 | $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist"); |
332 | $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd"); |
333 | $dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test"); |
334 | } |
3ff5b740 |
335 | } |