t/74mssql.t

   1 use strict;
   2 use warnings;
   3
   4 # use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
   5 BEGIN {
   6   if (my $lib_dirs = $ENV{DBICTEST_MSSQL_PERL5LIB}) {
   7     unshift @INC, $_ for split /:/, $lib_dirs;
   8   }
   9 }
  10
  11 use Test::More;
  12 use Test::Exception;
  13 use lib qw(t/lib);
  14 use DBICTest;
  15
  16 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
  17
  18 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
  19   unless ($dsn);
  20
  21 {
  22   my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version};
  23   ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') );
  24 }
  25
  26 my $schema;
  27
  28 my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass)
  29                                                     ->storage
  30                                                      ->_supports_typeless_placeholders;
  31 my @test_storages = (
  32   $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (),
  33   'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
  34 );
  35
  36 for my $storage_type (@test_storages) {
  37   $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  38
  39   if ($storage_type =~ /NoBindVars\z/) {
  40     # since we want to use the nobindvar - disable the capability so the
  41     # rebless happens to the correct class
  42     $schema->storage->_use_typeless_placeholders (0);
  43   }
  44
  45   $schema->storage->ensure_connected;
  46
  47   if ($storage_type =~ /NoBindVars\z/) {
  48     is $schema->storage->disable_sth_caching, 1,
  49       'prepare_cached disabled for NoBindVars';
  50   }
  51
  52   isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
  53
  54   SKIP: {
  55     skip 'This version of DBD::Sybase segfaults on disconnect', 1 if DBD::Sybase->VERSION < 1.08;
  56
  57     # start disconnected to test _ping
  58     $schema->storage->_dbh->disconnect;
  59
  60     lives_ok {
  61       $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
  62     } '_ping works';
  63   }
  64
  65   my $dbh = $schema->storage->dbh;
  66
  67   $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
  68       DROP TABLE artist");
  69   $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
  70       DROP TABLE cd");
  71
  72   $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);");
  73   $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);");
  74 # Just to test compat shim, Auto is in Core
  75   $schema->class('Artist')->load_components('PK::Auto::MSSQL');
  76
  77 # Test PK
  78   my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
  79   ok($new->artistid, "Auto-PK worked");
  80
  81 # Test LIMIT
  82   for (1..6) {
  83       $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
  84   }
  85
  86   my $it = $schema->resultset('Artist')->search( { },
  87       { rows     => 3,
  88         offset   => 2,
  89         order_by => 'artistid'
  90       }
  91   );
  92
  93 # Test ? in data don't get treated as placeholders
  94   my $cd = $schema->resultset('CD')->create( {
  95       artist      => 1,
  96       title       => 'Does this break things?',
  97       year        => 2007,
  98   } );
  99   ok($cd->id, 'Not treating ? in data as placeholders');
 100
 101   is( $it->count, 3, "LIMIT count ok" );
 102   ok( $it->next->name, "iterator->next ok" );
 103   $it->next;
 104   $it->next;
 105   is( $it->next, undef, "next past end of resultset ok" );
 106
 107 # test MONEY column support
 108   $schema->storage->dbh_do (sub {
 109       my ($storage, $dbh) = @_;
 110       eval { $dbh->do("DROP TABLE money_test") };
 111       $dbh->do(<<'SQL');
 112   CREATE TABLE money_test (
 113      id INT IDENTITY PRIMARY KEY,
 114      amount MONEY NULL
 115   )
 116 SQL
 117    });
 118
 119    my $rs = $schema->resultset('Money');
 120
 121   my $row;
 122   lives_ok {
 123     $row = $rs->create({ amount => 100 });
 124   } 'inserted a money value';
 125
 126   cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
 127
 128   lives_ok {
 129     $row->update({ amount => 200 });
 130   } 'updated a money value';
 131
 132   cmp_ok $rs->find($row->id)->amount, '==', 200,
 133     'updated money value round-trip';
 134
 135   lives_ok {
 136     $row->update({ amount => undef });
 137   } 'updated a money value to NULL';
 138
 139   is $rs->find($row->id)->amount,
 140     undef, 'updated money value to NULL round-trip';
 141
 142   $rs->delete;
 143
 144   # test simple transaction with commit
 145   lives_ok {
 146     $schema->txn_do(sub {
 147       $rs->create({ amount => 300 });
 148     });
 149   } 'simple transaction';
 150
 151   cmp_ok $rs->first->amount, '==', 300, 'committed';
 152
 153   $rs->reset;
 154   $rs->delete;
 155
 156   # test rollback
 157   throws_ok {
 158     $schema->txn_do(sub {
 159       $rs->create({ amount => 700 });
 160       die 'mtfnpy';
 161     });
 162   } qr/mtfnpy/, 'simple failed txn';
 163
 164   is $rs->first, undef, 'rolled back';
 165
 166   $rs->reset;
 167   $rs->delete;
 168
 169   # test multiple active statements
 170   {
 171     $rs->create({ amount => 800 + $_ }) for 1..3;
 172
 173     my @map = (
 174       [ 'Artist 1', '801.00' ],
 175       [ 'Artist 2', '802.00' ],
 176       [ 'Artist 3', '803.00' ]
 177     );
 178
 179     my $artist_rs = $schema->resultset('Artist')->search({
 180       name => { -like => 'Artist %' }
 181     });;
 182
 183     my $i = 0;
 184
 185     while (my $money_row = $rs->next) {
 186       my $artist_row = $artist_rs->next;
 187
 188       is_deeply [ $artist_row->name, $money_row->amount ], $map[$i++],
 189         'multiple active statements';
 190     }
 191     $rs->reset;
 192     $rs->delete;
 193   }
 194
 195
 196   # test RNO detection when version detection fails
 197   SKIP: {
 198     my $storage = $schema->storage;
 199     my $version = $storage->_server_info->{normalized_dbms_version};
 200
 201     skip 'could not detect SQL Server version', 1 if not defined $version;
 202
 203     my $have_rno = $version >= 9 ? 1 : 0;
 204
 205     local $storage->{_dbh_details}{info} = {}; # delete cache
 206
 207     my $rno_detected =
 208       ($storage->sql_limit_dialect eq 'RowNumberOver') ? 1 : 0;
 209
 210     ok (($have_rno == $rno_detected),
 211       'row_number() over support detected correctly');
 212   }
 213
 214   {
 215     my $schema = DBICTest::Schema->clone;
 216     $schema->connection($dsn, $user, $pass);
 217
 218     like $schema->storage->sql_maker->{limit_dialect},
 219       qr/^(?:Top|RowNumberOver)\z/,
 220       'sql_maker is correct on unconnected schema';
 221   }
 222 }
 223
 224 # test op-induced autoconnect
 225 lives_ok (sub {
 226
 227   my $schema =  DBICTest::Schema->clone;
 228   $schema->connection($dsn, $user, $pass);
 229
 230   my $artist = $schema->resultset ('Artist')->search ({}, { order_by => 'artistid' })->next;
 231   is ($artist->id, 1, 'Artist retrieved successfully');
 232 }, 'Query-induced autoconnect works');
 233
 234 done_testing;
 235
 236 # clean up our mess
 237 END {
 238   if (my $dbh = eval { $schema->storage->dbh }) {
 239     $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist");
 240     $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd");
 241     $dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test");
 242   }
 243 }