t/74mssql.t

   1 use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mssql_sybase';
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use Scalar::Util 'weaken';
   9 use lib qw(t/lib);
  10 use DBICTest;
  11
  12 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
  13 {
  14   my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version};
  15   ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') );
  16 }
  17
  18 my $schema;
  19
  20 my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass)
  21                                                     ->storage
  22                                                      ->_supports_typeless_placeholders;
  23 my @test_storages = (
  24   $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (),
  25   'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
  26 );
  27
  28 for my $storage_type (@test_storages) {
  29   $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  30
  31   if ($storage_type =~ /NoBindVars\z/) {
  32     # since we want to use the nobindvar - disable the capability so the
  33     # rebless happens to the correct class
  34     $schema->storage->_use_typeless_placeholders (0);
  35   }
  36
  37   local $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN} = 1; # disable nobindvars warning
  38
  39   $schema->storage->ensure_connected;
  40
  41   if ($storage_type =~ /NoBindVars\z/) {
  42     is $schema->storage->disable_sth_caching, 1,
  43       'prepare_cached disabled for NoBindVars';
  44   }
  45
  46   isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
  47
  48   SKIP: {
  49     skip 'This version of DBD::Sybase segfaults on disconnect', 1 if DBD::Sybase->VERSION < 1.08;
  50
  51     # start disconnected to test _ping
  52     $schema->storage->_dbh->disconnect;
  53
  54     lives_ok {
  55       $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
  56     } '_ping works';
  57   }
  58
  59   my $dbh = $schema->storage->dbh;
  60
  61   $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
  62       DROP TABLE artist");
  63   $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
  64       DROP TABLE cd");
  65
  66   $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);");
  67   $dbh->do("CREATE TABLE cd (cdid INT IDENTITY PRIMARY KEY, artist INT,  title VARCHAR(100), year VARCHAR(100), genreid INT NULL, single_track INT NULL);");
  68 # Just to test compat shim, Auto is in Core
  69   $schema->class('Artist')->load_components('PK::Auto::MSSQL');
  70
  71 # Test PK
  72   my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
  73   ok($new->artistid, "Auto-PK worked");
  74
  75 # Test LIMIT
  76   for (1..6) {
  77       $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
  78   }
  79
  80   my $it = $schema->resultset('Artist')->search( { },
  81       { rows     => 3,
  82         offset   => 2,
  83         order_by => 'artistid'
  84       }
  85   );
  86
  87 # Test ? in data don't get treated as placeholders
  88   my $cd = $schema->resultset('CD')->create( {
  89       artist      => 1,
  90       title       => 'Does this break things?',
  91       year        => 2007,
  92   } );
  93   ok($cd->id, 'Not treating ? in data as placeholders');
  94
  95   is( $it->count, 3, "LIMIT count ok" );
  96   ok( $it->next->name, "iterator->next ok" );
  97   $it->next;
  98   $it->next;
  99   is( $it->next, undef, "next past end of resultset ok" );
 100
 101 # test MONEY column support
 102   $schema->storage->dbh_do (sub {
 103       my ($storage, $dbh) = @_;
 104       eval { $dbh->do("DROP TABLE money_test") };
 105       $dbh->do(<<'SQL');
 106   CREATE TABLE money_test (
 107      id INT IDENTITY PRIMARY KEY,
 108      amount MONEY NULL
 109   )
 110 SQL
 111    });
 112
 113   my $rs = $schema->resultset('Money');
 114   weaken(my $rs_cp = $rs);  # nested closure refcounting is an utter mess in perl
 115
 116   my $row;
 117   lives_ok {
 118     $row = $rs->create({ amount => 100 });
 119   } 'inserted a money value';
 120
 121   cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
 122
 123   lives_ok {
 124     $row->update({ amount => 200 });
 125   } 'updated a money value';
 126
 127   cmp_ok $rs->find($row->id)->amount, '==', 200,
 128     'updated money value round-trip';
 129
 130   lives_ok {
 131     $row->update({ amount => undef });
 132   } 'updated a money value to NULL';
 133
 134   is $rs->find($row->id)->amount,
 135     undef, 'updated money value to NULL round-trip';
 136
 137   $rs->delete;
 138
 139   # test simple transaction with commit
 140   lives_ok {
 141     $schema->txn_do(sub {
 142       $rs_cp->create({ amount => 300 });
 143     });
 144   } 'simple transaction';
 145
 146   cmp_ok $rs->first->amount, '==', 300, 'committed';
 147
 148   $rs->reset;
 149   $rs->delete;
 150
 151   # test rollback
 152   throws_ok {
 153     $schema->txn_do(sub {
 154       $rs_cp->create({ amount => 700 });
 155       die 'mtfnpy';
 156     });
 157   } qr/mtfnpy/, 'simple failed txn';
 158
 159   is $rs->first, undef, 'rolled back';
 160
 161   $rs->reset;
 162   $rs->delete;
 163
 164   # test multiple active statements
 165   {
 166     $rs->create({ amount => 800 + $_ }) for 1..3;
 167
 168     my @map = (
 169       [ 'Artist 1', '801.00' ],
 170       [ 'Artist 2', '802.00' ],
 171       [ 'Artist 3', '803.00' ]
 172     );
 173
 174     my $artist_rs = $schema->resultset('Artist')->search({
 175       name => { -like => 'Artist %' }
 176     });;
 177
 178     my $i = 0;
 179
 180     while (my $money_row = $rs->next) {
 181       my $artist_row = $artist_rs->next;
 182
 183       is_deeply [ $artist_row->name, $money_row->amount ], $map[$i++],
 184         'multiple active statements';
 185     }
 186     $rs->reset;
 187     $rs->delete;
 188   }
 189
 190   my $wrappers = {
 191     no_transaction => sub { shift->() },
 192     txn_do => sub { my $code = shift; $schema->txn_do(sub { $code->() } ) },
 193     txn_begin => sub { $schema->txn_begin; shift->(); $schema->txn_commit },
 194     txn_guard => sub { my $g = $schema->txn_scope_guard; shift->(); $g->commit },
 195   };
 196
 197   # test transaction handling on a disconnected handle
 198   for my $wrapper (keys %$wrappers) {
 199     $rs->delete;
 200
 201     # a reconnect should trigger on next action
 202     $schema->storage->_get_dbh->disconnect;
 203
 204
 205     lives_and {
 206       $wrappers->{$wrapper}->( sub {
 207         $rs_cp->create({ amount => 900 + $_ }) for 1..3;
 208       });
 209       is $rs->count, 3;
 210     } "transaction on disconnected handle with $wrapper wrapper";
 211   }
 212
 213   # test transaction handling on a disconnected handle with multiple active
 214   # statements
 215   for my $wrapper (keys %$wrappers) {
 216     $schema->storage->disconnect;
 217     $rs->delete;
 218     $rs->reset;
 219     $rs->create({ amount => 1000 + $_ }) for (1..3);
 220
 221     my $artist_rs = $schema->resultset('Artist')->search({
 222       name => { -like => 'Artist %' }
 223     });;
 224
 225     $rs->next;
 226
 227     my $map = [ ['Artist 1', '1002.00'], ['Artist 2', '1003.00'] ];
 228
 229     weaken(my $a_rs_cp = $artist_rs);
 230
 231     local $TODO = 'Transaction handling with multiple active statements will '
 232                  .'need eager cursor support.'
 233       unless $wrapper eq 'no_transaction';
 234
 235     lives_and {
 236       my @results;
 237
 238       $wrappers->{$wrapper}->( sub {
 239         while (my $money = $rs_cp->next) {
 240           my $artist = $a_rs_cp->next;
 241           push @results, [ $artist->name, $money->amount ];
 242         };
 243       });
 244
 245       is_deeply \@results, $map;
 246     } "transactions with multiple active statement with $wrapper wrapper";
 247   }
 248
 249   # test RNO detection when version detection fails
 250   SKIP: {
 251     my $storage = $schema->storage;
 252     my $version = $storage->_server_info->{normalized_dbms_version};
 253
 254     skip 'could not detect SQL Server version', 1 if not defined $version;
 255
 256     my $have_rno = $version >= 9 ? 1 : 0;
 257
 258     local $storage->{_dbh_details}{info} = {}; # delete cache
 259
 260     my $rno_detected =
 261       ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0;
 262
 263     ok (($have_rno == $rno_detected),
 264       'row_number() over support detected correctly');
 265   }
 266
 267   {
 268     my $schema = DBICTest::Schema->clone;
 269     $schema->connection($dsn, $user, $pass);
 270
 271     like $schema->storage->sql_maker->{limit_dialect},
 272       qr/^(?:Top|RowNumberOver)\z/,
 273       'sql_maker is correct on unconnected schema';
 274   }
 275 }
 276
 277 # test op-induced autoconnect
 278 lives_ok (sub {
 279
 280   my $schema =  DBICTest::Schema->clone;
 281   $schema->connection($dsn, $user, $pass);
 282
 283   my $artist = $schema->resultset ('Artist')->search ({}, { order_by => 'artistid' })->next;
 284   is ($artist->id, 1, 'Artist retrieved successfully');
 285 }, 'Query-induced autoconnect works');
 286
 287 # test AutoCommit=0
 288 {
 289   local $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK} = 1;
 290   my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 0 });
 291
 292   my $rs = $schema2->resultset('Money');
 293
 294   $rs->delete;
 295   $schema2->txn_commit;
 296
 297   is $rs->count, 0, 'initially empty'
 298     || diag ('Found row with amount ' . $_->amount) for $rs->all;
 299
 300   $rs->create({ amount => 3000 });
 301   $schema2->txn_rollback;
 302
 303   is $rs->count, 0, 'rolled back in AutoCommit=0'
 304     || diag ('Found row with amount ' . $_->amount) for $rs->all;
 305
 306   $rs->create({ amount => 4000 });
 307   $schema2->txn_commit;
 308
 309   cmp_ok $rs->first->amount, '==', 4000, 'committed in AutoCommit=0';
 310 }
 311
 312 done_testing;
 313
 314 # clean up our mess
 315 END {
 316   if (my $dbh = eval { $schema->storage->dbh }) {
 317     $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist");
 318     $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd");
 319     $dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test");
 320   }
 321
 322   undef $schema;
 323 }