t/746mssql.t

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