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