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
  10 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
  11
  12 plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
  13   unless ($dsn && $user);
  14
  15 DBICTest::Schema->load_classes('ArtistGUID');
  16 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  17
  18 {
  19   no warnings 'redefine';
  20   my $connect_count = 0;
  21   my $orig_connect = \&DBI::connect;
  22   local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
  23
  24   $schema->storage->ensure_connected;
  25
  26   is( $connect_count, 1, 'only one connection made');
  27 }
  28
  29 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
  30
  31 {
  32   my $schema2 = $schema->connect ($schema->storage->connect_info);
  33   ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
  34 }
  35
  36 $schema->storage->_dbh->disconnect;
  37
  38 lives_ok {
  39   $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
  40 } '_ping works';
  41
  42 $schema->storage->dbh_do (sub {
  43     my ($storage, $dbh) = @_;
  44     eval { $dbh->do("DROP TABLE artist") };
  45     $dbh->do(<<'SQL');
  46 CREATE TABLE artist (
  47    artistid INT IDENTITY NOT NULL,
  48    name VARCHAR(100),
  49    rank INT NOT NULL DEFAULT '13',
  50    charfield CHAR(10) NULL,
  51    primary key(artistid)
  52 )
  53 SQL
  54 });
  55
  56 my %seen_id;
  57
  58 my @opts = (
  59   { on_connect_call => 'use_dynamic_cursors' },
  60   {},
  61 );
  62 my $new;
  63
  64 # test Auto-PK with different options
  65 for my $opts (@opts) {
  66   SKIP: {
  67     $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
  68
  69     eval {
  70       $schema->storage->ensure_connected
  71     };
  72     if ($@ =~ /dynamic cursors/) {
  73       skip
  74 'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
  75 ' FreeTDS', 1;
  76     }
  77
  78     $schema->resultset('Artist')->search({ name => 'foo' })->delete;
  79
  80     $new = $schema->resultset('Artist')->create({ name => 'foo' });
  81
  82     ok($new->artistid > 0, "Auto-PK worked");
  83   }
  84 }
  85
  86 $seen_id{$new->artistid}++;
  87
  88 # test LIMIT support
  89 for (1..6) {
  90     $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
  91     is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
  92     $seen_id{$new->artistid}++;
  93 }
  94
  95 my $it = $schema->resultset('Artist')->search( {}, {
  96     rows => 3,
  97     order_by => 'artistid',
  98 });
  99
 100 is( $it->count, 3, "LIMIT count ok" );
 101 is( $it->next->name, "foo", "iterator->next ok" );
 102 $it->next;
 103 is( $it->next->name, "Artist 2", "iterator->next ok" );
 104 is( $it->next, undef, "next past end of resultset ok" );
 105
 106 # test GUID columns
 107
 108 $schema->storage->dbh_do (sub {
 109     my ($storage, $dbh) = @_;
 110     eval { $dbh->do("DROP TABLE artist") };
 111     $dbh->do(<<'SQL');
 112 CREATE TABLE artist (
 113    artistid UNIQUEIDENTIFIER NOT NULL,
 114    name VARCHAR(100),
 115    rank INT NOT NULL DEFAULT '13',
 116    charfield CHAR(10) NULL,
 117    a_guid UNIQUEIDENTIFIER,
 118    primary key(artistid)
 119 )
 120 SQL
 121 });
 122
 123 # start disconnected to make sure insert works on an un-reblessed storage
 124 $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 125
 126 my $row;
 127 lives_ok {
 128   $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 129 } 'created a row with a GUID';
 130
 131 ok(
 132   eval { $row->artistid },
 133   'row has GUID PK col populated',
 134 );
 135 diag $@ if $@;
 136
 137 ok(
 138   eval { $row->a_guid },
 139   'row has a GUID col with auto_nextval populated',
 140 );
 141 diag $@ if $@;
 142
 143 my $row_from_db = $schema->resultset('ArtistGUID')
 144   ->search({ name => 'mtfnpy' })->first;
 145
 146 is $row_from_db->artistid, $row->artistid,
 147   'PK GUID round trip';
 148
 149 is $row_from_db->a_guid, $row->a_guid,
 150   'NON-PK GUID round trip';
 151
 152 # test MONEY type
 153 $schema->storage->dbh_do (sub {
 154     my ($storage, $dbh) = @_;
 155     eval { $dbh->do("DROP TABLE money_test") };
 156     $dbh->do(<<'SQL');
 157 CREATE TABLE money_test (
 158    id INT IDENTITY PRIMARY KEY,
 159    amount MONEY NULL
 160 )
 161 SQL
 162 });
 163
 164 my $rs = $schema->resultset('Money');
 165
 166 lives_ok {
 167   $row = $rs->create({ amount => 100 });
 168 } 'inserted a money value';
 169
 170 cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
 171
 172 lives_ok {
 173   $row->update({ amount => 200 });
 174 } 'updated a money value';
 175
 176 cmp_ok $rs->find($row->id)->amount, '==', 200,
 177   'updated money value round-trip';
 178
 179 lives_ok {
 180   $row->update({ amount => undef });
 181 } 'updated a money value to NULL';
 182
 183 is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
 184
 185 $schema->storage->dbh_do (sub {
 186     my ($storage, $dbh) = @_;
 187     eval { $dbh->do("DROP TABLE owners") };
 188     eval { $dbh->do("DROP TABLE books") };
 189     $dbh->do(<<'SQL');
 190 CREATE TABLE books (
 191    id INT IDENTITY (1, 1) NOT NULL,
 192    source VARCHAR(100),
 193    owner INT,
 194    title VARCHAR(10),
 195    price INT NULL
 196 )
 197
 198 CREATE TABLE owners (
 199    id INT IDENTITY (1, 1) NOT NULL,
 200    name VARCHAR(100),
 201 )
 202 SQL
 203
 204 });
 205
 206 lives_ok ( sub {
 207   # start a new connection, make sure rebless works
 208   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 209   $schema->populate ('Owners', [
 210     [qw/id  name  /],
 211     [qw/1   wiggle/],
 212     [qw/2   woggle/],
 213     [qw/3   boggle/],
 214     [qw/4   fRIOUX/],
 215     [qw/5   fRUE/],
 216     [qw/6   fREW/],
 217     [qw/7   fROOH/],
 218     [qw/8   fISMBoC/],
 219     [qw/9   station/],
 220     [qw/10   mirror/],
 221     [qw/11   dimly/],
 222     [qw/12   face_to_face/],
 223     [qw/13   icarus/],
 224     [qw/14   dream/],
 225     [qw/15   dyrstyggyr/],
 226   ]);
 227 }, 'populate with PKs supplied ok' );
 228
 229
 230 lives_ok (sub {
 231   # start a new connection, make sure rebless works
 232   # test an insert with a supplied identity, followed by one without
 233   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 234   for (2, 1) {
 235     my $id = $_ * 20 ;
 236     $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
 237     $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
 238   }
 239 }, 'create with/without PKs ok' );
 240
 241 is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
 242
 243 lives_ok ( sub {
 244   # start a new connection, make sure rebless works
 245   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 246   $schema->populate ('BooksInLibrary', [
 247     [qw/source  owner title   /],
 248     [qw/Library 1     secrets0/],
 249     [qw/Library 1     secrets1/],
 250     [qw/Eatery  1     secrets2/],
 251     [qw/Library 2     secrets3/],
 252     [qw/Library 3     secrets4/],
 253     [qw/Eatery  3     secrets5/],
 254     [qw/Library 4     secrets6/],
 255     [qw/Library 5     secrets7/],
 256     [qw/Eatery  5     secrets8/],
 257     [qw/Library 6     secrets9/],
 258     [qw/Library 7     secrets10/],
 259     [qw/Eatery  7     secrets11/],
 260     [qw/Library 8     secrets12/],
 261   ]);
 262 }, 'populate without PKs supplied ok' );
 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/, '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
 273   my $al = $owners->current_source_alias;
 274   my $sealed_owners = $owners->result_source->resultset->search (
 275     {},
 276     {
 277       alias => $al,
 278       from => [{
 279         -alias => $al,
 280         -source_handle => $owners->result_source->handle,
 281         $al => $owners->as_query,
 282       }],
 283     },
 284   );
 285
 286   is_deeply (
 287     [ map { $_->name } ($sealed_owners->all) ],
 288     [ map { $_->name } ($owners->all) ],
 289     'Sort preserved from within a subquery',
 290   );
 291 }
 292
 293 TODO: {
 294   local $TODO = "This porbably will never work, but it isn't critical either afaik";
 295
 296   my $book_owner_ids = $schema->resultset ('BooksInLibrary')
 297                                ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name', unsafe_subselect_ok => 1 })
 298                                 ->get_column ('owner');
 299
 300   my $book_owners = $schema->resultset ('Owners')->search ({
 301     id => { -in => $book_owner_ids->as_query }
 302   });
 303
 304   is_deeply (
 305     [ map { $_->id } ($book_owners->all) ],
 306     [ $book_owner_ids->all ],
 307     'Sort is preserved across IN subqueries',
 308   );
 309 }
 310
 311 # This is known not to work - thus the negative test
 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   cmp_ok (
 324     join ("\x00", map { $_->name } ($corelated_owners->all) ),
 325       'ne',
 326     join ("\x00", map { $_->name } ($owners->all) ),
 327     'Sadly sort not preserved from within a corelated subquery',
 328   );
 329
 330   cmp_ok (
 331     join ("\x00", sort map { $_->name } ($corelated_owners->all) ),
 332       'ne',
 333     join ("\x00", sort map { $_->name } ($owners->all) ),
 334     'Which in fact gives a completely wrong dataset',
 335   );
 336 }
 337
 338
 339 # make sure right-join-side single-prefetch ordering limit works
 340 {
 341   my $rs = $schema->resultset ('BooksInLibrary')->search (
 342     {
 343       'owner.name' => { '!=', 'woggle' },
 344     },
 345     {
 346       prefetch => 'owner',
 347       order_by => 'owner.name',
 348     }
 349   );
 350   # this is the order in which they should come from the above query
 351   my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
 352
 353   is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
 354   is_deeply (
 355     [map { $_->owner->name } ($rs->all) ],
 356     \@owner_names,
 357     'Rows were properly ordered'
 358   );
 359
 360   my $limited_rs = $rs->search ({}, {rows => 7, offset => 2, unsafe_subselect_ok => 1});
 361   is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
 362   is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
 363
 364   my $queries;
 365   $schema->storage->debugcb(sub { $queries++; });
 366   $schema->storage->debug(1);
 367
 368   is_deeply (
 369     [map { $_->owner->name } ($limited_rs->all) ],
 370     [@owner_names[2 .. 7]],
 371     'Limited rows were properly ordered'
 372   );
 373   is ($queries, 1, 'Only one query with prefetch');
 374
 375   $schema->storage->debugcb(undef);
 376   $schema->storage->debug(0);
 377
 378
 379   is_deeply (
 380     [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
 381     [@owner_names[2 .. 7]],
 382     'Rows are still properly ordered after search_related'
 383   );
 384 }
 385
 386
 387 #
 388 # try a prefetch on tables with identically named columns
 389 #
 390
 391 # set quote char - make sure things work while quoted
 392 $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
 393 $schema->storage->_sql_maker->{name_sep} = '.';
 394
 395 {
 396   # try a ->has_many direction
 397   my $owners = $schema->resultset ('Owners')->search (
 398     {
 399       'books.id' => { '!=', undef },
 400       'me.name' => { '!=', 'somebogusstring' },
 401     },
 402     {
 403       prefetch => 'books',
 404       order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
 405       rows     => 3,  # 8 results total
 406       unsafe_subselect_ok => 1,
 407     },
 408   );
 409
 410   my ($sql, @bind) = @${$owners->page(3)->as_query};
 411   is_deeply (
 412     \@bind,
 413     [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ],  # double because of the prefetch subq
 414   );
 415
 416   is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
 417   is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
 418
 419   is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
 420   is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
 421   is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
 422
 423
 424   # try a ->belongs_to direction (no select collapse, group_by should work)
 425   my $books = $schema->resultset ('BooksInLibrary')->search (
 426     {
 427       'owner.name' => [qw/wiggle woggle/],
 428     },
 429     {
 430       distinct => 1,
 431       having => \['1 = ?', [ test => 1 ] ], #test having propagation
 432       prefetch => 'owner',
 433       rows     => 2,  # 3 results total
 434       order_by => { -desc => 'me.owner' },
 435       unsafe_subselect_ok => 1,
 436     },
 437   );
 438
 439   ($sql, @bind) = @${$books->page(3)->as_query};
 440   is_deeply (
 441     \@bind,
 442     [
 443       # inner
 444       [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
 445       # outer
 446       [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
 447     ],
 448   );
 449
 450   is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
 451   is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
 452
 453   is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
 454   is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
 455   is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
 456 }
 457
 458 done_testing;
 459
 460 # clean up our mess
 461 END {
 462   if (my $dbh = eval { $schema->storage->_dbh }) {
 463     eval { $dbh->do("DROP TABLE $_") }
 464       for qw/artist money_test books owners/;
 465   }
 466 }
 467 # vim:sw=2 sts=2