Commit | Line | Data |
54e0bd06 |
1 | use strict; |
d35a6fed |
2 | use warnings; |
54e0bd06 |
3 | |
4 | use Test::More; |
d35a6fed |
5 | use Test::Exception; |
75a1d824 |
6 | use Test::Warn; |
54e0bd06 |
7 | use lib qw(t/lib); |
8 | use DBICTest; |
a4c52abc |
9 | use DBIx::Class::_Util 'sigwarn_silencer'; |
c0d8cb1f |
10 | use Path::Class::File (); |
75a1d824 |
11 | use Math::BigInt; |
569b9fe6 |
12 | use List::Util qw/shuffle/; |
75a1d824 |
13 | use Storable qw/nfreeze dclone/; |
54e0bd06 |
14 | |
54e0bd06 |
15 | my $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 | |
25 | my $start_id = 'populateXaaaaaa'; |
569b9fe6 |
26 | my $rows = 10_000; |
d35a6fed |
27 | my $offset = 3; |
28 | |
569b9fe6 |
29 | $schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] ); |
d35a6fed |
30 | is ( |
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 | |
36 | my $artist = $schema->resultset ('Artist') |
37 | ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' }) |
38 | ->first; |
39 | my $ex_title = $artist->cds->first->title; |
40 | |
41 | throws_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 |
56 | my @links = $schema->populate('Link', [ |
b0457415 |
57 | [ qw/id url title/ ], |
58 | [ qw/2 burl btitle/ ] |
59 | ]); |
89b2e3e4 |
60 | is(scalar @links, 1); |
61 | |
62 | my $link2 = shift @links; |
b0457415 |
63 | is($link2->id, 2, 'Link 2 id'); |
64 | is($link2->url, 'burl', 'Link 2 url'); |
65 | is($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 |
72 | is(scalar @links, 1); |
73 | |
74 | my $link3 = shift @links; |
b0457415 |
75 | is($link3->id, 3, 'Link 3 id'); |
76 | is($link3->url, 'curl', 'Link 3 url'); |
77 | is($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 |
84 | is(scalar @links, 1); |
85 | |
86 | my $link4 = shift @links; |
b0457415 |
87 | is($link4->id, 4, 'Link 4 id'); |
88 | is($link4->url, undef, 'Link 4 url'); |
89 | is($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 | ]); |
97 | is(scalar @links, 2); |
98 | is($links[0]->url, undef); |
99 | is($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 | ]); |
107 | my $link5 = $schema->resultset('Link')->find(5); |
108 | is($link5->id, 5, 'Link 5 id'); |
109 | is($link5->url, 'eurl', 'Link 5 url'); |
110 | is($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 | ]); |
117 | my $link6 = $schema->resultset('Link')->find(6); |
118 | is($link6->id, 6, 'Link 6 id'); |
119 | is($link6->url, 'furl', 'Link 6 url'); |
120 | is($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 | ]); |
127 | my $link7 = $schema->resultset('Link')->find(7); |
128 | is($link7->id, 7, 'Link 7 id'); |
129 | is($link7->url, undef, 'Link 7 url'); |
130 | is($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; |
139 | is(scalar @links, 2); |
140 | is($links[0]->url, undef); |
141 | is($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; |
150 | is(scalar @links, 3); |
151 | is($links[0]->url, undef); |
152 | is($links[0]->title, undef); |
153 | is($links[1]->url, undef); |
154 | is($links[1]->title, 't74'); |
155 | is($links[2]->url, 'u75'); |
156 | is($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 |
276 | my $rs = $schema->resultset('Artist'); |
277 | $rs->delete; |
bbd6f348 |
278 | throws_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 | |
300 | is($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 | |
305 | throws_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 | |
320 | throws_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 | |
333 | throws_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 |
346 | throws_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 | |
359 | throws_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 | |
372 | lives_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 |
386 | warnings_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 |
528 | lives_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 |
534 | done_testing; |