7 use DBIx::Class::Optional::Dependencies ();
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');
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;
17 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
19 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test'
20 unless ($dsn && $user);
22 require DBICTest::Schema;
23 DBICTest::Schema->load_classes(qw/VaryingMAX ArtistGUID/);
25 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
26 $binstr{'large'} = $binstr{'small'} x 1024;
28 my $maxloblen = length $binstr{'large'};
30 my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
32 LongReadLen => $maxloblen,
35 $schema->storage->ensure_connected;
37 isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
39 my $ver = $schema->storage->_server_info->{normalized_dbms_version};
41 ok $ver, 'can introspect DBMS version';
44 is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
45 'correct limit dialect detected';
47 $schema->storage->dbh_do (sub {
48 my ($storage, $dbh) = @_;
49 try { local $^W = 0; $dbh->do("DROP TABLE artist") };
52 artistid INT IDENTITY NOT NULL,
54 rank INT NOT NULL DEFAULT '13',
55 charfield CHAR(10) NULL,
61 $schema->storage->dbh_do (sub {
62 my ($storage, $dbh) = @_;
63 try { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
65 CREATE TABLE artist_guid (
66 artistid UNIQUEIDENTIFIER NOT NULL,
69 charfield CHAR(10) NULL,
70 a_guid UNIQUEIDENTIFIER,
76 my $have_max = $ver >= 9; # 2005 and greater
78 $schema->storage->dbh_do (sub {
79 my ($storage, $dbh) = @_;
80 try { local $^W = 0; $dbh->do("DROP TABLE varying_max_test") };
82 CREATE TABLE varying_max_test (
83 id INT IDENTITY NOT NULL,
85 varchar_max VARCHAR(MAX),
86 nvarchar_max NVARCHAR(MAX),
87 varbinary_max VARBINARY(MAX),
97 my $ars = $schema->resultset('Artist');
99 my $new = $ars->create({ name => 'foo' });
100 ok($new->artistid > 0, 'Auto-PK worked');
102 # make sure select works
103 my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
104 is $found->artistid, $new->artistid, 'search works';
106 # test large column list in select
107 $found = $schema->resultset('Artist')->search({ name => 'foo' }, {
108 select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
109 as => ['artistid', 'name', map "foo_$_", 0..50],
111 is $found->artistid, $new->artistid, 'select with big column list';
112 is $found->get_column('foo_50'), 'foo', 'last item in big column list';
114 # create a few more rows
116 $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
119 # test multiple active cursors
120 my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
121 my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
124 ok try { $rs2->next }, 'multiple active cursors';
127 # test bug where ADO blows up if the first bindparam is shorter than the second
128 is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
132 is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
136 # test explicit key spec
137 $new = $ars->create ({ name => 'bar', artistid => 66 });
138 is($new->artistid, 66, 'Explicit PK worked');
139 $new->discard_changes;
140 is($new->artistid, 66, 'Explicit PK assigned');
142 # test basic transactions
143 $schema->txn_do(sub {
144 $ars->create({ name => 'transaction_commit' });
146 ok($ars->search({ name => 'transaction_commit' })->first,
147 'transaction committed');
148 $ars->search({ name => 'transaction_commit' })->delete,
150 $schema->txn_do(sub {
151 $ars->create({ name => 'transaction_rollback' });
154 } qr/rolling back/, 'rollback executed';
155 is $ars->search({ name => 'transaction_rollback' })->first, undef,
156 'transaction rolled back';
158 # test two-phase commit and inner transaction rollback from nested transactions
159 $schema->txn_do(sub {
160 $ars->create({ name => 'in_outer_transaction' });
161 $schema->txn_do(sub {
162 $ars->create({ name => 'in_inner_transaction' });
164 ok($ars->search({ name => 'in_inner_transaction' })->first,
165 'commit from inner transaction visible in outer transaction');
167 $schema->txn_do(sub {
168 $ars->create({ name => 'in_inner_transaction_rolling_back' });
169 die 'rolling back inner transaction';
171 } qr/rolling back inner transaction/, 'inner transaction rollback executed';
173 ok($ars->search({ name => 'in_outer_transaction' })->first,
174 'commit from outer transaction');
175 ok($ars->search({ name => 'in_inner_transaction' })->first,
176 'commit from inner transaction');
177 is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
179 'rollback from inner transaction';
180 $ars->search({ name => 'in_outer_transaction' })->delete;
181 $ars->search({ name => 'in_inner_transaction' })->delete;
187 push @pop, { name => "Artist_$_" };
189 $ars->populate (\@pop);
192 # test populate with explicit key
196 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
198 $ars->populate (\@pop);
201 # count what we did so far
202 is ($ars->count, 18, 'Simple count works');
205 my $current_artistid = $ars->search({}, {
206 select => [ { max => 'artistid' } ], as => ['artistid']
210 lives_ok { $row = $ars->create({}) }
211 'empty insert works';
213 $row->discard_changes;
215 is $row->artistid, $current_artistid+1,
216 'empty insert generated correct PK';
218 # test that autoinc column still works after empty insert
219 $row = $ars->create({ name => 'after_empty_insert' });
221 is $row->artistid, $current_artistid+2,
222 'autoincrement column functional aftear empty insert';
224 my $rs = $schema->resultset('VaryingMAX');
226 foreach my $size (qw/small large/) {
227 local $schema->storage->{debug} = 0 if $size eq 'large';
229 my $str = $binstr{$size};
233 varchar_max => $str, nvarchar_max => $str, varbinary_max => $str
235 } "created $size VARXXX(MAX) LOBs";
238 $row->discard_changes;
239 } 're-selected just-inserted LOBs';
241 cmp_ok try { $row->varchar_max }, 'eq', $str, 'VARCHAR(MAX) matches';
242 cmp_ok try { $row->nvarchar_max }, 'eq', $str, 'NVARCHAR(MAX) matches';
243 cmp_ok try { $row->varbinary_max }, 'eq', $str, 'VARBINARY(MAX) matches';
248 try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE bindtype_test') };
249 $schema->storage->dbh->do(qq[
250 CREATE TABLE bindtype_test
252 id INT IDENTITY NOT NULL PRIMARY KEY,
258 ],{ RaiseError => 1, PrintError => 1 });
260 $rs = $schema->resultset('BindType');
263 foreach my $type (qw( blob clob a_memo )) {
264 foreach my $size (qw( small large )) {
267 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
268 "inserted $size $type without dying" or next;
270 my $from_db = eval { $rs->find($id)->$type } || '';
273 ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
276 join '', map sprintf('%02X', ord), split //, shift
278 diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
279 substr($hexdump->($from_db),-255);
280 diag 'Size: ', length($from_db);
281 diag 'Expected Size: ', length($binstr{$size});
282 diag 'Expected: ', "\n",
283 substr($hexdump->($binstr{$size}), 0, 255),
284 "...", substr($hexdump->($binstr{$size}),-255);
290 $rs->search({ id => 0 })->update({ blob => $binstr{small} });
291 } 'updated IMAGE to small binstr without dying';
294 $rs->search({ id => 0 })->update({ blob => $binstr{large} });
295 } 'updated IMAGE to large binstr without dying';
299 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
300 } 'created a row with a GUID';
303 eval { $row->artistid },
304 'row has GUID PK col populated',
308 my $guid = try { $row->artistid }||'';
310 ok(($guid !~ /^{.*?}\z/), 'GUID not enclosed in braces')
311 or diag "GUID is: $guid";
314 eval { $row->a_guid },
315 'row has a GUID col with auto_nextval populated',
319 my $row_from_db = $schema->resultset('ArtistGUID')
320 ->search({ name => 'mtfnpy' })->first;
322 is try { $row_from_db->artistid }, try { $row->artistid },
323 'PK GUID round trip (via ->search->next)';
325 is try { $row_from_db->a_guid }, try { $row->a_guid },
326 'NON-PK GUID round trip (via ->search->next)';
328 $row_from_db = try { $schema->resultset('ArtistGUID')
329 ->find($row->artistid) };
331 is try { $row_from_db->artistid }, try { $row->artistid },
332 'PK GUID round trip (via ->find)';
334 is try { $row_from_db->a_guid }, try { $row->a_guid },
335 'NON-PK GUID round trip (via ->find)';
337 ($row_from_db) = $schema->resultset('ArtistGUID')
338 ->search({ name => 'mtfnpy' })->all;
340 is try { $row_from_db->artistid }, try { $row->artistid },
341 'PK GUID round trip (via ->search->all)';
343 is try { $row_from_db->a_guid }, try { $row->a_guid },
344 'NON-PK GUID round trip (via ->search->all)';
347 $row = $schema->resultset('ArtistGUID')->create({
348 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
349 name => 'explicit_guid',
351 } 'created a row with explicit PK GUID';
353 is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C06',
354 'row has correct PK GUID';
357 $row->update({ artistid => '70171270-4822-4450-81DF-921F99BA3C07' });
358 } "updated row's PK GUID";
360 is try { $row->artistid }, '70171270-4822-4450-81DF-921F99BA3C07',
361 'row has correct PK GUID';
368 $schema->resultset('ArtistGUID')->populate([{
369 artistid => '70171270-4822-4450-81DF-921F99BA3C06',
370 name => 'explicit_guid',
372 } 'created a row with explicit PK GUID via ->populate in void context';
378 local $SIG{__WARN__} = sub {};
379 if (my $dbh = try { $schema->storage->_dbh }) {
380 (try { $dbh->do("DROP TABLE $_") })
381 for qw/artist artist_guid varying_max_test bindtype_test/;