9 use DBIx::Class::_Util 'sigwarn_silencer';
10 use Path::Class::File ();
12 use List::Util qw/shuffle/;
13 use Storable qw/nfreeze dclone/;
15 my $schema = DBICTest->init_schema();
17 # The map below generates stuff like:
18 # [ qw/artistid name/ ],
25 my $start_id = 'populateXaaaaaa';
29 $schema->populate('Artist', [ [ qw/artistid name/ ], map { [ ($_ + $offset) => $start_id++ ] } shuffle ( 1 .. $rows ) ] );
31 $schema->resultset ('Artist')->search ({ name => { -like => 'populateX%' } })->count,
33 'populate created correct number of rows with massive AoA bulk insert',
36 my $artist = $schema->resultset ('Artist')
37 ->search ({ 'cds.title' => { '!=', undef } }, { join => 'cds' })
39 my $ex_title = $artist->cds->first->title;
43 $schema->populate('CD', [
46 artist => $artist->id,
50 } ('Huey', 'Dewey', $ex_title, 'Louie')
52 }, qr/\Qexecute_for_fetch() aborted with '\E.+ at populate slice.+$ex_title/ms, 'Readable exception thrown for failed populate');
54 ## make sure populate honors fields/orders in list context
56 my @links = $schema->populate('Link', [
62 my $link2 = shift @links;
63 is($link2->id, 2, 'Link 2 id');
64 is($link2->url, 'burl', 'Link 2 url');
65 is($link2->title, 'btitle', 'Link 2 title');
68 @links = $schema->populate('Link', [
74 my $link3 = shift @links;
75 is($link3->id, 3, 'Link 3 id');
76 is($link3->url, 'curl', 'Link 3 url');
77 is($link3->title, 'ctitle', 'Link 3 title');
79 ## not all physical columns
80 @links = $schema->populate('Link', [
86 my $link4 = shift @links;
87 is($link4->id, 4, 'Link 4 id');
88 is($link4->url, undef, 'Link 4 url');
89 is($link4->title, 'dtitle', 'Link 4 title');
91 ## variable size dataset
92 @links = $schema->populate('Link', [
95 [ 42, undef, 'url42' ],
98 is($links[0]->url, undef);
99 is($links[1]->url, 'url42');
101 ## make sure populate -> _insert_bulk honors fields/orders in void context
103 $schema->populate('Link', [
104 [ qw/id url title/ ],
105 [ qw/5 eurl etitle/ ]
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');
113 $schema->populate('Link', [
114 [ qw/id title url/ ],
115 [ qw/6 ftitle furl/ ]
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');
122 ## not all physical columns
123 $schema->populate('Link', [
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');
132 ## variable size dataset in void ctx
133 $schema->populate('Link', [
134 [ qw/id title url/ ],
136 [ 72, undef, 'url72' ],
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');
143 ## variable size dataset in void ctx, hash version
144 $schema->populate('Link', [
146 { id => 74, title => 't74' },
147 { id => 75, url => 'u75' },
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);
158 ## Make sure the void ctx trace is sane
162 [ qw/id title url/ ],
165 [ 83, undef, 'url83' ],
169 { id => 92, title => 't92' },
170 { id => 93, url => 'url93' },
173 $schema->is_executed_sql_bind(
175 $schema->populate('Link', $_);
180 'INSERT INTO link( id, title, url ) VALUES( ?, ?, ? )',
189 # populate with literals
191 my $rs = $schema->resultset('Link');
194 # test populate with all literal sql (no binds)
198 url => \"'cpan.org'",
199 title => \"'The ''best of'' cpan'",
204 $_->url eq 'cpan.org' &&
205 $_->title eq "The 'best of' cpan",
206 } $rs->all), 5, 'populate with all literal SQL');
210 # test mixed binds with literal sql
214 url => \"'cpan.org'",
215 title => "The 'best of' cpan",
220 $_->url eq 'cpan.org' &&
221 $_->title eq "The 'best of' cpan",
222 } $rs->all), 5, 'populate with all literal SQL');
227 # populate with literal+bind
229 my $rs = $schema->resultset('Link');
232 # test populate with all literal/bind sql
235 url => \['?', [ {} => 'cpan.org' ] ],
236 title => \['?', [ {} => "The 'best of' cpan" ] ],
241 $_->url eq 'cpan.org' &&
242 $_->title eq "The 'best of' cpan",
243 } $rs->all), 5, 'populate with all literal/bind');
247 # test populate with mix literal and literal/bind
250 url => \"'cpan.org'",
251 title => \['?', [ {} => "The 'best of' cpan" ] ],
256 $_->url eq 'cpan.org' &&
257 $_->title eq "The 'best of' cpan",
258 } $rs->all), 5, 'populate with all literal/bind SQL');
262 # test mixed binds with literal sql/bind
264 $rs->populate([ map { +{
265 url => \[ '? || ?', [ {} => 'cpan.org_' ], $_ ],
266 title => "The 'best of' cpan",
270 ok($rs->find({ url => "cpan.org_$_" }), "Row $_ correctly created with dynamic literal/bind populate" );
276 my $rs = $schema->resultset('Artist');
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/ );
290 artistid => 'foo', # this dies
298 } qr/\Qexecute_for_fetch() aborted with 'datatype mismatch\E\b/, 'bad slice fails PK insert';
300 is($rs->count, 0, 'populate is atomic');
302 # Trying to use a column marked as a bind in the first slice with literal sql in
303 # a later slice should throw.
316 } qr/Literal SQL found where a plain bind value is expected/, 'literal sql where bind expected throws';
318 # ... and vice-versa.
331 } qr/\QIncorrect value (expecting SCALAR-ref/, 'bind where literal sql expected throws';
344 } qr/Inconsistent literal SQL value/, 'literal sql must be the same in all slices';
350 name => \['?', [ {} => 'foo' ] ],
357 } qr/\QIncorrect value (expecting ARRAYREF-ref/, 'literal where literal+bind expected throws';
363 name => \['?', [ { sqlt_datatype => 'foooo' } => 'foo' ] ],
367 name => \['?', [ {} => 'foo' ] ],
370 } qr/\QDiffering bind attributes on literal\/bind values not supported for column 'name'/, 'literal+bind with differing attrs throws';
376 name => \['?', [ undef, 'foo' ] ],
380 name => \['?', [ {} => 'bar' ] ],
383 } 'literal+bind with semantically identical attrs works after normalization';
385 # test all kinds of population with stringified objects
388 my $rs = $schema->resultset('Artist')->search({}, { columns => [qw(name rank)], order_by => 'artistid' });
390 # the stringification has nothing to do with the artist name
391 # this is solely for testing consistency
392 my $fn = Path::Class::File->new ('somedir/somefilename.tmp');
393 my $fn2 = Path::Class::File->new ('somedir/someotherfilename.tmp');
394 my $rank = Math::BigInt->new(42);
397 'stringifying objects after regular values' => { AoA => [
399 ( map { [ $_, $rank ] } (
400 'supplied before stringifying objects',
401 'supplied before stringifying objects 2',
407 'stringifying objects before regular values' => { AoA => [
409 ( map { [ $rank, $_ ] } (
412 'supplied after stringifying objects',
413 'supplied after stringifying objects 2',
417 'stringifying objects between regular values' => { AoA => [
419 ( map { [ $_, $rank ] } (
420 'supplied before stringifying objects',
423 'supplied after stringifying objects',
427 'stringifying objects around regular values' => { AoA => [
429 ( map { [ $rank, $_ ] } (
431 'supplied between stringifying objects',
436 'single stringifying object' => { AoA => [
441 'empty set' => { AoA => [
446 # generate the AoH equivalent based on the AoAs above
447 for my $bag (values %$args) {
449 my @hdr = @{$bag->{AoA}[0]};
450 for my $v ( @{$bag->{AoA}}[1..$#{$bag->{AoA}}] ) {
451 push @{$bag->{AoH}}, my $h = {};
456 local $Storable::canonical = 1;
457 my $preimage = nfreeze($args);
460 for my $tst (keys %$args) {
461 for my $type (qw(AoA AoH)) {
465 $rs->populate($args->{$tst}{$type});
469 "Populate() $tst in void context"
474 my $dummy = $rs->populate($args->{$tst}{$type});
478 "Populate() $tst in non-void context"
483 my @dummy = $rs->populate($args->{$tst}{$type});
487 "Populate() $tst in non-void context"
491 # test create() as we have everything set up already
493 $rs->create($_) for @{$args->{$tst}{AoH}};
503 ($preimage eq nfreeze($args)),
504 'Arguments fed to populate()/create() unchanged'
508 } [], 'Data integrity warnings gone as planned';
510 $schema->is_executed_sql_bind(
512 $schema->resultset('TwoKeys')->populate([{
515 fourkeys_to_twokeys => [{
532 [ 'INSERT INTO twokeys ( artist, cd)
536 [ 'INSERT INTO fourkeys_to_twokeys ( autopilot, f_bar, f_foo, f_goodbye, f_hello, t_artist, t_cd)
539 ( SELECT me.artist FROM twokeys me WHERE artist = ? AND cd = ? ),
540 ( SELECT me.cd FROM twokeys me WHERE artist = ? AND cd = ? )
547 'multicol-PK has_many populate expected trace'
551 $schema->populate('CD', [
552 {cdid => 10001, artist => $artist->id, title => 'Pretty Much Empty', year => 2011, tracks => []},
554 }, 'empty has_many relationship accepted by populate');