'undef =>' isn't what one would want
[dbsrgits/DBIx-Class-Historic.git] / t / 100populate.t
CommitLineData
54e0bd06 1use strict;
d35a6fed 2use warnings;
54e0bd06 3
4use Test::More;
d35a6fed 5use Test::Exception;
75a1d824 6use Test::Warn;
54e0bd06 7use lib qw(t/lib);
8use DBICTest;
1c30a2e4 9use DBIx::Class::_Util qw(sigwarn_silencer serialize);
c0d8cb1f 10use Path::Class::File ();
75a1d824 11use Math::BigInt;
569b9fe6 12use List::Util qw/shuffle/;
54e0bd06 13
54e0bd06 14my $schema = DBICTest->init_schema();
54e0bd06 15
d35a6fed 16# The map below generates stuff like:
17# [ qw/artistid name/ ],
18# [ 4, "b" ],
19# [ 5, "c" ],
20# ...
21# [ 9999, "ntm" ],
22# [ 10000, "ntn" ],
23
24my $start_id = 'populateXaaaaaa';
569b9fe6 25my $rows = 10_000;
d35a6fed 26my $offset = 3;
27
569b9fe6 28$schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
d35a6fed 29is (
30 $schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
31 $rows,
32 'populate created correct number of rows with massive AoA bulk insert',
33);
34
35my $artist = $schema->resultset ('Artist')
36 ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' })
37 ->first;
38my $ex_title = $artist->cds->first->title;
39
40throws_ok ( sub {
41 my $i = 600;
42 $schema->populate('CD', [
43 map {
44 {
d35a6fed 45 artist => $artist->id,
46 title => $_,
47 year => 2009,
48 }
49 } ('Huey', 'Dewey', $ex_title, 'Louie')
50 ])
52cef7e3 51}, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
b0457415 52
89b2e3e4 53## make sure populate honors fields/orders in list context
b0457415 54## schema order
89b2e3e4 55my @links = $schema->populate('Link', [
b0457415 56[ qw/id url title/ ],
57[ qw/2 burl btitle/ ]
58]);
89b2e3e4 59is(scalar @links, 1);
60
61my $link2 = shift @links;
b0457415 62is($link2->id, 2, 'Link 2 id');
63is($link2->url, 'burl', 'Link 2 url');
64is($link2->title, 'btitle', 'Link 2 title');
65
66## non-schema order
89b2e3e4 67@links = $schema->populate('Link', [
b0457415 68[ qw/id title url/ ],
69[ qw/3 ctitle curl/ ]
70]);
89b2e3e4 71is(scalar @links, 1);
72
73my $link3 = shift @links;
b0457415 74is($link3->id, 3, 'Link 3 id');
75is($link3->url, 'curl', 'Link 3 url');
76is($link3->title, 'ctitle', 'Link 3 title');
77
78## not all physical columns
89b2e3e4 79@links = $schema->populate('Link', [
b0457415 80[ qw/id title/ ],
81[ qw/4 dtitle/ ]
82]);
89b2e3e4 83is(scalar @links, 1);
84
85my $link4 = shift @links;
b0457415 86is($link4->id, 4, 'Link 4 id');
87is($link4->url, undef, 'Link 4 url');
88is($link4->title, 'dtitle', 'Link 4 title');
89
d0cefd99 90## variable size dataset
91@links = $schema->populate('Link', [
92[ qw/id title url/ ],
93[ 41 ],
94[ 42, undef, 'url42' ],
95]);
96is(scalar @links, 2);
97is($links[0]->url, undef);
98is($links[1]->url, 'url42');
b0457415 99
2a6dda4b 100## make sure populate -> _insert_bulk honors fields/orders in void context
89b2e3e4 101## schema order
102$schema->populate('Link', [
103[ qw/id url title/ ],
104[ qw/5 eurl etitle/ ]
105]);
106my $link5 = $schema->resultset('Link')->find(5);
107is($link5->id, 5, 'Link 5 id');
108is($link5->url, 'eurl', 'Link 5 url');
109is($link5->title, 'etitle', 'Link 5 title');
110
111## non-schema order
112$schema->populate('Link', [
113[ qw/id title url/ ],
114[ qw/6 ftitle furl/ ]
115]);
116my $link6 = $schema->resultset('Link')->find(6);
117is($link6->id, 6, 'Link 6 id');
118is($link6->url, 'furl', 'Link 6 url');
119is($link6->title, 'ftitle', 'Link 6 title');
120
121## not all physical columns
122$schema->populate('Link', [
123[ qw/id title/ ],
124[ qw/7 gtitle/ ]
125]);
126my $link7 = $schema->resultset('Link')->find(7);
127is($link7->id, 7, 'Link 7 id');
128is($link7->url, undef, 'Link 7 url');
129is($link7->title, 'gtitle', 'Link 7 title');
130
d0cefd99 131## variable size dataset in void ctx
132$schema->populate('Link', [
133[ qw/id title url/ ],
134[ 71 ],
135[ 72, undef, 'url72' ],
136]);
137@links = $schema->resultset('Link')->search({ id => [71, 72]}, { order_by => 'id' })->all;
138is(scalar @links, 2);
139is($links[0]->url, undef);
140is($links[1]->url, 'url72');
141
142## variable size dataset in void ctx, hash version
143$schema->populate('Link', [
144 { id => 73 },
145 { id => 74, title => 't74' },
146 { id => 75, url => 'u75' },
147]);
148@links = $schema->resultset('Link')->search({ id => [73..75]}, { order_by => 'id' })->all;
149is(scalar @links, 3);
150is($links[0]->url, undef);
151is($links[0]->title, undef);
152is($links[1]->url, undef);
153is($links[1]->title, 't74');
154is($links[2]->url, 'u75');
155is($links[2]->title, undef);
156
157## Make sure the void ctx trace is sane
158{
159 for (
160 [
161 [ qw/id title url/ ],
162 [ 81 ],
163 [ 82, 't82' ],
164 [ 83, undef, 'url83' ],
165 ],
166 [
167 { id => 91 },
168 { id => 92, title => 't92' },
169 { id => 93, url => 'url93' },
170 ]
171 ) {
172 $schema->is_executed_sql_bind(
173 sub {
174 $schema->populate('Link', $_);
175 },
176 [
177 [ 'BEGIN' ],
178 [
179 'INSERT INTO link( id, title, url ) VALUES( ?, ?, ? )',
180 "__BULK_INSERT__"
181 ],
182 [ 'COMMIT' ],
183 ]
184 );
185 }
186}
187
84f7e8a1 188# populate with literals
189{
190 my $rs = $schema->resultset('Link');
191 $rs->delete;
aac0bfd0 192
2a6dda4b 193 # test populate with all literal sql (no binds)
aac0bfd0 194
84f7e8a1 195 $rs->populate([
574d7df6 196 (+{
84f7e8a1 197 url => \"'cpan.org'",
198 title => \"'The ''best of'' cpan'",
574d7df6 199 }) x 5
84f7e8a1 200 ]);
574d7df6 201
84f7e8a1 202 is((grep {
203 $_->url eq 'cpan.org' &&
204 $_->title eq "The 'best of' cpan",
205 } $rs->all), 5, 'populate with all literal SQL');
bbd6f348 206
84f7e8a1 207 $rs->delete;
bbd6f348 208
84f7e8a1 209 # test mixed binds with literal sql
aac0bfd0 210
84f7e8a1 211 $rs->populate([
aac0bfd0 212 (+{
84f7e8a1 213 url => \"'cpan.org'",
214 title => "The 'best of' cpan",
aac0bfd0 215 }) x 5
84f7e8a1 216 ]);
aac0bfd0 217
84f7e8a1 218 is((grep {
219 $_->url eq 'cpan.org' &&
220 $_->title eq "The 'best of' cpan",
221 } $rs->all), 5, 'populate with all literal SQL');
aac0bfd0 222
84f7e8a1 223 $rs->delete;
224}
aac0bfd0 225
a9bac98f 226# populate with literal+bind
227{
228 my $rs = $schema->resultset('Link');
229 $rs->delete;
230
2a6dda4b 231 # test populate with all literal/bind sql
a9bac98f 232 $rs->populate([
233 (+{
234 url => \['?', [ {} => 'cpan.org' ] ],
235 title => \['?', [ {} => "The 'best of' cpan" ] ],
236 }) x 5
237 ]);
238
239 is((grep {
240 $_->url eq 'cpan.org' &&
241 $_->title eq "The 'best of' cpan",
242 } $rs->all), 5, 'populate with all literal/bind');
243
244 $rs->delete;
245
2a6dda4b 246 # test populate with mix literal and literal/bind
a9bac98f 247 $rs->populate([
248 (+{
249 url => \"'cpan.org'",
250 title => \['?', [ {} => "The 'best of' cpan" ] ],
251 }) x 5
252 ]);
253
254 is((grep {
255 $_->url eq 'cpan.org' &&
256 $_->title eq "The 'best of' cpan",
257 } $rs->all), 5, 'populate with all literal/bind SQL');
258
259 $rs->delete;
260
261 # test mixed binds with literal sql/bind
262
263 $rs->populate([ map { +{
90b2bd88 264 url => \[ '? || ?', [ {} => 'cpan.org_' ], $_ ],
a9bac98f 265 title => "The 'best of' cpan",
266 } } (1 .. 5) ]);
267
268 for (1 .. 5) {
269 ok($rs->find({ url => "cpan.org_$_" }), "Row $_ correctly created with dynamic literal/bind populate" );
270 }
271
272 $rs->delete;
273}
274
84f7e8a1 275my $rs = $schema->resultset('Artist');
276$rs->delete;
bbd6f348 277throws_ok {
a4c52abc 278 # this warning is correct, but we are not testing it here
279 # what we are after is the correct exception when an int
280 # fails to coerce into a sqlite rownum
281 local $SIG{__WARN__} = sigwarn_silencer( qr/datatype mismatch.+ foo as integer/ );
282
bbd6f348 283 $rs->populate([
284 {
285 artistid => 1,
286 name => 'foo1',
287 },
288 {
289 artistid => 'foo', # this dies
290 name => 'foo2',
291 },
292 {
293 artistid => 3,
294 name => 'foo3',
295 },
296 ]);
a4c52abc 297} qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice fails PK insert';
bbd6f348 298
299is($rs->count, 0, 'populate is atomic');
300
1295943f 301# Trying to use a column marked as a bind in the first slice with literal sql in
302# a later slice should throw.
303
304throws_ok {
305 $rs->populate([
306 {
307 artistid => 1,
308 name => \"'foo'",
309 },
310 {
311 artistid => \2,
312 name => \"'foo'",
313 }
314 ]);
f6faeab8 315} qr/Literal SQL found where a plain bind value is expected/, 'literal sql where bind expected throws';
1295943f 316
317# ... and vice-versa.
318
319throws_ok {
320 $rs->populate([
321 {
322 artistid => \1,
323 name => \"'foo'",
324 },
325 {
326 artistid => 2,
327 name => \"'foo'",
328 }
329 ]);
f6faeab8 330} qr/\QIncorrect value (expecting SCALAR-ref/, 'bind where literal sql expected throws';
1295943f 331
332throws_ok {
333 $rs->populate([
334 {
335 artistid => 1,
336 name => \"'foo'",
337 },
338 {
339 artistid => 2,
340 name => \"'bar'",
341 }
342 ]);
f6faeab8 343} qr/Inconsistent literal SQL value/, 'literal sql must be the same in all slices';
1295943f 344
a9bac98f 345throws_ok {
346 $rs->populate([
347 {
348 artistid => 1,
349 name => \['?', [ {} => 'foo' ] ],
350 },
351 {
352 artistid => 2,
353 name => \"'bar'",
354 }
355 ]);
356} qr/\QIncorrect value (expecting ARRAYREF-ref/, 'literal where literal+bind expected throws';
357
358throws_ok {
359 $rs->populate([
360 {
361 artistid => 1,
362 name => \['?', [ { sqlt_datatype => 'foooo' } => 'foo' ] ],
363 },
364 {
365 artistid => 2,
366 name => \['?', [ {} => 'foo' ] ],
367 }
368 ]);
369} qr/\QDiffering bind attributes on literal\/bind values not supported for column 'name'/, 'literal+bind with differing attrs throws';
370
371lives_ok {
372 $rs->populate([
373 {
374 artistid => 1,
375 name => \['?', [ undef, 'foo' ] ],
376 },
377 {
378 artistid => 2,
379 name => \['?', [ {} => 'bar' ] ],
380 }
381 ]);
382} 'literal+bind with semantically identical attrs works after normalization';
383
75a1d824 384# test all kinds of population with stringified objects
277e3014 385# or with empty sets
75a1d824 386warnings_like {
387 my $rs = $schema->resultset('Artist')->search({}, { columns => [qw(name rank)], order_by => 'artistid' });
388
389 # the stringification has nothing to do with the artist name
390 # this is solely for testing consistency
391 my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
392 my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
393 my $rank = Math::BigInt->new(42);
394
395 my $args = {
0a768c90 396 'stringifying objects after regular values' => { AoA => [
397 [qw( name rank )],
398 ( map { [ $_, $rank ] } (
75a1d824 399 'supplied before stringifying objects',
400 'supplied before stringifying objects 2',
401 $fn,
402 $fn2,
0a768c90 403 )),
404 ]},
405
406 'stringifying objects before regular values' => { AoA => [
407 [qw( rank name )],
408 ( map { [ $rank, $_ ] } (
75a1d824 409 $fn,
410 $fn2,
411 'supplied after stringifying objects',
412 'supplied after stringifying objects 2',
0a768c90 413 )),
414 ]},
415
416 'stringifying objects between regular values' => { AoA => [
417 [qw( name rank )],
418 ( map { [ $_, $rank ] } (
75a1d824 419 'supplied before stringifying objects',
420 $fn,
421 $fn2,
422 'supplied after stringifying objects',
0a768c90 423 ))
424 ]},
425
426 'stringifying objects around regular values' => { AoA => [
427 [qw( rank name )],
428 ( map { [ $rank, $_ ] } (
75a1d824 429 $fn,
430 'supplied between stringifying objects',
431 $fn2,
0a768c90 432 ))
433 ]},
434
435 'single stringifying object' => { AoA => [
436 [qw( rank name )],
437 [ $rank, $fn ],
438 ]},
277e3014 439
440 'empty set' => { AoA => [
441 [qw( name rank )],
442 ]},
75a1d824 443 };
444
0a768c90 445 # generate the AoH equivalent based on the AoAs above
446 for my $bag (values %$args) {
277e3014 447 $bag->{AoH} = [];
0a768c90 448 my @hdr = @{$bag->{AoA}[0]};
449 for my $v ( @{$bag->{AoA}}[1..$#{$bag->{AoA}}] ) {
450 push @{$bag->{AoH}}, my $h = {};
451 @{$h}{@hdr} = @$v;
452 }
453 }
75a1d824 454
0a768c90 455 local $Storable::canonical = 1;
1c30a2e4 456 my $preimage = serialize($args);
75a1d824 457
75a1d824 458
0a768c90 459 for my $tst (keys %$args) {
460 for my $type (qw(AoA AoH)) {
461
462 # test void ctx
463 $rs->delete;
464 $rs->populate($args->{$tst}{$type});
465 is_deeply(
466 $rs->all_hri,
467 $args->{$tst}{AoH},
468 "Populate() $tst in void context"
469 );
470
471 # test scalar ctx
472 $rs->delete;
473 my $dummy = $rs->populate($args->{$tst}{$type});
474 is_deeply(
475 $rs->all_hri,
476 $args->{$tst}{AoH},
477 "Populate() $tst in non-void context"
478 );
479
480 # test list ctx
481 $rs->delete;
482 my @dummy = $rs->populate($args->{$tst}{$type});
483 is_deeply(
484 $rs->all_hri,
485 $args->{$tst}{AoH},
486 "Populate() $tst in non-void context"
487 );
488 }
75a1d824 489
490 # test create() as we have everything set up already
491 $rs->delete;
0a768c90 492 $rs->create($_) for @{$args->{$tst}{AoH}};
75a1d824 493
494 is_deeply(
495 $rs->all_hri,
0a768c90 496 $args->{$tst}{AoH},
75a1d824 497 "Create() $tst"
498 );
499 }
8464d1a4 500
75a1d824 501 ok (
1c30a2e4 502 ($preimage eq serialize($args)),
75a1d824 503 'Arguments fed to populate()/create() unchanged'
504 );
8464d1a4 505
75a1d824 506 $rs->delete;
cff17b97 507} [], 'Data integrity warnings gone as planned';
8464d1a4 508
d0cefd99 509$schema->is_executed_sql_bind(
510 sub {
18d80024 511 $schema->resultset('TwoKeys')->populate([{
512 artist => 1,
513 cd => 5,
514 fourkeys_to_twokeys => [{
515 f_foo => 1,
516 f_bar => 1,
517 f_hello => 1,
518 f_goodbye => 1,
519 autopilot => 'a',
520 },{
521 f_foo => 2,
522 f_bar => 2,
523 f_hello => 2,
524 f_goodbye => 2,
525 autopilot => 'b',
526 }]
527 }])
d0cefd99 528 },
529 [
530 [ 'BEGIN' ],
531 [ 'INSERT INTO twokeys ( artist, cd)
532 VALUES ( ?, ? )',
533 '__BULK_INSERT__'
534 ],
535 [ 'INSERT INTO fourkeys_to_twokeys ( autopilot, f_bar, f_foo, f_goodbye, f_hello, t_artist, t_cd)
536 VALUES (
537 ?, ?, ?, ?, ?,
538 ( SELECT me.artist FROM twokeys me WHERE artist = ? AND cd = ? ),
539 ( SELECT me.cd FROM twokeys me WHERE artist = ? AND cd = ? )
540 )
541 ',
542 '__BULK_INSERT__'
543 ],
544 [ 'COMMIT' ],
545 ],
546 'multicol-PK has_many populate expected trace'
547);
18d80024 548
d6170b26 549lives_ok ( sub {
550 $schema->populate('CD', [
551 {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
552 ])
553}, 'empty has_many relationship accepted by populate');
554
bbd6f348 555done_testing;