Commit | Line | Data |
c1cac633 |
1 | use strict; |
b9a2c3a5 |
2 | use warnings; |
c1cac633 |
3 | |
4 | use Test::More; |
893403c8 |
5 | use Test::Exception; |
c1cac633 |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
b2d16f1f |
8 | use DBIC::SqlMakerTest; |
c1cac633 |
9 | |
10 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; |
11 | |
12 | plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' |
13 | unless ($dsn && $user); |
14 | |
ca791b95 |
15 | DBICTest::Schema->load_classes('ArtistGUID'); |
42e5b103 |
16 | my $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 |
29 | isa_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 |
40 | CREATE 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 |
47 | SQL |
c5f77f6c |
48 | }); |
49 | |
c1cac633 |
50 | my %seen_id; |
51 | |
7b1b2582 |
52 | my @opts = ( |
53 | { on_connect_call => 'use_dynamic_cursors' }, |
54 | {}, |
55 | ); |
56 | my $new; |
2eebd801 |
57 | |
7b1b2582 |
58 | # test Auto-PK with different options |
59 | for 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 |
83 | for (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 | |
89 | my $it = $schema->resultset('Artist')->search( {}, { |
90 | rows => 3, |
91 | order_by => 'artistid', |
92 | }); |
93 | |
94 | is( $it->count, 3, "LIMIT count ok" ); |
95 | is( $it->next->name, "foo", "iterator->next ok" ); |
96 | $it->next; |
97 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
98 | is( $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'); |
106 | CREATE 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 | ) |
114 | SQL |
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 |
120 | my $row; |
121 | lives_ok { |
122 | $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) |
123 | } 'created a row with a GUID'; |
124 | |
125 | ok( |
126 | eval { $row->artistid }, |
127 | 'row has GUID PK col populated', |
128 | ); |
129 | diag $@ if $@; |
130 | |
131 | ok( |
132 | eval { $row->a_guid }, |
133 | 'row has a GUID col with auto_nextval populated', |
134 | ); |
135 | diag $@ if $@; |
136 | |
137 | my $row_from_db = $schema->resultset('ArtistGUID') |
138 | ->search({ name => 'mtfnpy' })->first; |
139 | |
140 | is $row_from_db->artistid, $row->artistid, |
141 | 'PK GUID round trip'; |
142 | |
143 | is $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 |
151 | CREATE TABLE money_test ( |
152 | id INT IDENTITY PRIMARY KEY, |
5064f5c3 |
153 | amount MONEY NULL |
818ec409 |
154 | ) |
818ec409 |
155 | SQL |
818ec409 |
156 | }); |
157 | |
158 | my $rs = $schema->resultset('Money'); |
159 | |
818ec409 |
160 | lives_ok { |
d68f21ee |
161 | $row = $rs->create({ amount => 100 }); |
818ec409 |
162 | } 'inserted a money value'; |
163 | |
a33d2444 |
164 | cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip'; |
818ec409 |
165 | |
d68f21ee |
166 | lives_ok { |
167 | $row->update({ amount => 200 }); |
168 | } 'updated a money value'; |
169 | |
a33d2444 |
170 | cmp_ok $rs->find($row->id)->amount, '==', 200, |
171 | 'updated money value round-trip'; |
d68f21ee |
172 | |
f6b185e1 |
173 | lives_ok { |
174 | $row->update({ amount => undef }); |
175 | } 'updated a money value to NULL'; |
176 | |
177 | is $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 |
184 | CREATE 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 |
192 | CREATE TABLE owners ( |
b9a2c3a5 |
193 | id INT IDENTITY (1, 1) NOT NULL, |
42e5b103 |
194 | name VARCHAR(100), |
b9a2c3a5 |
195 | ) |
b9a2c3a5 |
196 | SQL |
197 | |
198 | }); |
893403c8 |
199 | |
200 | lives_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 | |
afcfff01 |
223 | lives_ok (sub { |
224 | # start a new connection, make sure rebless works |
225 | # test an insert with a supplied identity, followed by one without |
226 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
fb7cd45f |
227 | for (2, 1) { |
afcfff01 |
228 | my $id = $_ * 20 ; |
229 | $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" }); |
230 | $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) }); |
231 | } |
232 | }, 'create with/without PKs ok' ); |
233 | |
234 | is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' ); |
235 | |
893403c8 |
236 | lives_ok ( sub { |
e29dc2bb |
237 | # start a new connection, make sure rebless works |
48617009 |
238 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
893403c8 |
239 | $schema->populate ('BooksInLibrary', [ |
240 | [qw/source owner title /], |
02495deb |
241 | [qw/Library 1 secrets0/], |
242 | [qw/Library 1 secrets1/], |
893403c8 |
243 | [qw/Eatery 1 secrets2/], |
aafe4014 |
244 | [qw/Library 2 secrets3/], |
02495deb |
245 | [qw/Library 3 secrets4/], |
aafe4014 |
246 | [qw/Eatery 3 secrets5/], |
02495deb |
247 | [qw/Library 4 secrets6/], |
248 | [qw/Library 5 secrets7/], |
249 | [qw/Eatery 5 secrets8/], |
aafe4014 |
250 | [qw/Library 6 secrets9/], |
02495deb |
251 | [qw/Library 7 secrets10/], |
252 | [qw/Eatery 7 secrets11/], |
893403c8 |
253 | [qw/Library 8 secrets12/], |
254 | ]); |
255 | }, 'populate without PKs supplied ok' ); |
b9a2c3a5 |
256 | |
f0bd60fc |
257 | # make sure ordered subselects work |
258 | { |
fb7cd45f |
259 | my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name' }); |
260 | my $al = $owners->current_source_alias; |
261 | my $sealed_owners = $owners->result_source->resultset->search ( |
262 | {}, |
263 | { |
264 | alias => $al, |
265 | from => [{ |
266 | -alias => $al, |
267 | -source_handle => $owners->result_source->handle, |
268 | $al => $owners->as_query, |
269 | }], |
270 | }, |
271 | ); |
272 | |
273 | $schema->storage->debug (1); |
274 | diag "\n"; |
b8c33373 |
275 | my @names = map { $_->name } ($owners->all); |
276 | my @subq_names = map { $_->name } ($sealed_owners->all); |
fb7cd45f |
277 | |
278 | is_deeply ( |
fb7cd45f |
279 | \@names, |
b8c33373 |
280 | \@subq_names, |
fb7cd45f |
281 | 'Sort preserved from within a subquery' |
282 | ) || diag do { require Data::Dumper::Concise; Data::Dumper::Concise::Dumper (\@names, \@subq_names) }; |
283 | $schema->storage->debug (0); |
284 | |
285 | |
286 | |
f0bd60fc |
287 | my $book_owner_ids = $schema->resultset ('BooksInLibrary') |
fb7cd45f |
288 | ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name' }) |
f0bd60fc |
289 | ->get_column ('owner'); |
290 | |
fb7cd45f |
291 | my $book_owners = $schema->resultset ('Owners')->search ({ |
f0bd60fc |
292 | id => { -in => $book_owner_ids->as_query } |
293 | }); |
294 | |
fb7cd45f |
295 | is ($book_owners->count, 8, 'Correct amount of book owners'); |
296 | |
297 | is_deeply ( |
298 | [ map { $_->id } ($book_owners->all) ], |
299 | [ $book_owner_ids->all ], |
300 | 'Sort is preserved across IN subqueries', |
301 | ); |
f0bd60fc |
302 | } |
fb7cd45f |
303 | |
8ff60918 |
304 | # make sure right-join-side single-prefetch ordering limit works |
305 | { |
306 | my $rs = $schema->resultset ('BooksInLibrary')->search ( |
307 | { |
308 | 'owner.name' => { '!=', 'woggle' }, |
309 | }, |
310 | { |
311 | prefetch => 'owner', |
312 | order_by => 'owner.name', |
313 | } |
314 | ); |
315 | # this is the order in which they should come from the above query |
316 | my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/; |
317 | |
318 | is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset'); |
319 | is_deeply ( |
320 | [map { $_->owner->name } ($rs->all) ], |
321 | \@owner_names, |
322 | 'Rows were properly ordered' |
323 | ); |
324 | |
325 | my $limited_rs = $rs->search ({}, {rows => 7, offset => 2}); |
326 | is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset'); |
327 | is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset'); |
328 | |
329 | my $queries; |
330 | $schema->storage->debugcb(sub { $queries++; }); |
331 | $schema->storage->debug(1); |
332 | |
333 | is_deeply ( |
334 | [map { $_->owner->name } ($limited_rs->all) ], |
335 | [@owner_names[2 .. 7]], |
336 | 'Limited rows were properly ordered' |
337 | ); |
338 | is ($queries, 1, 'Only one query with prefetch'); |
339 | |
340 | $schema->storage->debugcb(undef); |
341 | $schema->storage->debug(0); |
342 | |
343 | |
344 | is_deeply ( |
345 | [map { $_->name } ($limited_rs->search_related ('owner')->all) ], |
346 | [@owner_names[2 .. 7]], |
347 | 'Rows are still properly ordered after search_related' |
348 | ); |
349 | } |
350 | |
f0bd60fc |
351 | |
b9a2c3a5 |
352 | # |
02d133f0 |
353 | # try a prefetch on tables with identically named columns |
b9a2c3a5 |
354 | # |
355 | |
02d133f0 |
356 | # set quote char - make sure things work while quoted |
357 | $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/]; |
358 | $schema->storage->_sql_maker->{name_sep} = '.'; |
359 | |
b9a2c3a5 |
360 | { |
893403c8 |
361 | # try a ->has_many direction |
6bc666a5 |
362 | my $owners = $schema->resultset ('Owners')->search ( |
363 | { |
9010bab8 |
364 | 'books.id' => { '!=', undef }, |
365 | 'me.name' => { '!=', 'somebogusstring' }, |
6bc666a5 |
366 | }, |
367 | { |
fc85215b |
368 | prefetch => 'books', |
9010bab8 |
369 | order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation |
56d2561e |
370 | rows => 3, # 8 results total |
6bc666a5 |
371 | }, |
372 | ); |
fc85215b |
373 | |
9010bab8 |
374 | my ($sql, @bind) = @${$owners->page(3)->as_query}; |
375 | is_deeply ( |
376 | \@bind, |
377 | [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq |
378 | ); |
379 | |
56d2561e |
380 | is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows'); |
381 | is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count'); |
382 | |
6bc666a5 |
383 | is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows'); |
384 | is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count'); |
385 | is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs'); |
386 | |
b9a2c3a5 |
387 | |
42e5b103 |
388 | # try a ->belongs_to direction (no select collapse, group_by should work) |
6bc666a5 |
389 | my $books = $schema->resultset ('BooksInLibrary')->search ( |
390 | { |
56d2561e |
391 | 'owner.name' => [qw/wiggle woggle/], |
6bc666a5 |
392 | }, |
393 | { |
fc85215b |
394 | distinct => 1, |
9010bab8 |
395 | having => \['1 = ?', [ test => 1 ] ], #test having propagation |
42e5b103 |
396 | prefetch => 'owner', |
56d2561e |
397 | rows => 2, # 3 results total |
ac93965c |
398 | order_by => { -desc => 'owner' }, |
6bc666a5 |
399 | }, |
400 | ); |
fc85215b |
401 | |
9010bab8 |
402 | ($sql, @bind) = @${$books->page(3)->as_query}; |
403 | is_deeply ( |
404 | \@bind, |
405 | [ |
406 | # inner |
407 | [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ], |
408 | # outer |
409 | [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], |
410 | ], |
411 | ); |
b1e1d073 |
412 | |
56d2561e |
413 | is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows'); |
414 | is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count'); |
b1e1d073 |
415 | |
6bc666a5 |
416 | is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows'); |
417 | is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count'); |
418 | is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs'); |
b9a2c3a5 |
419 | } |
c1cac633 |
420 | |
8ff60918 |
421 | |
422 | |
423 | # Just to aid bug-hunting, delete block before merging |
b8d88d9b |
424 | { |
8ff60918 |
425 | |
426 | my $limited_rs = $schema->resultset ('BooksInLibrary')->search ( |
b8d88d9b |
427 | { |
92f6e0b8 |
428 | 'owner.name' => { '!=', 'woggle' }, |
b8d88d9b |
429 | }, |
430 | { |
3670702b |
431 | prefetch => 'owner', |
aafe4014 |
432 | order_by => 'owner.name', |
8ff60918 |
433 | rows => 7, |
434 | offset => 2, |
b8d88d9b |
435 | } |
436 | ); |
92f6e0b8 |
437 | |
444b791c |
438 | |
188c8576 |
439 | =begin |
440 | |
441 | Alan's SQL: |
442 | |
443 | SELECT me.id, me.surveyor_id, me.survey_site_id, me.year, surveyor.id, surveyor.name, surveyor.email, surveyor.phone, surveyor.login, surveyor.password, surveyor.is_active, surveyor.is_verifier, surveyor.arm_length, surveyor.eye_height, surveyor.year_joined |
444 | FROM ( |
445 | SELECT * |
446 | FROM ( |
447 | SELECT orig_query.*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index |
448 | FROM ( |
449 | SELECT me.id, me.surveyor_id, me.survey_site_id, me.year |
450 | FROM ( |
451 | SELECT TOP 100 PERCENT me.id, me.surveyor_id, me.survey_site_id, me.year |
452 | FROM surveyors_survey_sites me |
453 | JOIN surveyors surveyor ON surveyor.id = me.surveyor_id |
454 | ORDER BY surveyor.name |
455 | ) me |
456 | ) orig_query |
457 | ) rno_subq |
458 | WHERE rno__row__index BETWEEN 136 AND 150 |
459 | ) me |
460 | JOIN surveyors surveyor ON surveyor.id = me.surveyor_id |
461 | ORDER BY surveyor.name |
462 | =cut |
463 | |
464 | is_same_sql_bind ( |
465 | $limited_rs->as_query, |
466 | '( |
467 | SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price], [owner].[id], [owner].[name] |
468 | FROM ( |
469 | SELECT * |
470 | FROM ( |
02495deb |
471 | SELECT [me].*, ROW_NUMBER() OVER( ORDER BY (SELECT(1)) ) AS rno__row__index |
188c8576 |
472 | FROM ( |
473 | SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price] |
474 | FROM ( |
475 | SELECT TOP 100 PERCENT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price] |
476 | FROM [books] [me] |
477 | JOIN [owners] [owner] ON [owner].[id] = [me].[owner] |
478 | WHERE ( ( [owner].[name] != ? AND [source] = ? ) ) |
aafe4014 |
479 | ORDER BY [owner].[name] |
188c8576 |
480 | ) [me] |
1f36ab67 |
481 | ) [me] |
188c8576 |
482 | ) rno_subq |
483 | WHERE rno__row__index BETWEEN 3 AND 9 |
484 | ) [me] |
485 | JOIN [owners] [owner] ON [owner].[id] = [me].[owner] |
486 | WHERE ( ( [owner].[name] != ? AND [source] = ? ) ) |
aafe4014 |
487 | ORDER BY [owner].[name] |
188c8576 |
488 | )', |
489 | [ ([ 'owner.name' => 'woggle' ], [ source => 'Library' ]) x 2 ], |
490 | 'Expected SQL executed', |
491 | ); |
492 | } |
493 | |
afcfff01 |
494 | done_testing; |
495 | |
c1cac633 |
496 | # clean up our mess |
497 | END { |
ca791b95 |
498 | if (my $dbh = eval { $schema->storage->_dbh }) { |
499 | eval { $dbh->do("DROP TABLE $_") } |
02495deb |
500 | for qw/artist money_test books owners/; |
ca791b95 |
501 | } |
c1cac633 |
502 | } |
fc85215b |
503 | # vim:sw=2 sts=2 |