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