MULTICREATE_DEBUG + TRACE_PROFILE=console_monochrome results in >4MB log
[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}) {
e81b50f4 78 die "on_connect_call option '$opts_name' is not functional: $_";
9ffaf8a3 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
4ca1fd6f 254 {
e56b1c2d 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
fd1d12a9 375 is_same_sql_bind (
376 $owners->page(3)->as_query,
377 $dialect eq 'Top'
378 ? '(
379 SELECT TOP 2147483647 [me].[id], [me].[name],
380 [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
381 FROM (
382 SELECT TOP 2147483647 [me].[id], [me].[name]
383 FROM (
384 SELECT TOP 3 [me].[id], [me].[name], [ORDER__BY__001]
385 FROM (
386 SELECT TOP 9 [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
387 FROM [owners] [me]
388 LEFT JOIN [books] [books]
389 ON [books].[owner] = [me].[id]
390 WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
391 GROUP BY [me].[id], [me].[name]
392 ORDER BY name + ? ASC, [me].[id]
393 ) [me]
394 ORDER BY [ORDER__BY__001] DESC, [me].[id] DESC
395 ) [me]
396 ORDER BY [ORDER__BY__001] ASC, [me].[id]
397 ) [me]
398 LEFT JOIN [books] [books]
399 ON [books].[owner] = [me].[id]
400 WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
401 ORDER BY name + ? ASC, [me].[id]
402 )'
403 : '(
404 SELECT TOP 2147483647 [me].[id], [me].[name],
405 [books].[id], [books].[source], [books].[owner], [books].[title], [books].[price]
406 FROM (
407 SELECT TOP 2147483647 [me].[id], [me].[name]
408 FROM (
409 SELECT [me].[id], [me].[name],
410 ROW_NUMBER() OVER( ORDER BY [ORDER__BY__001] ASC, [me].[id] ) AS [rno__row__index]
411 FROM (
412 SELECT [me].[id], [me].[name], name + ? AS [ORDER__BY__001]
413 FROM [owners] [me]
414 LEFT JOIN [books] [books]
415 ON [books].[owner] = [me].[id]
416 WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
417 GROUP BY [me].[id], [me].[name]
418 ) [me]
419 ) [me]
420 WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
421 ) [me]
422 LEFT JOIN [books] [books]
423 ON [books].[owner] = [me].[id]
424 WHERE [books].[id] IS NOT NULL AND [me].[name] != ?
425 ORDER BY name + ? ASC, [me].[id]
426 )'
427 ,
e56b1c2d 428 [
fcb7fcbb 429 [ { dbic_colname => 'test' }
430 => 'xxx' ],
ebc5c60a 431 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
432 => 'somebogusstring' ],
433
434 ($dialect eq 'Top'
435 ? [ { dbic_colname => 'test' } => 'xxx' ] # the extra re-order bind
436 : ([ $OFFSET => 7 ], [ $TOTAL => 9 ]) # parameterised RNO
437 ),
438
fcb7fcbb 439 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' }
440 => 'somebogusstring' ],
441 [ { dbic_colname => 'test' }
442 => 'xxx' ],
e56b1c2d 443 ],
fd1d12a9 444 ) if $quoted;
fb7cd45f 445
e56b1c2d 446 is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows");
447 is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count");
a54bd479 448
e56b1c2d 449 is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count");
4ca1fd6f 450 {
e56b1c2d 451 local $TODO = "Top-limit does not work when your limit ends up past the resultset"
452 if $dialect eq 'Top';
453 is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows");
454 is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs");
a54bd479 455 }
a54bd479 456
a54bd479 457
e56b1c2d 458 # try a ->belongs_to direction (no select collapse, group_by should work)
459 my $books = $schema->resultset ('BooksInLibrary')->search (
460 {
461 'owner.name' => [qw/wiggle woggle/],
462 },
463 {
464 distinct => 1,
465 having => \['1 = ?', [ test => 1 ] ], #test having propagation
466 prefetch => 'owner',
467 rows => 2, # 3 results total
86bb5a27 468 order_by => [{ -desc => 'me.owner' }, 'me.id'],
e56b1c2d 469 unsafe_subselect_ok => 1,
470 },
471 );
6de07ea3 472
fd1d12a9 473 is_same_sql_bind (
474 $books->page(3)->as_query,
475 $dialect eq 'Top'
476 ? '(
477 SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
478 [owner].[id], [owner].[name]
479 FROM (
480 SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
481 FROM (
482 SELECT TOP 2 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
483 FROM (
484 SELECT TOP 6 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
485 FROM [books] [me]
486 JOIN [owners] [owner]
487 ON [owner].[id] = [me].[owner]
488 WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
489 GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
490 HAVING 1 = ?
491 ORDER BY [me].[owner] DESC, [me].[id]
492 ) [me]
493 ORDER BY [me].[owner] ASC, [me].[id] DESC
494 ) [me]
495 ORDER BY [me].[owner] DESC, [me].[id]
496 ) [me]
497 JOIN [owners] [owner]
498 ON [owner].[id] = [me].[owner]
499 WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
500 ORDER BY [me].[owner] DESC, [me].[id]
501 )'
502 : '(
503 SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
504 [owner].[id], [owner].[name]
505 FROM (
506 SELECT TOP 2147483647 [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
507 FROM (
508 SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price],
509 ROW_NUMBER() OVER( ORDER BY [me].[owner] DESC, [me].[id] ) AS [rno__row__index]
510 FROM (
511 SELECT [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
512 FROM [books] [me]
513 JOIN [owners] [owner]
514 ON [owner].[id] = [me].[owner]
515 WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
516 GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
517 HAVING 1 = ?
518 ) [me]
519 ) [me]
520 WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
521 ) [me]
522 JOIN [owners] [owner]
523 ON [owner].[id] = [me].[owner]
524 WHERE ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ?
525 ORDER BY [me].[owner] DESC, [me].[id]
526 )'
527 ,
e56b1c2d 528 [
529 # inner
0e773352 530 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
531 => 'wiggle' ],
532 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
533 => 'woggle' ],
534 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
535 => 'Library' ],
536 [ { dbic_colname => 'test' }
537 => '1' ],
538
fd1d12a9 539 # top(?)
540 $dialect eq 'Top'
541 ? ()
542 : ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] )
543 ,
544
e56b1c2d 545 # outer
0e773352 546 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
547 => 'wiggle' ],
548 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' }
549 => 'woggle' ],
550 [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
551 => 'Library' ],
e56b1c2d 552 ],
fd1d12a9 553 ) if $quoted;
4bb438ca 554
e56b1c2d 555 is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows");
556 is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count");
a54bd479 557
e56b1c2d 558 is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count");
4ca1fd6f 559 {
e56b1c2d 560 local $TODO = "Top-limit does not work when your limit ends up past the resultset"
561 if $dialect eq 'Top';
562 is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows");
563 is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs");
564 }
565 }
a54bd479 566 }
6de07ea3 567
568
a54bd479 569# test GUID columns
e56b1c2d 570 {
571 $schema->storage->dbh_do (sub {
572 my ($storage, $dbh) = @_;
573 eval { $dbh->do("DROP TABLE artist_guid") };
574 $dbh->do(<<'SQL');
b1bdb76d 575CREATE TABLE artist_guid (
a54bd479 576 artistid UNIQUEIDENTIFIER NOT NULL,
577 name VARCHAR(100),
578 rank INT NOT NULL DEFAULT '13',
579 charfield CHAR(10) NULL,
580 a_guid UNIQUEIDENTIFIER,
581 primary key(artistid)
582)
583SQL
e56b1c2d 584 });
8ff60918 585
e56b1c2d 586 # start disconnected to make sure insert works on an un-reblessed storage
587 $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
8ff60918 588
e56b1c2d 589 my $row;
590 lives_ok {
591 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
592 } 'created a row with a GUID';
8ff60918 593
e56b1c2d 594 ok(
595 eval { $row->artistid },
596 'row has GUID PK col populated',
597 );
598 diag $@ if $@;
8ff60918 599
e56b1c2d 600 ok(
601 eval { $row->a_guid },
602 'row has a GUID col with auto_nextval populated',
603 );
604 diag $@ if $@;
8ff60918 605
e56b1c2d 606 my $row_from_db = $schema->resultset('ArtistGUID')
607 ->search({ name => 'mtfnpy' })->first;
f0bd60fc 608
e56b1c2d 609 is $row_from_db->artistid, $row->artistid,
610 'PK GUID round trip';
b9a2c3a5 611
e56b1c2d 612 is $row_from_db->a_guid, $row->a_guid,
613 'NON-PK GUID round trip';
614 }
02d133f0 615
a54bd479 616# test MONEY type
e56b1c2d 617 {
618 $schema->storage->dbh_do (sub {
619 my ($storage, $dbh) = @_;
620 eval { $dbh->do("DROP TABLE money_test") };
621 $dbh->do(<<'SQL');
a54bd479 622CREATE TABLE money_test (
623 id INT IDENTITY PRIMARY KEY,
624 amount MONEY NULL
625)
626SQL
e56b1c2d 627 });
9010bab8 628
4ca1fd6f 629 {
35af31a1 630 my $freetds_and_dynamic_cursors = 1
631 if $opts_name eq 'use_dynamic_cursors' &&
aca3b4c3 632 $schema->storage->_using_freetds;
35af31a1 633
8273e845 634 local $TODO =
9ffaf8a3 635'these tests fail on freetds with dynamic cursors for some reason'
35af31a1 636 if $freetds_and_dynamic_cursors;
637 local $ENV{DBIC_NULLABLE_KEY_NOWARN} = 1
638 if $freetds_and_dynamic_cursors;
56d2561e 639
9ffaf8a3 640 my $rs = $schema->resultset('Money');
641 my $row;
6bc666a5 642
9ffaf8a3 643 lives_ok {
644 $row = $rs->create({ amount => 100 });
645 } 'inserted a money value';
b9a2c3a5 646
9ffaf8a3 647 cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 100,
648 'money value round-trip');
fc85215b 649
9ffaf8a3 650 lives_ok {
651 $row->update({ amount => 200 });
652 } 'updated a money value';
b1e1d073 653
9ffaf8a3 654 cmp_ok ((try { $rs->find($row->id)->amount })||0, '==', 200,
655 'updated money value round-trip');
b1e1d073 656
9ffaf8a3 657 lives_ok {
658 $row->update({ amount => undef });
659 } 'updated a money value to NULL';
660
661 is try { $rs->find($row->id)->amount }, undef,
662 'updated money value to NULL round-trip';
663 }
e56b1c2d 664 }
665 }
384b8bce 666}
c1cac633 667
afcfff01 668done_testing;
669
c1cac633 670# clean up our mess
671END {
ca791b95 672 if (my $dbh = eval { $schema->storage->_dbh }) {
673 eval { $dbh->do("DROP TABLE $_") }
b1bdb76d 674 for qw/artist artist_guid money_test books owners/;
ca791b95 675 }
65d35121 676 undef $schema;
c1cac633 677}
fc85215b 678# vim:sw=2 sts=2