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_ado'; |
3 | |
4ffa5700 |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Test::More; |
2edf3352 |
8 | use Test::Exception; |
c0329273 |
9 | |
4ffa5700 |
10 | use DBICTest; |
11 | |
56dca25f |
12 | # Example DSN (from frew): |
13 | # dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80; |
4ffa5700 |
14 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/}; |
15 | |
2edf3352 |
16 | DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/); |
17 | |
18 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
19 | $binstr{'large'} = $binstr{'small'} x 1024; |
20 | |
21 | my $maxloblen = length $binstr{'large'}; |
22 | |
23 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
24 | auto_savepoint => 1, |
25 | LongReadLen => $maxloblen, |
26 | }); |
27 | |
4ffa5700 |
28 | $schema->storage->ensure_connected; |
29 | |
2edf3352 |
30 | isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server'); |
4ffa5700 |
31 | |
56dca25f |
32 | my $ver = $schema->storage->_server_info->{normalized_dbms_version}; |
33 | |
34 | ok $ver, 'can introspect DBMS version'; |
35 | |
2edf3352 |
36 | # 2005 and greater |
56dca25f |
37 | is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'), |
38 | 'correct limit dialect detected'; |
39 | |
4ffa5700 |
40 | $schema->storage->dbh_do (sub { |
41 | my ($storage, $dbh) = @_; |
e2741c7f |
42 | eval { local $^W = 0; $dbh->do("DROP TABLE artist") }; |
4ffa5700 |
43 | $dbh->do(<<'SQL'); |
44 | CREATE TABLE artist ( |
45 | artistid INT IDENTITY NOT NULL, |
46 | name VARCHAR(100), |
47 | rank INT NOT NULL DEFAULT '13', |
48 | charfield CHAR(10) NULL, |
49 | primary key(artistid) |
50 | ) |
51 | SQL |
52 | }); |
53 | |
2edf3352 |
54 | $schema->storage->dbh_do (sub { |
55 | my ($storage, $dbh) = @_; |
e2741c7f |
56 | eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") }; |
2edf3352 |
57 | $dbh->do(<<"SQL"); |
58 | CREATE TABLE artist_guid ( |
59 | artistid UNIQUEIDENTIFIER NOT NULL, |
60 | name VARCHAR(100), |
61 | rank INT NULL, |
62 | charfield CHAR(10) NULL, |
63 | a_guid UNIQUEIDENTIFIER, |
64 | primary key(artistid) |
65 | ) |
66 | SQL |
67 | }); |
68 | |
69 | my $have_max = $ver >= 9; # 2005 and greater |
70 | |
71 | $schema->storage->dbh_do (sub { |
72 | my ($storage, $dbh) = @_; |
e2741c7f |
73 | eval { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") }; |
2edf3352 |
74 | $dbh->do(" |
75 | CREATE TABLE varying_max_test ( |
76 | id INT IDENTITY NOT NULL, |
77 | " . ($have_max ? " |
78 | varchar_max VARCHAR(MAX), |
79 | nvarchar_max NVARCHAR(MAX), |
80 | varbinary_max VARBINARY(MAX), |
81 | " : " |
82 | varchar_max TEXT, |
83 | nvarchar_max NTEXT, |
84 | varbinary_max IMAGE, |
85 | ") . " |
86 | primary key(id) |
87 | )"); |
88 | }); |
89 | |
90 | my $ars = $schema->resultset('Artist'); |
91 | |
92 | my $new = $ars->create({ name => 'foo' }); |
4ffa5700 |
93 | ok($new->artistid > 0, 'Auto-PK worked'); |
94 | |
95 | # make sure select works |
96 | my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first; |
97 | is $found->artistid, $new->artistid, 'search works'; |
98 | |
7282bf38 |
99 | # test large column list in select |
100 | $found = $schema->resultset('Artist')->search({ name => 'foo' }, { |
56dca25f |
101 | select => ['artistid', 'name', map \"'foo' foo_$_", 0..50], |
102 | as => ['artistid', 'name', map "foo_$_", 0..50], |
7282bf38 |
103 | })->first; |
104 | is $found->artistid, $new->artistid, 'select with big column list'; |
105 | is $found->get_column('foo_50'), 'foo', 'last item in big column list'; |
e38348dd |
106 | |
4ffa5700 |
107 | # create a few more rows |
8bcd9ece |
108 | for (1..12) { |
4ffa5700 |
109 | $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
110 | } |
111 | |
112 | # test multiple active cursors |
7c5b1b9f |
113 | my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' }); |
114 | my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' }); |
4ffa5700 |
115 | |
116 | while ($rs1->next) { |
e2741c7f |
117 | lives_ok { ok $rs2->next } 'multiple active cursors'; |
4ffa5700 |
118 | } |
119 | |
8bcd9ece |
120 | # test bug where ADO blows up if the first bindparam is shorter than the second |
121 | is $schema->resultset('Artist')->search({ artistid => 2 })->first->name, |
122 | 'Artist 1', |
123 | 'short bindparam'; |
124 | |
125 | is $schema->resultset('Artist')->search({ artistid => 13 })->first->name, |
126 | 'Artist 12', |
127 | 'longer bindparam'; |
128 | |
2edf3352 |
129 | # test explicit key spec |
130 | $new = $ars->create ({ name => 'bar', artistid => 66 }); |
131 | is($new->artistid, 66, 'Explicit PK worked'); |
132 | $new->discard_changes; |
133 | is($new->artistid, 66, 'Explicit PK assigned'); |
134 | |
135 | # test basic transactions |
136 | $schema->txn_do(sub { |
137 | $ars->create({ name => 'transaction_commit' }); |
138 | }); |
139 | ok($ars->search({ name => 'transaction_commit' })->first, |
140 | 'transaction committed'); |
141 | $ars->search({ name => 'transaction_commit' })->delete, |
142 | throws_ok { |
143 | $schema->txn_do(sub { |
144 | $ars->create({ name => 'transaction_rollback' }); |
145 | die 'rolling back'; |
146 | }); |
147 | } qr/rolling back/, 'rollback executed'; |
148 | is $ars->search({ name => 'transaction_rollback' })->first, undef, |
149 | 'transaction rolled back'; |
150 | |
151 | # test two-phase commit and inner transaction rollback from nested transactions |
152 | $schema->txn_do(sub { |
153 | $ars->create({ name => 'in_outer_transaction' }); |
154 | $schema->txn_do(sub { |
155 | $ars->create({ name => 'in_inner_transaction' }); |
156 | }); |
157 | ok($ars->search({ name => 'in_inner_transaction' })->first, |
158 | 'commit from inner transaction visible in outer transaction'); |
159 | throws_ok { |
160 | $schema->txn_do(sub { |
161 | $ars->create({ name => 'in_inner_transaction_rolling_back' }); |
162 | die 'rolling back inner transaction'; |
163 | }); |
164 | } qr/rolling back inner transaction/, 'inner transaction rollback executed'; |
165 | }); |
166 | ok($ars->search({ name => 'in_outer_transaction' })->first, |
167 | 'commit from outer transaction'); |
168 | ok($ars->search({ name => 'in_inner_transaction' })->first, |
169 | 'commit from inner transaction'); |
170 | is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first, |
171 | undef, |
172 | 'rollback from inner transaction'; |
173 | $ars->search({ name => 'in_outer_transaction' })->delete; |
174 | $ars->search({ name => 'in_inner_transaction' })->delete; |
175 | |
176 | # test populate |
177 | lives_ok (sub { |
178 | my @pop; |
179 | for (1..2) { |
180 | push @pop, { name => "Artist_$_" }; |
181 | } |
182 | $ars->populate (\@pop); |
183 | }); |
184 | |
185 | # test populate with explicit key |
186 | lives_ok (sub { |
187 | my @pop; |
188 | for (1..2) { |
189 | push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; |
190 | } |
191 | $ars->populate (\@pop); |
192 | }); |
193 | |
194 | # count what we did so far |
195 | is ($ars->count, 18, 'Simple count works'); |
196 | |
197 | # test empty insert |
198 | my $current_artistid = $ars->search({}, { |
199 | select => [ { max => 'artistid' } ], as => ['artistid'] |
200 | })->first->artistid; |
201 | |
202 | my $row; |
203 | lives_ok { $row = $ars->create({}) } |
204 | 'empty insert works'; |
205 | |
206 | $row->discard_changes; |
207 | |
208 | is $row->artistid, $current_artistid+1, |
209 | 'empty insert generated correct PK'; |
210 | |
211 | # test that autoinc column still works after empty insert |
212 | $row = $ars->create({ name => 'after_empty_insert' }); |
213 | |
214 | is $row->artistid, $current_artistid+2, |
215 | 'autoincrement column functional aftear empty insert'; |
216 | |
217 | my $rs = $schema->resultset('VaryingMAX'); |
218 | |
219 | foreach my $size (qw/small large/) { |
49eeb48d |
220 | local $schema->storage->{debug} = 0 if $size eq 'large'; |
2edf3352 |
221 | |
222 | my $str = $binstr{$size}; |
223 | my $row; |
224 | lives_ok { |
225 | $row = $rs->create({ |
226 | varchar_max => $str, nvarchar_max => $str, varbinary_max => $str |
227 | }); |
228 | } "created $size VARXXX(MAX) LOBs"; |
229 | |
230 | lives_ok { |
231 | $row->discard_changes; |
232 | } 're-selected just-inserted LOBs'; |
233 | |
e2741c7f |
234 | for my $type (qw( varchar nvarchar varbinary ) ) { |
235 | my $meth = "${type}_max"; |
236 | is( |
237 | eval { $row->$meth }, |
238 | $str, |
239 | ( uc $type ) . '(MAX) matches' |
240 | ); |
241 | } |
2edf3352 |
242 | } |
243 | |
244 | # test regular blobs |
245 | |
e2741c7f |
246 | eval { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') }; |
2edf3352 |
247 | $schema->storage->dbh->do(qq[ |
248 | CREATE TABLE bindtype_test |
249 | ( |
250 | id INT IDENTITY NOT NULL PRIMARY KEY, |
251 | bytea INT NULL, |
252 | blob IMAGE NULL, |
253 | clob TEXT NULL, |
254 | a_memo NTEXT NULL |
255 | ) |
256 | ],{ RaiseError => 1, PrintError => 1 }); |
257 | |
258 | $rs = $schema->resultset('BindType'); |
259 | my $id = 0; |
260 | |
261 | foreach my $type (qw( blob clob a_memo )) { |
262 | foreach my $size (qw( small large )) { |
263 | $id++; |
264 | |
265 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
266 | "inserted $size $type without dying" or next; |
267 | |
268 | my $from_db = eval { $rs->find($id)->$type } || ''; |
269 | diag $@ if $@; |
270 | |
271 | ok($from_db eq $binstr{$size}, "verified inserted $size $type" ) |
272 | or do { |
273 | my $hexdump = sub { |
274 | join '', map sprintf('%02X', ord), split //, shift |
275 | }; |
276 | diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...', |
277 | substr($hexdump->($from_db),-255); |
278 | diag 'Size: ', length($from_db); |
279 | diag 'Expected Size: ', length($binstr{$size}); |
280 | diag 'Expected: ', "\n", |
281 | substr($hexdump->($binstr{$size}), 0, 255), |
282 | "...", substr($hexdump->($binstr{$size}),-255); |
283 | }; |
284 | } |
285 | } |
286 | # test IMAGE update |
287 | lives_ok { |
288 | $rs->search({ id => 0 })->update({ blob => $binstr{small} }); |
289 | } 'updated IMAGE to small binstr without dying'; |
290 | |
291 | lives_ok { |
292 | $rs->search({ id => 0 })->update({ blob => $binstr{large} }); |
293 | } 'updated IMAGE to large binstr without dying'; |
294 | |
295 | # test GUIDs |
296 | lives_ok { |
297 | $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) |
298 | } 'created a row with a GUID'; |
299 | |
300 | ok( |
301 | eval { $row->artistid }, |
302 | 'row has GUID PK col populated', |
303 | ); |
304 | diag $@ if $@; |
305 | |
e2741c7f |
306 | my $guid = eval { $row->artistid }||''; |
2edf3352 |
307 | |
308 | ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces') |
309 | or diag "GUID is: $guid"; |
310 | |
311 | ok( |
312 | eval { $row->a_guid }, |
313 | 'row has a GUID col with auto_nextval populated', |
314 | ); |
315 | diag $@ if $@; |
316 | |
317 | my $row_from_db = $schema->resultset('ArtistGUID') |
318 | ->search({ name => 'mtfnpy' })->first; |
319 | |
e2741c7f |
320 | is( |
321 | eval { $row_from_db->artistid }, |
322 | eval { $row->artistid }, |
323 | 'PK GUID round trip (via ->search->next)' |
324 | ); |
2edf3352 |
325 | |
e2741c7f |
326 | is( |
327 | eval { $row_from_db->a_guid }, |
328 | eval { $row->a_guid }, |
329 | 'NON-PK GUID round trip (via ->search->next)' |
330 | ); |
2edf3352 |
331 | |
e2741c7f |
332 | $row_from_db = eval { |
333 | $schema->resultset('ArtistGUID')->find($row->artistid) |
334 | }; |
2edf3352 |
335 | |
e2741c7f |
336 | is( |
337 | eval { $row_from_db->artistid }, |
338 | eval { $row->artistid }, |
339 | 'PK GUID round trip (via ->find)' |
340 | ); |
2edf3352 |
341 | |
e2741c7f |
342 | is( |
343 | eval { $row_from_db->a_guid }, |
344 | eval { $row->a_guid }, |
345 | 'NON-PK GUID round trip (via ->find)' |
346 | ); |
2edf3352 |
347 | |
348 | ($row_from_db) = $schema->resultset('ArtistGUID') |
349 | ->search({ name => 'mtfnpy' })->all; |
350 | |
e2741c7f |
351 | is( |
352 | eval { $row_from_db->artistid }, |
353 | eval { $row->artistid }, |
354 | 'PK GUID round trip (via ->search->all)' |
355 | ); |
2edf3352 |
356 | |
e2741c7f |
357 | is( |
358 | eval { $row_from_db->a_guid }, |
359 | eval { $row->a_guid }, |
360 | 'NON-PK GUID round trip (via ->search->all)' |
361 | ); |
2edf3352 |
362 | |
363 | lives_ok { |
364 | $row = $schema->resultset('ArtistGUID')->create({ |
365 | artistid => '70171270-4822-4450-81DF-921F99BA3C06', |
366 | name => 'explicit_guid', |
367 | }); |
368 | } 'created a row with explicit PK GUID'; |
369 | |
e2741c7f |
370 | is( |
371 | eval { $row->artistid }, |
372 | '70171270-4822-4450-81DF-921F99BA3C06', |
373 | 'row has correct PK GUID' |
374 | ); |
2edf3352 |
375 | |
376 | lives_ok { |
377 | $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' }); |
378 | } "updated row's PK GUID"; |
379 | |
e2741c7f |
380 | is( |
381 | eval { $row->artistid }, |
382 | '70171270-4822-4450-81DF-921F99BA3C07', |
383 | 'row has correct PK GUID' |
384 | ); |
2edf3352 |
385 | |
386 | lives_ok { |
387 | $row->delete; |
388 | } 'deleted the row'; |
389 | |
390 | lives_ok { |
391 | $schema->resultset('ArtistGUID')->populate([{ |
392 | artistid => '70171270-4822-4450-81DF-921F99BA3C06', |
393 | name => 'explicit_guid', |
394 | }]); |
395 | } 'created a row with explicit PK GUID via ->populate in void context'; |
396 | |
8bcd9ece |
397 | done_testing; |
398 | |
4ffa5700 |
399 | # clean up our mess |
400 | END { |
2edf3352 |
401 | local $SIG{__WARN__} = sub {}; |
e2741c7f |
402 | if (my $dbh = eval { $schema->storage->_dbh }) { |
403 | (eval { $dbh->do("DROP TABLE $_") }) |
2edf3352 |
404 | for qw/artist artist_guid varying_max_test bindtype_test/; |
4ffa5700 |
405 | } |
65d35121 |
406 | |
407 | undef $schema; |
4ffa5700 |
408 | } |
409 | # vim:sw=2 sts=2 |