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