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 $schema->storage->_dbh->disconnect;
  50
  51 lives_ok {
  52   $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
  53 } '_ping works';
  54
  55 my %opts = (
  56   use_mars =>
  57     { opts => { on_connect_call => 'use_mars' } },
  58   use_dynamic_cursors =>
  59     { opts => { on_connect_call => 'use_dynamic_cursors' },
  60       required => $schema->storage->_using_freetds ? 0 : 1,
  61     },
  62   use_server_cursors =>
  63     { opts => { on_connect_call => 'use_server_cursors' } },
  64   plain =>
  65     { opts => {}, required => 1 },
  66 );
  67
  68 for my $opts_name (keys %opts) {
  69   SKIP: {
  70     my $opts = $opts{$opts_name}{opts};
  71     $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
  72
  73     try {
  74       $schema->storage->ensure_connected
  75     }
  76     catch {
  77       if ($opts{$opts_name}{required}) {
  78         die "on_connect_call option '$opts_name' is not functional: $_";
  79       }
  80       else {
  81         skip
  82           "on_connect_call option '$opts_name' not functional in this configuration: $_",
  83           1
  84         ;
  85       }
  86     };
  87
  88     $schema->storage->dbh_do (sub {
  89         my ($storage, $dbh) = @_;
  90         eval { $dbh->do("DROP TABLE artist") };
  91         $dbh->do(<<'SQL');
  92 CREATE TABLE artist (
  93    artistid INT IDENTITY NOT NULL,
  94    name VARCHAR(100),
  95    rank INT NOT NULL DEFAULT '13',
  96    charfield CHAR(10) NULL,
  97    primary key(artistid)
  98 )
  99 SQL
 100     });
 101
 102 # test Auto-PK
 103     $schema->resultset('Artist')->search({ name => 'foo' })->delete;
 104
 105     my $new = $schema->resultset('Artist')->create({ name => 'foo' });
 106
 107     ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name");
 108
 109 # Test multiple active statements
 110     SKIP: {
 111       skip 'not a multiple active statements configuration', 1
 112         if $opts_name eq 'plain';
 113
 114       $schema->storage->ensure_connected;
 115
 116       lives_ok {
 117
 118         no warnings 'redefine';
 119         local *DBI::connect = sub { die "NO RECONNECTS!!!" };
 120
 121         my $artist_rs = $schema->resultset('Artist');
 122
 123         $artist_rs->delete;
 124
 125         $artist_rs->create({ name => "Artist$_" }) for (1..3);
 126
 127         my $forward  = $artist_rs->search({},
 128           { order_by => { -asc  => 'artistid' } });
 129         my $backward = $artist_rs->search({},
 130           { order_by => { -desc => 'artistid' } });
 131
 132         my @map = (
 133           [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/]
 134         );
 135         my @result;
 136
 137         while (my $forward_row = $forward->next) {
 138           my $backward_row = $backward->next;
 139           push @result, [$forward_row->name, $backward_row->name];
 140         }
 141
 142         is_deeply \@result, \@map, "multiple active statements in $opts_name";
 143
 144         $artist_rs->delete;
 145
 146         is($artist_rs->count, 0, '$dbh still viable');
 147       } "Multiple active statements survive $opts_name";
 148     }
 149
 150 # Test populate
 151
 152     {
 153       $schema->storage->dbh_do (sub {
 154         my ($storage, $dbh) = @_;
 155         eval { $dbh->do("DROP TABLE owners") };
 156         eval { $dbh->do("DROP TABLE books") };
 157         $dbh->do(<<'SQL');
 158 CREATE TABLE books (
 159    id INT IDENTITY (1, 1) NOT NULL,
 160    source VARCHAR(100),
 161    owner INT,
 162    title VARCHAR(10),
 163    price INT NULL
 164 )
 165
 166 CREATE TABLE owners (
 167    id INT IDENTITY (1, 1) NOT NULL,
 168    name VARCHAR(100),
 169 )
 170 SQL
 171       });
 172
 173       lives_ok ( sub {
 174         # start a new connection, make sure rebless works
 175         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 176         $schema->populate ('Owners', [
 177           [qw/id  name  /],
 178           [qw/1   wiggle/],
 179           [qw/2   woggle/],
 180           [qw/3   boggle/],
 181           [qw/4   fRIOUX/],
 182           [qw/5   fRUE/],
 183           [qw/6   fREW/],
 184           [qw/7   fROOH/],
 185           [qw/8   fISMBoC/],
 186           [qw/9   station/],
 187           [qw/10   mirror/],
 188           [qw/11   dimly/],
 189           [qw/12   face_to_face/],
 190           [qw/13   icarus/],
 191           [qw/14   dream/],
 192           [qw/15   dyrstyggyr/],
 193         ]);
 194       }, 'populate with PKs supplied ok' );
 195
 196
 197       lives_ok (sub {
 198         # start a new connection, make sure rebless works
 199         # test an insert with a supplied identity, followed by one without
 200         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 201         for (2, 1) {
 202           my $id = $_ * 20 ;
 203           $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
 204           $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
 205         }
 206       }, 'create with/without PKs ok' );
 207
 208       is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
 209
 210       lives_ok ( sub {
 211         # start a new connection, make sure rebless works
 212         my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 213         $schema->populate ('BooksInLibrary', [
 214           [qw/source  owner title   /],
 215           [qw/Library 1     secrets0/],
 216           [qw/Library 1     secrets1/],
 217           [qw/Eatery  1     secrets2/],
 218           [qw/Library 2     secrets3/],
 219           [qw/Library 3     secrets4/],
 220           [qw/Eatery  3     secrets5/],
 221           [qw/Library 4     secrets6/],
 222           [qw/Library 5     secrets7/],
 223           [qw/Eatery  5     secrets8/],
 224           [qw/Library 6     secrets9/],
 225           [qw/Library 7     secrets10/],
 226           [qw/Eatery  7     secrets11/],
 227           [qw/Library 8     secrets12/],
 228         ]);
 229       }, 'populate without PKs supplied ok' );
 230     }
 231
 232 # test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible)
 233     for my $dialect (
 234       'Top',
 235       ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9
 236         ? ('RowNumberOver')
 237         : ()
 238       ,
 239     ) {
 240       for my $quoted (0, 1) {
 241
 242         $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
 243             limit_dialect => $dialect,
 244             %$opts,
 245             $quoted
 246               ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' )
 247               : ()
 248             ,
 249           });
 250
 251         my $test_type = "Dialect:$dialect Quoted:$quoted";
 252
 253         # basic limit support
 254         {
 255           my $art_rs = $schema->resultset ('Artist');
 256           $art_rs->delete;
 257           $art_rs->create({ name => 'Artist ' . $_ }) for (1..6);
 258
 259           my $it = $schema->resultset('Artist')->search( {}, {
 260             rows => 4,
 261             offset => 3,
 262             order_by => 'artistid',
 263           });
 264
 265           is( $it->count, 3, "$test_type: LIMIT count ok" );
 266
 267           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 268             if $dialect eq 'Top';
 269
 270           is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" );
 271           $it->next;
 272           is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" );
 273           is( $it->next, undef, "$test_type: next past end of resultset ok" );
 274         }
 275
 276         # plain ordered subqueries throw
 277         throws_ok (sub {
 278           $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
 279         }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok");
 280
 281         # make sure ordered subselects *somewhat* work
 282         {
 283           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
 284           my $sealed_owners = $owners->as_subselect_rs;
 285
 286           is_deeply (
 287             [ map { $_->name } ($sealed_owners->all) ],
 288             [ map { $_->name } ($owners->all) ],
 289             "$test_type: Sort preserved from within a subquery",
 290           );
 291         }
 292
 293         # still even with lost order of IN, we should be getting correct
 294         # sets
 295         {
 296           my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
 297           my $corelated_owners = $owners->result_source->resultset->search (
 298             {
 299               id => { -in => $owners->get_column('id')->as_query },
 300             },
 301             {
 302               order_by => 'name' #reorder because of what is shown above
 303             },
 304           );
 305
 306           is (
 307             join ("\x00", map { $_->name } ($corelated_owners->all) ),
 308             join ("\x00", map { $_->name } ($owners->all) ),
 309             "$test_type: With an outer order_by, everything still matches",
 310           );
 311         }
 312
 313         # make sure right-join-side single-prefetch ordering limit works
 314         {
 315           my $rs = $schema->resultset ('BooksInLibrary')->search (
 316             {
 317               'owner.name' => { '!=', 'woggle' },
 318             },
 319             {
 320               prefetch => 'owner',
 321               order_by => 'owner.name',
 322             }
 323           );
 324           # this is the order in which they should come from the above query
 325           my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
 326
 327           is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset");
 328           is_deeply (
 329             [map { $_->owner->name } ($rs->all) ],
 330             \@owner_names,
 331             "$test_type: Prefetched rows were properly ordered"
 332           );
 333
 334           my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1});
 335           is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset");
 336           is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset");
 337
 338           my $queries;
 339           my $orig_debug = $schema->storage->debug;
 340           $schema->storage->debugcb(sub { $queries++; });
 341           $schema->storage->debug(1);
 342
 343           is_deeply (
 344             [map { $_->owner->name } ($limited_rs->all) ],
 345             [@owner_names[2 .. 7]],
 346             "$test_type: Prefetch-limited rows were properly ordered"
 347           );
 348           is ($queries, 1, "$test_type: Only one query with prefetch");
 349
 350           $schema->storage->debugcb(undef);
 351           $schema->storage->debug($orig_debug);
 352
 353           is_deeply (
 354             [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
 355             [@owner_names[2 .. 7]],
 356             "$test_type: Rows are still properly ordered after search_related",
 357           );
 358         }
 359
 360         # try a ->has_many direction with duplicates
 361         my $owners = $schema->resultset ('Owners')->search (
 362           {
 363             'books.id' => { '!=', undef },
 364             'me.name' => { '!=', 'somebogusstring' },
 365           },
 366           {
 367             prefetch => 'books',
 368             order_by => [ { -asc => \['name + ?', [ test => 'xxx' ]] }, 'me.id' ], # test bindvar propagation
 369             group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by
 370             rows     => 3,  # 8 results total
 371             unsafe_subselect_ok => 1,
 372           },
 373         );
 374
 375         is_same_sql_bind (
 376           $owners->page(3)->as_query,
 377           $dialect eq 'Top'
 378             ? '(
 379               SELECT TOP 2147483647 [me].[id], [me].[name],
 380                                     [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
 381                 FROM (
 382                   SELECT TOP 2147483647 [me].[id], [me].[name]
 383                     FROM (
 384                       SELECT TOP 3 [me].[id], [me].[name], [ORDER__BY__001]
 385                         FROM (
 386                           SELECT TOP 9 [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
 387                             FROM [owners] [me]
 388                             LEFT JOIN [books] [books]
 389                               ON [books].[owner] = [me].[id]
 390                           WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
 391                           GROUP BY [me].[id], [me].[name]
 392                           ORDER BY name + ? ASC, [me].[id]
 393                         ) [me]
 394                       ORDER BY [ORDER__BY__001] DESC, [me].[id] DESC
 395                     ) [me]
 396                   ORDER BY [ORDER__BY__001] ASC, [me].[id]
 397                 ) [me]
 398                 LEFT JOIN [books] [books]
 399                   ON [books].[owner] = [me].[id]
 400               WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
 401               ORDER BY name + ? ASC, [me].[id]
 402             )'
 403             : '(
 404               SELECT TOP 2147483647 [me].[id], [me].[name],
 405                                     [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
 406                 FROM (
 407                   SELECT TOP 2147483647 [me].[id], [me].[name]
 408                     FROM (
 409                       SELECT [me].[id], [me].[name],
 410                              ROW_NUMBER() OVER( ORDER BY [ORDER__BY__001] ASC, [me].[id] ) AS [rno__row__index]
 411                         FROM (
 412                           SELECT [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
 413                             FROM [owners] [me]
 414                             LEFT JOIN [books] [books]
 415                               ON [books].[owner] = [me].[id]
 416                           WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
 417                           GROUP BY [me].[id], [me].[name]
 418                         ) [me]
 419                     ) [me]
 420                   WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
 421                 ) [me]
 422                 LEFT JOIN [books] [books]
 423                   ON [books].[owner] = [me].[id]
 424               WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
 425               ORDER BY name + ? ASC, [me].[id]
 426             )'
 427           ,
 428           [
 429             [ { dbic_colname => 'test' }
 430               => 'xxx' ],
 431             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 432               => 'somebogusstring' ],
 433
 434             ($dialect eq 'Top'
 435               ? [ { dbic_colname => 'test' } => 'xxx' ]  # the extra re-order bind
 436               : ([ $OFFSET => 7 ], [ $TOTAL => 9 ]) # parameterised RNO
 437             ),
 438
 439             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
 440               => 'somebogusstring' ],
 441             [ { dbic_colname => 'test' }
 442               => 'xxx' ],
 443           ],
 444         ) if $quoted;
 445
 446         is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
 447         is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
 448
 449         is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
 450         {
 451           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 452             if $dialect eq 'Top';
 453           is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
 454           is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
 455         }
 456
 457
 458         # try a ->belongs_to direction (no select collapse, group_by should work)
 459         my $books = $schema->resultset ('BooksInLibrary')->search (
 460           {
 461             'owner.name' => [qw/wiggle woggle/],
 462           },
 463           {
 464             distinct => 1,
 465             having => \['1 = ?', [ test => 1 ] ], #test having propagation
 466             prefetch => 'owner',
 467             rows     => 2,  # 3 results total
 468             order_by => [{ -desc => 'me.owner' }, 'me.id'],
 469             unsafe_subselect_ok => 1,
 470           },
 471         );
 472
 473         is_same_sql_bind (
 474           $books->page(3)->as_query,
 475           $dialect eq 'Top'
 476             ? '(
 477               SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
 478                                     [owner].[id], [owner].[name]
 479                 FROM (
 480                   SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 481                     FROM (
 482                       SELECT TOP 2 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 483                         FROM (
 484                           SELECT TOP 6 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 485                             FROM [books] [me]
 486                             JOIN [owners] [owner]
 487                               ON [owner].[id] = [me].[owner]
 488                           WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
 489                           GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 490                           HAVING 1 = ?
 491                           ORDER BY [me].[owner] DESC, [me].[id]
 492                         ) [me]
 493                       ORDER BY [me].[owner] ASC, [me].[id] DESC
 494                     ) [me]
 495                   ORDER BY [me].[owner] DESC, [me].[id]
 496                 ) [me]
 497                 JOIN [owners] [owner]
 498                   ON [owner].[id] = [me].[owner]
 499               WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
 500               ORDER BY [me].[owner] DESC, [me].[id]
 501             )'
 502             : '(
 503               SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
 504                                     [owner].[id], [owner].[name]
 505                 FROM (
 506                   SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 507                     FROM (
 508                       SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
 509                              ROW_NUMBER() OVER( ORDER BY [me].[owner] DESC, [me].[id] ) AS [rno__row__index]
 510                         FROM (
 511                           SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 512                             FROM [books] [me]
 513                             JOIN [owners] [owner]
 514                               ON [owner].[id] = [me].[owner]
 515                           WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
 516                           GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
 517                           HAVING 1 = ?
 518                         ) [me]
 519                     ) [me]
 520                   WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
 521                 ) [me]
 522                 JOIN [owners] [owner]
 523                   ON [owner].[id] = [me].[owner]
 524               WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
 525               ORDER BY [me].[owner] DESC, [me].[id]
 526             )'
 527           ,
 528           [
 529             # inner
 530             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 531               => 'wiggle' ],
 532             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 533               => 'woggle' ],
 534             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 535               => 'Library' ],
 536             [ { dbic_colname => 'test' }
 537               => '1' ],
 538
 539             # top(?)
 540             $dialect eq 'Top'
 541               ? ()
 542               : ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] )
 543             ,
 544
 545             # outer
 546             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 547               => 'wiggle' ],
 548             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
 549               => 'woggle' ],
 550             [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
 551               => 'Library' ],
 552           ],
 553         ) if $quoted;
 554
 555         is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
 556         is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
 557
 558         is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
 559         {
 560           local $TODO = "Top-limit does not work when your limit ends up past the resultset"
 561             if $dialect eq 'Top';
 562           is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
 563           is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
 564         }
 565       }
 566     }
 567
 568
 569 # test GUID columns
 570     {
 571       $schema->storage->dbh_do (sub {
 572         my ($storage, $dbh) = @_;
 573         eval { $dbh->do("DROP TABLE artist_guid") };
 574         $dbh->do(<<'SQL');
 575 CREATE TABLE artist_guid (
 576    artistid UNIQUEIDENTIFIER NOT NULL,
 577    name VARCHAR(100),
 578    rank INT NOT NULL DEFAULT '13',
 579    charfield CHAR(10) NULL,
 580    a_guid UNIQUEIDENTIFIER,
 581    primary key(artistid)
 582 )
 583 SQL
 584       });
 585
 586       # start disconnected to make sure insert works on an un-reblessed storage
 587       $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
 588
 589       my $row;
 590       lives_ok {
 591         $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 592       } 'created a row with a GUID';
 593
 594       ok(
 595         eval { $row->artistid },
 596         'row has GUID PK col populated',
 597       );
 598       diag $@ if $@;
 599
 600       ok(
 601         eval { $row->a_guid },
 602         'row has a GUID col with auto_nextval populated',
 603       );
 604       diag $@ if $@;
 605
 606       my $row_from_db = $schema->resultset('ArtistGUID')
 607         ->search({ name => 'mtfnpy' })->first;
 608
 609       is $row_from_db->artistid, $row->artistid,
 610         'PK GUID round trip';
 611
 612       is $row_from_db->a_guid, $row->a_guid,
 613         'NON-PK GUID round trip';
 614     }
 615
 616 # test MONEY type
 617     {
 618       $schema->storage->dbh_do (sub {
 619         my ($storage, $dbh) = @_;
 620         eval { $dbh->do("DROP TABLE money_test") };
 621         $dbh->do(<<'SQL');
 622 CREATE TABLE money_test (
 623    id INT IDENTITY PRIMARY KEY,
 624    amount MONEY NULL
 625 )
 626 SQL
 627       });
 628
 629       {
 630         my $freetds_and_dynamic_cursors = 1
 631           if $opts_name eq 'use_dynamic_cursors' &&
 632             $schema->storage->_using_freetds;
 633
 634         local $TODO =
 635 'these tests fail on freetds with dynamic cursors for some reason'
 636           if $freetds_and_dynamic_cursors;
 637         local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1
 638           if $freetds_and_dynamic_cursors;
 639
 640         my $rs = $schema->resultset('Money');
 641         my $row;
 642
 643         lives_ok {
 644           $row = $rs->create({ amount => 100 });
 645         } 'inserted a money value';
 646
 647         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100,
 648           'money value round-trip');
 649
 650         lives_ok {
 651           $row->update({ amount => 200 });
 652         } 'updated a money value';
 653
 654         cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200,
 655           'updated money value round-trip');
 656
 657         lives_ok {
 658           $row->update({ amount => undef });
 659         } 'updated a money value to NULL';
 660
 661         is try { $rs->find($row->id)->amount }, undef,
 662           'updated money value to NULL round-trip';
 663       }
 664     }
 665   }
 666 }
 667
 668 done_testing;
 669
 670 # clean up our mess
 671 END {
 672   if (my $dbh = eval { $schema->storage->_dbh }) {
 673     eval { $dbh->do("DROP TABLE $_") }
 674       for qw/artist artist_guid money_test books owners/;
 675   }
 676   undef $schema;
 677 }
 678 # vim:sw=2 sts=2