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