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