1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_ado';
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;
14 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
16 DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/);
18 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
19 $binstr{'large'} = $binstr{'small'} x 1024;
21 my $maxloblen = length $binstr{'large'};
23 my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
25 LongReadLen => $maxloblen,
28 $schema->storage->ensure_connected;
30 isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
32 my $ver = $schema->storage->_server_info->{normalized_dbms_version};
34 ok $ver, 'can introspect DBMS version';
37 is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
38 'correct limit dialect detected';
40 $schema->storage->dbh_do (sub {
41 my ($storage, $dbh) = @_;
42 eval { local $^W = 0; $dbh->do("DROP TABLE artist") };
45 artistid INT IDENTITY NOT NULL,
47 rank INT NOT NULL DEFAULT '13',
48 charfield CHAR(10) NULL,
54 $schema->storage->dbh_do (sub {
55 my ($storage, $dbh) = @_;
56 eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
58 CREATE TABLE artist_guid (
59 artistid UNIQUEIDENTIFIER NOT NULL,
62 charfield CHAR(10) NULL,
63 a_guid UNIQUEIDENTIFIER,
69 my $have_max = $ver >= 9; # 2005 and greater
71 $schema->storage->dbh_do (sub {
72 my ($storage, $dbh) = @_;
73 eval { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") };
75 CREATE TABLE varying_max_test (
76 id INT IDENTITY NOT NULL,
78 varchar_max VARCHAR(MAX),
79 nvarchar_max NVARCHAR(MAX),
80 varbinary_max VARBINARY(MAX),
90 my $ars = $schema->resultset('Artist');
92 my $new = $ars->create({ name => 'foo' });
93 ok($new->artistid > 0, 'Auto-PK worked');
95 # make sure select works
96 my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
97 is $found->artistid, $new->artistid, 'search works';
99 # test large column list in select
100 $found = $schema->resultset('Artist')->search({ name => 'foo' }, {
101 select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
102 as => ['artistid', 'name', map "foo_$_", 0..50],
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';
107 # create a few more rows
109 $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
112 # test multiple active cursors
113 my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
114 my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
117 lives_ok { ok $rs2->next } 'multiple active cursors';
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,
125 is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
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');
135 # test basic transactions
136 $schema->txn_do(sub {
137 $ars->create({ name => 'transaction_commit' });
139 ok($ars->search({ name => 'transaction_commit' })->first,
140 'transaction committed');
141 $ars->search({ name => 'transaction_commit' })->delete,
143 $schema->txn_do(sub {
144 $ars->create({ name => 'transaction_rollback' });
147 } qr/rolling back/, 'rollback executed';
148 is $ars->search({ name => 'transaction_rollback' })->first, undef,
149 'transaction rolled back';
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' });
157 ok($ars->search({ name => 'in_inner_transaction' })->first,
158 'commit from inner transaction visible in outer transaction');
160 $schema->txn_do(sub {
161 $ars->create({ name => 'in_inner_transaction_rolling_back' });
162 die 'rolling back inner transaction';
164 } qr/rolling back inner transaction/, 'inner transaction rollback executed';
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,
172 'rollback from inner transaction';
173 $ars->search({ name => 'in_outer_transaction' })->delete;
174 $ars->search({ name => 'in_inner_transaction' })->delete;
180 push @pop, { name => "Artist_$_" };
182 $ars->populate (\@pop);
185 # test populate with explicit key
189 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
191 $ars->populate (\@pop);
194 # count what we did so far
195 is ($ars->count, 18, 'Simple count works');
198 my $current_artistid = $ars->search({}, {
199 select => [ { max => 'artistid' } ], as => ['artistid']
203 lives_ok { $row = $ars->create({}) }
204 'empty insert works';
206 $row->discard_changes;
208 is $row->artistid, $current_artistid+1,
209 'empty insert generated correct PK';
211 # test that autoinc column still works after empty insert
212 $row = $ars->create({ name => 'after_empty_insert' });
214 is $row->artistid, $current_artistid+2,
215 'autoincrement column functional aftear empty insert';
217 my $rs = $schema->resultset('VaryingMAX');
219 foreach my $size (qw/small large/) {
220 local $schema->storage->{debug} = 0 if $size eq 'large';
222 my $str = $binstr{$size};
226 varchar_max => $str, nvarchar_max => $str, varbinary_max => $str
228 } "created $size VARXXX(MAX) LOBs";
231 $row->discard_changes;
232 } 're-selected just-inserted LOBs';
234 for my $type (qw( varchar nvarchar varbinary ) ) {
235 my $meth = "${type}_max";
237 eval { $row->$meth },
239 ( uc $type ) . '(MAX) matches'
246 eval { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') };
247 $schema->storage->dbh->do(qq[
248 CREATE TABLE bindtype_test
250 id INT IDENTITY NOT NULL PRIMARY KEY,
256 ],{ RaiseError => 1, PrintError => 1 });
258 $rs = $schema->resultset('BindType');
261 foreach my $type (qw( blob clob a_memo )) {
262 foreach my $size (qw( small large )) {
265 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
266 "inserted $size $type without dying" or next;
268 my $from_db = eval { $rs->find($id)->$type } || '';
271 ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
274 join '', map sprintf('%02X', ord), split //, shift
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);
288 $rs->search({ id => 0 })->update({ blob => $binstr{small} });
289 } 'updated IMAGE to small binstr without dying';
292 $rs->search({ id => 0 })->update({ blob => $binstr{large} });
293 } 'updated IMAGE to large binstr without dying';
297 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
298 } 'created a row with a GUID';
301 eval { $row->artistid },
302 'row has GUID PK col populated',
306 my $guid = eval { $row->artistid }||'';
308 ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
309 or diag "GUID is: $guid";
312 eval { $row->a_guid },
313 'row has a GUID col with auto_nextval populated',
317 my $row_from_db = $schema->resultset('ArtistGUID')
318 ->search({ name => 'mtfnpy' })->first;
321 eval { $row_from_db->artistid },
322 eval { $row->artistid },
323 'PK GUID round trip (via ->search->next)'
327 eval { $row_from_db->a_guid },
328 eval { $row->a_guid },
329 'NON-PK GUID round trip (via ->search->next)'
332 $row_from_db = eval {
333 $schema->resultset('ArtistGUID')->find($row->artistid)
337 eval { $row_from_db->artistid },
338 eval { $row->artistid },
339 'PK GUID round trip (via ->find)'
343 eval { $row_from_db->a_guid },
344 eval { $row->a_guid },
345 'NON-PK GUID round trip (via ->find)'
348 ($row_from_db) = $schema->resultset('ArtistGUID')
349 ->search({ name => 'mtfnpy' })->all;
352 eval { $row_from_db->artistid },
353 eval { $row->artistid },
354 'PK GUID round trip (via ->search->all)'
358 eval { $row_from_db->a_guid },
359 eval { $row->a_guid },
360 'NON-PK GUID round trip (via ->search->all)'
364 $row = $schema->resultset('ArtistGUID')->create({
365 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
366 name => 'explicit_guid',
368 } 'created a row with explicit PK GUID';
371 eval { $row->artistid },
372 '70171270-4822-4450-81DF-921F99BA3C06',
373 'row has correct PK GUID'
377 $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
378 } "updated row's PK GUID";
381 eval { $row->artistid },
382 '70171270-4822-4450-81DF-921F99BA3C07',
383 'row has correct PK GUID'
391 $schema->resultset('ArtistGUID')->populate([{
392 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
393 name => 'explicit_guid',
395 } 'created a row with explicit PK GUID via ->populate in void context';
401 local $SIG{__WARN__} = sub {};
402 if (my $dbh = eval { $schema->storage->_dbh }) {
403 (eval { $dbh->do("DROP TABLE $_") })
404 for qw/artist artist_guid varying_max_test bindtype_test/;