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