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