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