t/747mssql_ado.t

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