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