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