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