t/746sybase.t

   1 use strict;
   2 use warnings;
   3 no warnings 'uninitialized';
   4
   5 use Test::More;
   6 use Test::Exception;
   7 use lib qw(t/lib);
   8
   9 BEGIN {
  10   require DBICTest::Schema::BindType;
  11   DBICTest::Schema::BindType->add_column(
  12     anint => { data_type => 'integer' }
  13   );
  14 }
  15
  16 use DBICTest;
  17
  18 require DBIx::Class::Storage::DBI::Sybase;
  19 require DBIx::Class::Storage::DBI::Sybase::NoBindVars;
  20
  21 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
  22
  23 my $TESTS = 51 + 2;
  24
  25 if (not ($dsn && $user)) {
  26   plan skip_all =>
  27     'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' .
  28     "\nWarning: This test drops and creates the tables " .
  29     "'artist', 'money_test' and 'bindtype_test'";
  30 } else {
  31   plan tests => $TESTS*2 + 1;
  32 }
  33
  34 my @storage_types = (
  35   'DBI::Sybase',
  36   'DBI::Sybase::NoBindVars',
  37 );
  38 my $schema;
  39 my $storage_idx = -1;
  40
  41 sub get_schema {
  42   DBICTest::Schema->connect($dsn, $user, $pass, {
  43     on_connect_call => [
  44       [ blob_setup => log_on_update => 1 ], # this is a safer option
  45     ],
  46   });
  47 }
  48
  49 my $ping_count = 0;
  50 {
  51   my $ping = DBIx::Class::Storage::DBI::Sybase->can('_ping');
  52   *DBIx::Class::Storage::DBI::Sybase::_ping = sub {
  53     $ping_count++;
  54     goto $ping;
  55   };
  56 }
  57
  58 for my $storage_type (@storage_types) {
  59   $storage_idx++;
  60
  61   unless ($storage_type eq 'DBI::Sybase') { # autodetect
  62     DBICTest::Schema->storage_type("::$storage_type");
  63   }
  64
  65   $schema = get_schema();
  66
  67   $schema->storage->ensure_connected;
  68
  69   if ($storage_idx == 0 &&
  70       $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::NoBindVars')) {
  71 # no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS)
  72       my $tb = Test::More->builder;
  73       $tb->skip('no placeholders') for 1..$TESTS;
  74       next;
  75   }
  76
  77   isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
  78
  79   $schema->storage->_dbh->disconnect;
  80   lives_ok (sub { $schema->storage->dbh }, 'reconnect works');
  81
  82   $schema->storage->dbh_do (sub {
  83       my ($storage, $dbh) = @_;
  84       eval { $dbh->do("DROP TABLE artist") };
  85       $dbh->do(<<'SQL');
  86 CREATE TABLE artist (
  87    artistid INT IDENTITY PRIMARY KEY,
  88    name VARCHAR(100),
  89    rank INT DEFAULT 13 NOT NULL,
  90    charfield CHAR(10) NULL
  91 )
  92 SQL
  93   });
  94
  95   my %seen_id;
  96
  97 # so we start unconnected
  98   $schema->storage->disconnect;
  99
 100 # test primary key handling
 101   my $new = $schema->resultset('Artist')->create({ name => 'foo' });
 102   ok($new->artistid > 0, "Auto-PK worked");
 103
 104   $seen_id{$new->artistid}++;
 105
 106 # check redispatch to storage-specific insert when auto-detected storage
 107   if ($storage_type eq 'DBI::Sybase') {
 108     DBICTest::Schema->storage_type('::DBI');
 109     $schema = get_schema();
 110   }
 111
 112   $new = $schema->resultset('Artist')->create({ name => 'Artist 1' });
 113   is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' );
 114   $seen_id{$new->artistid}++;
 115
 116 # inserts happen in a txn, so we make sure it still works inside a txn too
 117   $schema->txn_begin;
 118
 119   for (2..6) {
 120     $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
 121     is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
 122     $seen_id{$new->artistid}++;
 123   }
 124
 125   $schema->txn_commit;
 126
 127 # test simple count
 128   is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');
 129
 130 # test LIMIT support
 131   my $it = $schema->resultset('Artist')->search({
 132     artistid => { '>' => 0 }
 133   }, {
 134     rows => 3,
 135     order_by => 'artistid',
 136   });
 137
 138   is( $it->count, 3, "LIMIT count ok" );
 139
 140   is( $it->next->name, "foo", "iterator->next ok" );
 141   $it->next;
 142   is( $it->next->name, "Artist 2", "iterator->next ok" );
 143   is( $it->next, undef, "next past end of resultset ok" );
 144
 145 # now try with offset
 146   $it = $schema->resultset('Artist')->search({}, {
 147     rows => 3,
 148     offset => 3,
 149     order_by => 'artistid',
 150   });
 151
 152   is( $it->count, 3, "LIMIT with offset count ok" );
 153
 154   is( $it->next->name, "Artist 3", "iterator->next ok" );
 155   $it->next;
 156   is( $it->next->name, "Artist 5", "iterator->next ok" );
 157   is( $it->next, undef, "next past end of resultset ok" );
 158
 159 # now try a grouped count
 160   $schema->resultset('Artist')->create({ name => 'Artist 6' })
 161     for (1..6);
 162
 163   $it = $schema->resultset('Artist')->search({}, {
 164     group_by => 'name'
 165   });
 166
 167   is( $it->count, 7, 'COUNT of GROUP_BY ok' );
 168
 169 # do an IDENTITY_INSERT
 170   {
 171     no warnings 'redefine';
 172
 173     my @debug_out;
 174     local $schema->storage->{debug} = 1;
 175     local $schema->storage->debugobj->{callback} = sub {
 176       push @debug_out, $_[1];
 177     };
 178
 179     my $txn_used = 0;
 180     my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit;
 181     local *DBIx::Class::Storage::DBI::txn_commit = sub {
 182       $txn_used = 1;
 183       goto &$txn_commit;
 184     };
 185
 186     $schema->resultset('Artist')
 187       ->create({ artistid => 999, name => 'mtfnpy' });
 188
 189     ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used');
 190
 191     SKIP: {
 192       skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1
 193         if $storage_type =~ /NoBindVars/i;
 194
 195       is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT';
 196     }
 197   }
 198
 199 # do an IDENTITY_UPDATE
 200   {
 201     my @debug_out;
 202     local $schema->storage->{debug} = 1;
 203     local $schema->storage->debugobj->{callback} = sub {
 204       push @debug_out, $_[1];
 205     };
 206
 207     lives_and {
 208       $schema->resultset('Artist')
 209         ->find(999)->update({ artistid => 555 });
 210       ok((grep /IDENTITY_UPDATE/i, @debug_out));
 211     } 'IDENTITY_UPDATE used';
 212     $ping_count-- if $@;
 213   }
 214
 215
 216 # test insert_bulk using populate, this should always pass whether or not it
 217 # does anything Sybase specific or not. Just here to aid debugging.
 218   lives_ok {
 219     $schema->resultset('Artist')->populate([
 220       {
 221         name => 'bulk artist 1',
 222         charfield => 'foo',
 223       },
 224       {
 225         name => 'bulk artist 2',
 226         charfield => 'foo',
 227       },
 228       {
 229         name => 'bulk artist 3',
 230         charfield => 'foo',
 231       },
 232     ]);
 233   } 'insert_bulk via populate';
 234
 235   my $bulk_rs = $schema->resultset('Artist')->search({
 236     name => { -like => 'bulk artist %' }
 237   });
 238
 239   is $bulk_rs->count, 3, 'correct number inserted via insert_bulk';
 240
 241   is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
 242     'column set correctly via insert_bulk');
 243
 244   my %bulk_ids;
 245   @bulk_ids{map $_->artistid, $bulk_rs->all} = ();
 246
 247   is ((scalar keys %bulk_ids), 3,
 248     'identities generated correctly in insert_bulk');
 249
 250   $bulk_rs->delete;
 251
 252 # now test insert_bulk with IDENTITY_INSERT
 253   lives_ok {
 254     $schema->resultset('Artist')->populate([
 255       {
 256         artistid => 2001,
 257         name => 'bulk artist 1',
 258         charfield => 'foo',
 259       },
 260       {
 261         artistid => 2002,
 262         name => 'bulk artist 2',
 263         charfield => 'foo',
 264       },
 265       {
 266         artistid => 2003,
 267         name => 'bulk artist 3',
 268         charfield => 'foo',
 269       },
 270     ]);
 271   } 'insert_bulk with IDENTITY_INSERT via populate';
 272
 273   is $bulk_rs->count, 3,
 274     'correct number inserted via insert_bulk with IDENTITY_INSERT';
 275
 276   is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
 277     'column set correctly via insert_bulk with IDENTITY_INSERT');
 278
 279   $bulk_rs->delete;
 280
 281 # test correlated subquery
 282   my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } })
 283     ->get_column('artistid')
 284     ->as_query;
 285   my $subq_rs = $schema->resultset('Artist')->search({
 286     artistid => { -in => $subq }
 287   });
 288   is $subq_rs->count, 11, 'correlated subquery';
 289
 290 # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
 291   SKIP: {
 292     skip 'TEXT/IMAGE support does not work with FreeTDS', 16
 293       if $schema->storage->using_freetds;
 294
 295     my $dbh = $schema->storage->_dbh;
 296     {
 297       local $SIG{__WARN__} = sub {};
 298       eval { $dbh->do('DROP TABLE bindtype_test') };
 299
 300       $dbh->do(qq[
 301         CREATE TABLE bindtype_test
 302         (
 303           id    INT   IDENTITY PRIMARY KEY,
 304           bytea INT   NULL,
 305           blob  IMAGE NULL,
 306           clob  TEXT  NULL,
 307           anint INT   NULL
 308         )
 309       ],{ RaiseError => 1, PrintError => 0 });
 310     }
 311
 312     my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
 313     $binstr{'large'} = $binstr{'small'} x 1024;
 314
 315     my $maxloblen = length $binstr{'large'};
 316
 317     if (not $schema->storage->using_freetds) {
 318       $dbh->{'LongReadLen'} = $maxloblen * 2;
 319     } else {
 320       $dbh->do("set textsize ".($maxloblen * 2));
 321     }
 322
 323     my $rs = $schema->resultset('BindType');
 324     my $last_id;
 325
 326     foreach my $type (qw(blob clob)) {
 327       foreach my $size (qw(small large)) {
 328         no warnings 'uninitialized';
 329
 330         my $created = eval { $rs->create( { $type => $binstr{$size} } ) };
 331         ok(!$@, "inserted $size $type without dying");
 332         diag $@ if $@;
 333
 334         $last_id = $created->id if $created;
 335
 336         my $got = eval {
 337           $rs->find($last_id)->$type
 338         };
 339         diag $@ if $@;
 340         ok($got eq $binstr{$size}, "verified inserted $size $type");
 341       }
 342     }
 343
 344     # blob insert with explicit PK
 345     # also a good opportunity to test IDENTITY_INSERT
 346
 347     $rs->delete;
 348
 349     my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) };
 350     ok(!$@, "inserted large blob without dying with manual PK");
 351     diag $@ if $@;
 352
 353     my $got = eval {
 354       $rs->find(1)->blob
 355     };
 356     diag $@ if $@;
 357     ok($got eq $binstr{large}, "verified inserted large blob with manual PK");
 358
 359     # try a blob update
 360     my $new_str = $binstr{large} . 'mtfnpy';
 361
 362     # check redispatch to storage-specific update when auto-detected storage
 363     if ($storage_type eq 'DBI::Sybase') {
 364       DBICTest::Schema->storage_type('::DBI');
 365       $schema = get_schema();
 366     }
 367
 368     eval { $rs->search({ id => 1 })->update({ blob => $new_str }) };
 369     ok !$@, 'updated blob successfully';
 370     diag $@ if $@;
 371     $got = eval {
 372       $rs->find(1)->blob
 373     };
 374     diag $@ if $@;
 375     ok($got eq $new_str, "verified updated blob");
 376
 377     # try a blob update with IDENTITY_UPDATE
 378     lives_and {
 379       $new_str = $binstr{large} . 'hlagh';
 380       $rs->find(1)->update({ id => 999, blob => $new_str });
 381       ok($rs->find(999)->blob eq $new_str);
 382     } 'verified updated blob with IDENTITY_UPDATE';
 383
 384     ## try multi-row blob update
 385     # first insert some blobs
 386     $rs->delete;
 387     $rs->create({ blob => $binstr{large} }) for (1..3);
 388     $new_str = $binstr{large} . 'foo';
 389     $rs->update({ blob => $new_str });
 390     is((grep $_->blob eq $new_str, $rs->all), 3, 'multi-row blob update');
 391
 392     # make sure impossible blob update throws
 393     throws_ok {
 394       $rs->update({ anint => 5 });
 395       $rs->create({ anint => 6 });
 396       $rs->search({ anint => 5 })->update({ blob => $new_str, anint => 6 });
 397     } qr/impossible/, 'impossible blob update throws';
 398   }
 399
 400 # test MONEY column support
 401   $schema->storage->dbh_do (sub {
 402       my ($storage, $dbh) = @_;
 403       eval { $dbh->do("DROP TABLE money_test") };
 404       $dbh->do(<<'SQL');
 405 CREATE TABLE money_test (
 406    id INT IDENTITY PRIMARY KEY,
 407    amount MONEY NULL
 408 )
 409 SQL
 410   });
 411
 412 # test insert transaction when there's an active cursor
 413   SKIP: {
 414     skip 'not testing insert with active cursor if using ::NoBindVars', 1
 415       if $storage_type =~ /NoBindVars/i;
 416
 417     my $artist_rs = $schema->resultset('Artist');
 418     $artist_rs->first;
 419     lives_ok {
 420       my $row = $schema->resultset('Money')->create({ amount => 100 });
 421       $row->delete;
 422     } 'inserted a row with an active cursor';
 423     $ping_count-- if $@; # dbh_do calls ->connected
 424   }
 425
 426 # test insert in an outer transaction when there's an active cursor
 427   TODO: {
 428     local $TODO = 'this should work once we have eager cursors';
 429
 430 # clear state, or we get a deadlock on $row->delete
 431 # XXX figure out why this happens
 432     $schema->storage->disconnect;
 433
 434     lives_ok {
 435       $schema->txn_do(sub {
 436         my $artist_rs = $schema->resultset('Artist');
 437         $artist_rs->first;
 438         my $row = $schema->resultset('Money')->create({ amount => 100 });
 439         $row->delete;
 440       });
 441     } 'inserted a row with an active cursor in outer txn';
 442     $ping_count-- if $@; # dbh_do calls ->connected
 443   }
 444
 445 # Now test money values.
 446   my $rs = $schema->resultset('Money');
 447
 448   my $row;
 449   lives_ok {
 450     $row = $rs->create({ amount => 100 });
 451   } 'inserted a money value';
 452
 453   is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip';
 454
 455   lives_ok {
 456     $row->update({ amount => 200 });
 457   } 'updated a money value';
 458
 459   is eval { $rs->find($row->id)->amount },
 460     200, 'updated money value round-trip';
 461
 462   lives_ok {
 463     $row->update({ amount => undef });
 464   } 'updated a money value to NULL';
 465
 466   my $null_amount = eval { $rs->find($row->id)->amount };
 467   ok(
 468     (($null_amount == undef) && (not $@)),
 469     'updated money value to NULL round-trip'
 470   );
 471   diag $@ if $@;
 472 }
 473
 474 is $ping_count, 0, 'no pings';
 475
 476 # clean up our mess
 477 END {
 478   if (my $dbh = eval { $schema->storage->_dbh }) {
 479     eval { $dbh->do("DROP TABLE $_") }
 480       for qw/artist bindtype_test money_test/;
 481   }
 482 }