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