t/746mssql.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use Try::Tiny;
   7 use DBIx::Class::SQLMaker::LimitDialects;
   8 use DBIx::Class::Optional::Dependencies ();
   9 use lib qw(t/lib);
  10 use DBICTest;
  11 use DBIC::SqlMakerTest;
  12
  13 plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_odbc')
  14   unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_odbc');
  15
  16 my $OFFSET = DBIx::Class::SQLMaker::LimitDialects->__offset_bindtype;
  17 my $TOTAL  = DBIx::Class::SQLMaker::LimitDialects->__total_bindtype;
  18
  19 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
  20
  21 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
  22   unless ($dsn && $user);
  23
  24 {
  25   my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version};
  26   ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') );
  27 }
  28
  29 DBICTest::Schema->load_classes('ArtistGUID');
  30 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  31
  32 {
  33   no warnings 'redefine';
  34   my $connect_count = 0;
  35   my $orig_connect = \&DBI::connect;
  36   local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
  37
  38   $schema->storage->ensure_connected;
  39
  40   is( $connect_count, 1, 'only one connection made');
  41 }
  42
  43 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
  44
  45 {
  46   my $schema2 = $schema->connect ($schema->storage->connect_info);
  47   ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
  48 }
  49
  50 $schema->storage->_dbh->disconnect;
  51
  52 lives_ok {
  53   $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
  54 } '_ping works';
  55
  56 my %opts = (
  57   use_mars =>
  58     { opts => { on_connect_call => 'use_mars' } },
  59   use_dynamic_cursors =>
  60     { opts => { on_connect_call => 'use_dynamic_cursors' }, required => 1 },
  61   use_server_cursors =>
  62     { opts => { on_connect_call => 'use_server_cursors' } },
  63   NO_OPTION =>
  64     { opts => {}, required => 1 },
  65 );
  66
  67 for my $opts_name (keys %opts) {
  68   SKIP: {
  69     my $opts = $opts{$opts_name}{opts};
  70     $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
  71
  72     try {
  73       $schema->storage->ensure_connected
  74     }
  75     catch {
  76       if ($opts{$opts_name}{required}) {
  77         BAIL_OUT "on_connect_call option '$opts_name' is not functional: $_";
  78       }
  79       else {
  80         skip
  81 "on_connect_call option '$opts_name' not functional in this configuration: $_",
  82 1;
  83       }
  84     };
  85
  86     $schema->storage->dbh_do (sub {
  87         my ($storage, $dbh) = @_;
  88         eval { $dbh->do("DROP TABLE artist") };
  89         $dbh->do(<<'SQL');
  90 CREATE TABLE artist (
  91    artistid INT IDENTITY NOT NULL,
  92    name VARCHAR(100),
  93    rank INT NOT NULL DEFAULT '13',
  94    charfield CHAR(10) NULL,
  95    primary key(artistid)
  96 )
  97 SQL
  98     });
  99
 100 # test Auto-PK
 101     $schema->resultset('Artist')->search({ name => 'foo' })->delete;
 102
 103     my $new = $schema->resultset('Artist')->create({ name => 'foo' });
 104
 105     ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name");
 106
 107 # Test multiple active statements
 108     SKIP: {
 109       skip 'not a multiple active statements configuration', 1
 110         if $opts_name eq 'plain';
 111
 112       my $artist_rs = $schema->resultset('Artist');
 113
 114       $artist_rs->delete;
 115
 116       $artist_rs->create({ name => "Artist$_" }) for (1..3);
 117
 118       my $forward  = $artist_rs->search({},
 119         { order_by => { -asc  => 'artistid' } });
 120       my $backward = $artist_rs->search({},
 121         { order_by => { -desc => 'artistid' } });
 122
 123       my @map = (
 124         [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/]
 125       );
 126       my @result;
 127
 128       while (my $forward_row = $forward->next) {
 129         my $backward_row = $backward->next;
 130         push @result, [$forward_row->name, $backward_row->name];
 131       }
 132
 133       is_deeply \@result, \@map, "multiple active statements in $opts_name";
 134
 135       $artist_rs->delete;
 136     }
 137
 138 # Test populate
 139
 140     {
 141       $schema->storage->dbh_do (sub {
 142         my ($storage, $dbh) = @_;
 143         eval { $dbh->do("DROP TABLE owners") };
 144         eval { $dbh->do("DROP TABLE books") };
 145         $dbh->do(<<'SQL');
 146 CREATE TABLE books (
 147    id INT IDENTITY (1, 1) NOT NULL,
 148    source VARCHAR(100),
 149    owner INT,
 150    title VARCHAR(10),
 151    price INT NULL
 152 )
 153
 154 CREATE TABLE owners (
 155    id INT IDENTITY (1, 1) NOT NULL,
 156    name VARCHAR(100),
 157 )
 158 SQL
 159       });
 160
 161       lives_ok ( sub {
 162         # start a new connection, make sure rebless works
 163         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 164         $schema->populate ('Owners', [
 165           [qw/id  name  /],
 166           [qw/1   wiggle/],
 167           [qw/2   woggle/],
 168           [qw/3   boggle/],
 169           [qw/4   fRIOUX/],
 170           [qw/5   fRUE/],
 171           [qw/6   fREW/],
 172           [qw/7   fROOH/],
 173           [qw/8   fISMBoC/],
 174           [qw/9   station/],
 175           [qw/10   mirror/],
 176           [qw/11   dimly/],
 177           [qw/12   face_to_face/],
 178           [qw/13   icarus/],
 179           [qw/14   dream/],
 180           [qw/15   dyrstyggyr/],
 181         ]);
 182       }, 'populate with PKs supplied ok' );
 183
 184
 185       lives_ok (sub {
 186         # start a new connection, make sure rebless works
 187         # test an insert with a supplied identity, followed by one without
 188         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 189         for (2, 1) {
 190           my $id = $_ * 20 ;
 191           $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
 192           $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
 193         }
 194       }, 'create with/without PKs ok' );
 195
 196       is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
 197
 198       lives_ok ( sub {
 199         # start a new connection, make sure rebless works
 200         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 201         $schema->populate ('BooksInLibrary', [
 202           [qw/source  owner title   /],
 203           [qw/Library 1     secrets0/],
 204           [qw/Library 1     secrets1/],
 205           [qw/Eatery  1     secrets2/],
 206           [qw/Library 2     secrets3/],
 207           [qw/Library 3     secrets4/],
 208           [qw/Eatery  3     secrets5/],
 209           [qw/Library 4     secrets6/],
 210           [qw/Library 5     secrets7/],
 211           [qw/Eatery  5     secrets8/],
 212           [qw/Library 6     secrets9/],
 213           [qw/Library 7     secrets10/],
 214           [qw/Eatery  7     secrets11/],
 215           [qw/Library 8     secrets12/],
 216         ]);
 217       }, 'populate without PKs supplied ok' );
 218     }
 219
 220 # test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible)
 221     for my $dialect (
 222       'Top',
 223       ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9
 224         ? ('RowNumberOver')
 225         : ()
 226       ,
 227     ) {
 228       for my $quoted (0, 1) {
 229
 230         $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
 231             limit_dialect => $dialect,
 232             %$opts,
 233             $quoted
 234               ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' )
 235               : ()
 236             ,
 237           });
 238
 239         my $test_type = "Dialect:$dialect Quoted:$quoted";
 240
 241         # basic limit support
 242         TODO: {
 243           my $art_rs = $schema->resultset ('Artist');
 244           $art_rs->delete;
 245           $art_rs->create({ name => 'Artist ' . $_ }) for (1..6);
 246
 247           my $it = $schema->resultset('Artist')->search( {}, {
 248             rows => 4,
 249             offset => 3,
 250             order_by => 'artistid',
 251           });
 252
 253           is( $it->count, 3, "$test_type: LIMIT count ok" );
 254
 255           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 256             if $dialect eq 'Top';
 257
 258           is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" );
 259           $it->next;
 260           is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" );
 261           is( $it->next, undef, "$test_type: next past end of resultset ok" );
 262         }
 263
 264         # plain ordered subqueries throw
 265         throws_ok (sub {
 266           $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
 267         }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok");
 268
 269         # make sure ordered subselects *somewhat* work
 270         {
 271           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
 272           my $sealed_owners = $owners->as_subselect_rs;
 273
 274           is_deeply (
 275             [ map { $_->name } ($sealed_owners->all) ],
 276             [ map { $_->name } ($owners->all) ],
 277             "$test_type: Sort preserved from within a subquery",
 278           );
 279         }
 280
 281         # still even with lost order of IN, we should be getting correct
 282         # sets
 283         {
 284           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
 285           my $corelated_owners = $owners->result_source->resultset->search (
 286             {
 287               id => { -in => $owners->get_column('id')->as_query },
 288             },
 289             {
 290               order_by => 'name' #reorder because of what is shown above
 291             },
 292           );
 293
 294           is (
 295             join ("\x00", map { $_->name } ($corelated_owners->all) ),
 296             join ("\x00", map { $_->name } ($owners->all) ),
 297             "$test_type: With an outer order_by, everything still matches",
 298           );
 299         }
 300
 301         # make sure right-join-side single-prefetch ordering limit works
 302         {
 303           my $rs = $schema->resultset ('BooksInLibrary')->search (
 304             {
 305               'owner.name' => { '!=', 'woggle' },
 306             },
 307             {
 308               prefetch => 'owner',
 309               order_by => 'owner.name',
 310             }
 311           );
 312           # this is the order in which they should come from the above query
 313           my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
 314
 315           is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset");
 316           is_deeply (
 317             [map { $_->owner->name } ($rs->all) ],
 318             \@owner_names,
 319             "$test_type: Prefetched rows were properly ordered"
 320           );
 321
 322           my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1});
 323           is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset");
 324           is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset");
 325
 326           my $queries;
 327           my $orig_debug = $schema->storage->debug;
 328           $schema->storage->debugcb(sub { $queries++; });
 329           $schema->storage->debug(1);
 330
 331           is_deeply (
 332             [map { $_->owner->name } ($limited_rs->all) ],
 333             [@owner_names[2 .. 7]],
 334             "$test_type: Prefetch-limited rows were properly ordered"
 335           );
 336           is ($queries, 1, "$test_type: Only one query with prefetch");
 337
 338           $schema->storage->debugcb(undef);
 339           $schema->storage->debug($orig_debug);
 340
 341           is_deeply (
 342             [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
 343             [@owner_names[2 .. 7]],
 344             "$test_type: Rows are still properly ordered after search_related",
 345           );
 346         }
 347
 348         # try a ->has_many direction with duplicates
 349         my $owners = $schema->resultset ('Owners')->search (
 350           {
 351             'books.id' => { '!=', undef },
 352             'me.name' => { '!=', 'somebogusstring' },
 353           },
 354           {
 355             prefetch => 'books',
 356             order_by => [ { -asc => \['name + ?', [ test => 'xxx' ]] }, 'me.id' ], # test bindvar propagation
 357             group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by
 358             rows     => 3,  # 8 results total
 359             unsafe_subselect_ok => 1,
 360           },
 361         );
 362
 363         my ($sql, @bind) = @${$owners->page(3)->as_query};
 364         is_same_bind (
 365           \@bind,
 366           [
 367             ($dialect eq 'Top' ? [ { dbic_colname => 'test' } => 'xxx' ] : ()), # the extra re-order bind
 368             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 369               => 'somebogusstring' ],
 370             [ { dbic_colname => 'test' }
 371               => 'xxx' ],
 372             ($dialect ne 'Top' ? ( [ $OFFSET => 7 ], [ $TOTAL => 9 ] ) : ()), # parameterised RNO
 373             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 374               => 'somebogusstring' ],
 375             [ { dbic_colname => 'test' }
 376               => 'xxx' ],
 377           ],
 378         );
 379
 380         is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
 381         is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
 382
 383         is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
 384         TODO: {
 385           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 386             if $dialect eq 'Top';
 387           is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
 388           is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
 389         }
 390
 391
 392         # try a ->belongs_to direction (no select collapse, group_by should work)
 393         my $books = $schema->resultset ('BooksInLibrary')->search (
 394           {
 395             'owner.name' => [qw/wiggle woggle/],
 396           },
 397           {
 398             distinct => 1,
 399             having => \['1 = ?', [ test => 1 ] ], #test having propagation
 400             prefetch => 'owner',
 401             rows     => 2,  # 3 results total
 402             order_by => [{ -desc => 'me.owner' }, 'me.id'],
 403             unsafe_subselect_ok => 1,
 404           },
 405         );
 406
 407         ($sql, @bind) = @${$books->page(3)->as_query};
 408         is_same_bind (
 409           \@bind,
 410           [
 411             # inner
 412             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 413               => 'wiggle' ],
 414             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 415               => 'woggle' ],
 416             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 417               => 'Library' ],
 418             [ { dbic_colname => 'test' }
 419               => '1' ],
 420
 421             # rno(?)
 422             $dialect ne 'Top' ? ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] ) : (),
 423             # outer
 424             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 425               => 'wiggle' ],
 426             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 427               => 'woggle' ],
 428             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 429               => 'Library' ],
 430           ],
 431         );
 432
 433         is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
 434         is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
 435
 436         is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
 437         TODO: {
 438           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 439             if $dialect eq 'Top';
 440           is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
 441           is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
 442         }
 443       }
 444     }
 445
 446
 447 # test GUID columns
 448     {
 449       $schema->storage->dbh_do (sub {
 450         my ($storage, $dbh) = @_;
 451         eval { $dbh->do("DROP TABLE artist_guid") };
 452         $dbh->do(<<'SQL');
 453 CREATE TABLE artist_guid (
 454    artistid UNIQUEIDENTIFIER NOT NULL,
 455    name VARCHAR(100),
 456    rank INT NOT NULL DEFAULT '13',
 457    charfield CHAR(10) NULL,
 458    a_guid UNIQUEIDENTIFIER,
 459    primary key(artistid)
 460 )
 461 SQL
 462       });
 463
 464       # start disconnected to make sure insert works on an un-reblessed storage
 465       $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 466
 467       my $row;
 468       lives_ok {
 469         $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 470       } 'created a row with a GUID';
 471
 472       ok(
 473         eval { $row->artistid },
 474         'row has GUID PK col populated',
 475       );
 476       diag $@ if $@;
 477
 478       ok(
 479         eval { $row->a_guid },
 480         'row has a GUID col with auto_nextval populated',
 481       );
 482       diag $@ if $@;
 483
 484       my $row_from_db = $schema->resultset('ArtistGUID')
 485         ->search({ name => 'mtfnpy' })->first;
 486
 487       is $row_from_db->artistid, $row->artistid,
 488         'PK GUID round trip';
 489
 490       is $row_from_db->a_guid, $row->a_guid,
 491         'NON-PK GUID round trip';
 492     }
 493
 494 # test MONEY type
 495     {
 496       $schema->storage->dbh_do (sub {
 497         my ($storage, $dbh) = @_;
 498         eval { $dbh->do("DROP TABLE money_test") };
 499         $dbh->do(<<'SQL');
 500 CREATE TABLE money_test (
 501    id INT IDENTITY PRIMARY KEY,
 502    amount MONEY NULL
 503 )
 504 SQL
 505       });
 506
 507       TODO: {
 508         my $freetds_and_dynamic_cursors = 1
 509           if $opts_name eq 'use_dynamic_cursors' &&
 510             $schema->storage->using_freetds;
 511
 512         local $TODO =
 513 'these tests fail on freetds with dynamic cursors for some reason'
 514           if $freetds_and_dynamic_cursors;
 515         local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1
 516           if $freetds_and_dynamic_cursors;
 517
 518         my $rs = $schema->resultset('Money');
 519         my $row;
 520
 521         lives_ok {
 522           $row = $rs->create({ amount => 100 });
 523         } 'inserted a money value';
 524
 525         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100,
 526           'money value round-trip');
 527
 528         lives_ok {
 529           $row->update({ amount => 200 });
 530         } 'updated a money value';
 531
 532         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200,
 533           'updated money value round-trip');
 534
 535         lives_ok {
 536           $row->update({ amount => undef });
 537         } 'updated a money value to NULL';
 538
 539         is try { $rs->find($row->id)->amount }, undef,
 540           'updated money value to NULL round-trip';
 541       }
 542     }
 543   }
 544 }
 545
 546 done_testing;
 547
 548 # clean up our mess
 549 END {
 550   if (my $dbh = eval { $schema->storage->_dbh }) {
 551     eval { $dbh->do("DROP TABLE $_") }
 552       for qw/artist artist_guid money_test books owners/;
 553   }
 554   undef $schema;
 555 }
 556 # vim:sw=2 sts=2