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