t/747mssql_ado.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2 use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_ado';
   3
   4 use strict;
   5 use warnings;
   6
   7 use Test::More;
   8 use Test::Exception;
   9 use Try::Tiny;
  10 use DBIx::Class::Optional::Dependencies ();
  11
  12 use DBICTest;
  13
  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 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
  17
  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
  30 $schema->storage->ensure_connected;
  31
  32 isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
  33
  34 my $ver = $schema->storage->_server_info->{normalized_dbms_version};
  35
  36 ok $ver, 'can introspect DBMS version';
  37
  38 # 2005 and greater
  39 is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
  40   'correct limit dialect detected';
  41
  42 $schema->storage->dbh_do (sub {
  43     my ($storage, $dbh) = @_;
  44     try { local $^W = 0; $dbh->do("DROP TABLE artist") };
  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
  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' });
  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
 101 # test large column list in select
 102 $found = $schema->resultset('Artist')->search({ name => 'foo' }, {
 103   select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
 104   as     => ['artistid', 'name', map        "foo_$_", 0..50],
 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';
 108
 109 # create a few more rows
 110 for (1..12) {
 111   $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
 112 }
 113
 114 # test multiple active cursors
 115 my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
 116 my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
 117
 118 while ($rs1->next) {
 119   ok try { $rs2->next }, 'multiple active cursors';
 120 }
 121
 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
 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/) {
 222   local $schema->storage->{debug} = 0 if $size eq 'large';
 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';
 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
 369 done_testing;
 370
 371 # clean up our mess
 372 END {
 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/;
 377   }
 378
 379   undef $schema;
 380 }
 381 # vim:sw=2 sts=2