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         {
 282           my $book_owner_ids = $schema->resultset ('BooksInLibrary')->search ({}, {
 283             rows => 6,
 284             offset => 2,
 285             join => 'owner',
 286             distinct => 1,
 287             order_by => 'owner.name',
 288             unsafe_subselect_ok => 1
 289           })->get_column ('owner');
 290
 291           my @ids = $book_owner_ids->all;
 292
 293           is (@ids, 6, 'Limit works');
 294
 295           my $book_owners = $schema->resultset ('Owners')->search ({
 296             id => { -in => $book_owner_ids->as_query }
 297           });
 298
 299           TODO: {
 300             local $TODO = "Correlated limited IN subqueries will probably never preserve order";
 301
 302             is_deeply (
 303               [ map { $_->id } ($book_owners->all) ],
 304               [ $book_owner_ids->all ],
 305               "$test_type: Sort is preserved across IN subqueries",
 306             );
 307           }
 308         }
 309
 310         # still even with lost order of IN, we should be getting correct
 311         # sets
 312         {
 313           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
 314           my $corelated_owners = $owners->result_source->resultset->search (
 315             {
 316               id => { -in => $owners->get_column('id')->as_query },
 317             },
 318             {
 319               order_by => 'name' #reorder because of what is shown above
 320             },
 321           );
 322
 323           is (
 324             join ("\x00", map { $_->name } ($corelated_owners->all) ),
 325             join ("\x00", map { $_->name } ($owners->all) ),
 326             "$test_type: With an outer order_by, everything still matches",
 327           );
 328         }
 329
 330         # make sure right-join-side single-prefetch ordering limit works
 331         {
 332           my $rs = $schema->resultset ('BooksInLibrary')->search (
 333             {
 334               'owner.name' => { '!=', 'woggle' },
 335             },
 336             {
 337               prefetch => 'owner',
 338               order_by => 'owner.name',
 339             }
 340           );
 341           # this is the order in which they should come from the above query
 342           my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
 343
 344           is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset");
 345           is_deeply (
 346             [map { $_->owner->name } ($rs->all) ],
 347             \@owner_names,
 348             "$test_type: Prefetched rows were properly ordered"
 349           );
 350
 351           my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1});
 352           is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset");
 353           is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset");
 354
 355           my $queries;
 356           my $orig_debug = $schema->storage->debug;
 357           $schema->storage->debugcb(sub { $queries++; });
 358           $schema->storage->debug(1);
 359
 360           is_deeply (
 361             [map { $_->owner->name } ($limited_rs->all) ],
 362             [@owner_names[2 .. 7]],
 363             "$test_type: Prefetch-limited rows were properly ordered"
 364           );
 365           is ($queries, 1, "$test_type: Only one query with prefetch");
 366
 367           $schema->storage->debugcb(undef);
 368           $schema->storage->debug($orig_debug);
 369
 370           is_deeply (
 371             [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
 372             [@owner_names[2 .. 7]],
 373             "$test_type: Rows are still properly ordered after search_related",
 374           );
 375         }
 376
 377         # try a ->has_many direction with duplicates
 378         my $owners = $schema->resultset ('Owners')->search (
 379           {
 380             'books.id' => { '!=', undef },
 381             'me.name' => { '!=', 'somebogusstring' },
 382           },
 383           {
 384             prefetch => 'books',
 385             order_by => [ { -asc => \['name + ?', [ test => 'xxx' ]] }, 'me.id' ], # test bindvar propagation
 386             group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by
 387             rows     => 3,  # 8 results total
 388             unsafe_subselect_ok => 1,
 389           },
 390         );
 391
 392         my ($sql, @bind) = @${$owners->page(3)->as_query};
 393         is_same_bind (
 394           \@bind,
 395           [
 396             ($dialect eq 'Top' ? [ { dbic_colname => 'test' } => 'xxx' ] : ()), # the extra re-order bind
 397             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 398               => 'somebogusstring' ],
 399             [ { dbic_colname => 'test' }
 400               => 'xxx' ],
 401             ($dialect ne 'Top' ? ( [ $OFFSET => 7 ], [ $TOTAL => 9 ] ) : ()), # parameterised RNO
 402             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 403               => 'somebogusstring' ],
 404             [ { dbic_colname => 'test' }
 405               => 'xxx' ],
 406           ],
 407         );
 408
 409         is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
 410         is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
 411
 412         is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
 413         TODO: {
 414           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 415             if $dialect eq 'Top';
 416           is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
 417           is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
 418         }
 419
 420
 421         # try a ->belongs_to direction (no select collapse, group_by should work)
 422         my $books = $schema->resultset ('BooksInLibrary')->search (
 423           {
 424             'owner.name' => [qw/wiggle woggle/],
 425           },
 426           {
 427             distinct => 1,
 428             having => \['1 = ?', [ test => 1 ] ], #test having propagation
 429             prefetch => 'owner',
 430             rows     => 2,  # 3 results total
 431             order_by => [{ -desc => 'me.owner' }, 'me.id'],
 432             unsafe_subselect_ok => 1,
 433           },
 434         );
 435
 436         ($sql, @bind) = @${$books->page(3)->as_query};
 437         is_same_bind (
 438           \@bind,
 439           [
 440             # inner
 441             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 442               => 'wiggle' ],
 443             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 444               => 'woggle' ],
 445             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 446               => 'Library' ],
 447             [ { dbic_colname => 'test' }
 448               => '1' ],
 449
 450             # rno(?)
 451             $dialect ne 'Top' ? ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] ) : (),
 452             # outer
 453             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 454               => 'wiggle' ],
 455             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 456               => 'woggle' ],
 457             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 458               => 'Library' ],
 459           ],
 460         );
 461
 462         is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
 463         is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
 464
 465         is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
 466         TODO: {
 467           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 468             if $dialect eq 'Top';
 469           is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
 470           is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
 471         }
 472       }
 473     }
 474
 475
 476 # test GUID columns
 477     {
 478       $schema->storage->dbh_do (sub {
 479         my ($storage, $dbh) = @_;
 480         eval { $dbh->do("DROP TABLE artist_guid") };
 481         $dbh->do(<<'SQL');
 482 CREATE TABLE artist_guid (
 483    artistid UNIQUEIDENTIFIER NOT NULL,
 484    name VARCHAR(100),
 485    rank INT NOT NULL DEFAULT '13',
 486    charfield CHAR(10) NULL,
 487    a_guid UNIQUEIDENTIFIER,
 488    primary key(artistid)
 489 )
 490 SQL
 491       });
 492
 493       # start disconnected to make sure insert works on an un-reblessed storage
 494       $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 495
 496       my $row;
 497       lives_ok {
 498         $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 499       } 'created a row with a GUID';
 500
 501       ok(
 502         eval { $row->artistid },
 503         'row has GUID PK col populated',
 504       );
 505       diag $@ if $@;
 506
 507       ok(
 508         eval { $row->a_guid },
 509         'row has a GUID col with auto_nextval populated',
 510       );
 511       diag $@ if $@;
 512
 513       my $row_from_db = $schema->resultset('ArtistGUID')
 514         ->search({ name => 'mtfnpy' })->first;
 515
 516       is $row_from_db->artistid, $row->artistid,
 517         'PK GUID round trip';
 518
 519       is $row_from_db->a_guid, $row->a_guid,
 520         'NON-PK GUID round trip';
 521     }
 522
 523 # test MONEY type
 524     {
 525       $schema->storage->dbh_do (sub {
 526         my ($storage, $dbh) = @_;
 527         eval { $dbh->do("DROP TABLE money_test") };
 528         $dbh->do(<<'SQL');
 529 CREATE TABLE money_test (
 530    id INT IDENTITY PRIMARY KEY,
 531    amount MONEY NULL
 532 )
 533 SQL
 534       });
 535
 536       TODO: {
 537         my $freetds_and_dynamic_cursors = 1
 538           if $opts_name eq 'use_dynamic_cursors' &&
 539             $schema->storage->using_freetds;
 540
 541         local $TODO =
 542 'these tests fail on freetds with dynamic cursors for some reason'
 543           if $freetds_and_dynamic_cursors;
 544         local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1
 545           if $freetds_and_dynamic_cursors;
 546
 547         my $rs = $schema->resultset('Money');
 548         my $row;
 549
 550         lives_ok {
 551           $row = $rs->create({ amount => 100 });
 552         } 'inserted a money value';
 553
 554         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100,
 555           'money value round-trip');
 556
 557         lives_ok {
 558           $row->update({ amount => 200 });
 559         } 'updated a money value';
 560
 561         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200,
 562           'updated money value round-trip');
 563
 564         lives_ok {
 565           $row->update({ amount => undef });
 566         } 'updated a money value to NULL';
 567
 568         is try { $rs->find($row->id)->amount }, undef,
 569           'updated money value to NULL round-trip';
 570       }
 571     }
 572   }
 573 }
 574
 575 done_testing;
 576
 577 # clean up our mess
 578 END {
 579   if (my $dbh = eval { $schema->storage->_dbh }) {
 580     eval { $dbh->do("DROP TABLE $_") }
 581       for qw/artist artist_guid money_test books owners/;
 582   }
 583 }
 584 # vim:sw=2 sts=2