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 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
  34 $schema->storage->ensure_connected;
  35
  36 isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server');
  37
  38 my $ver = $schema->storage->_server_info->{normalized_dbms_version};
  39
  40 ok $ver, 'can introspect DBMS version';
  41
  42 # 2005 and greater
  43 is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'),
  44   'correct limit dialect detected';
  45
  46 $schema->storage->dbh_do (sub {
  47     my ($storage, $dbh) = @_;
  48     try { local $^W = 0; $dbh->do("DROP TABLE artist") };
  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
  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' });
  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
 105 # test large column list in select
 106 $found = $schema->resultset('Artist')->search({ name => 'foo' }, {
 107   select => ['artistid', 'name', map \"'foo' foo_$_", 0..50],
 108   as     => ['artistid', 'name', map        "foo_$_", 0..50],
 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';
 112
 113 # create a few more rows
 114 for (1..12) {
 115   $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
 116 }
 117
 118 # test multiple active cursors
 119 my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
 120 my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
 121
 122 while ($rs1->next) {
 123   ok try { $rs2->next }, 'multiple active cursors';
 124 }
 125
 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
 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/) {
 226   local $schema->storage->{debug} = 0 if $size eq 'large';
 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';
 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
 373 done_testing;
 374
 375 # clean up our mess
 376 END {
 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/;
 381   }
 382
 383   undef $schema;
 384 }
 385 # vim:sw=2 sts=2