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