Neither of these can fail now that we dep on 5.8.1 (missed in 55087b99)
[dbsrgits/DBIx-Class.git] / t / 101populate_rs.t
CommitLineData
e8aef98d 1## ----------------------------------------------------------------------------
2## Tests for the $resultset->populate method.
3##
4## GOALS: We need to test the method for both void and array context for all
5## the following relationship types: belongs_to, has_many. Additionally we
8b280eee 6## need to test each of those for both specified PK's and autogenerated PK's
e8aef98d 7##
8## Also need to test some stuff that should generate errors.
9## ----------------------------------------------------------------------------
10
81ab7888 11use strict;
12use warnings;
13
14use Test::More;
d0cefd99 15use Test::Warn;
277e3014 16use Test::Exception;
81ab7888 17use lib qw(t/lib);
18use DBICTest;
19
81ab7888 20
e8aef98d 21## ----------------------------------------------------------------------------
22## Get a Schema and some ResultSets we can play with.
23## ----------------------------------------------------------------------------
24
d7f20fdf 25my $schema = DBICTest->init_schema();
26my $art_rs = $schema->resultset('Artist');
27my $cd_rs = $schema->resultset('CD');
7ec05166 28
8d005ad9 29my $restricted_art_rs = $art_rs->search({ -and => [ rank => 42, charfield => { '=', \['(SELECT MAX(artistid) FROM artist) + ?', 6] } ] });
e8aef98d 30
31ok( $schema, 'Got a Schema object');
32ok( $art_rs, 'Got Good Artist Resultset');
33ok( $cd_rs, 'Got Good CD Resultset');
34
35
36## ----------------------------------------------------------------------------
8b93a938 37## Schema populate Tests
38## ----------------------------------------------------------------------------
39
7c325d53 40SCHEMA_POPULATE1: {
8b93a938 41
d0cefd99 42 # throw a monkey wrench
43 my $post_jnap_monkeywrench = $schema->resultset('Artist')->find(1)->update({ name => undef });
d7f20fdf 44
d0cefd99 45 warnings_exist { $schema->populate('Artist', [
d7f20fdf 46
47 [qw/name cds/],
48 ["001First Artist", [
49 {title=>"001Title1", year=>2000},
50 {title=>"001Title2", year=>2001},
51 {title=>"001Title3", year=>2002},
52 ]],
53 ["002Second Artist", []],
54 ["003Third Artist", [
55 {title=>"003Title1", year=>2005},
56 ]],
57 [undef, [
58 {title=>"004Title1", year=>2010}
59 ]],
d0cefd99 60 ]) } qr/\QFast-path populate() of non-uniquely identifiable rows with related data is not possible/;
d7f20fdf 61
62 isa_ok $schema, 'DBIx::Class::Schema';
63
d0cefd99 64 my ( $preexisting_undef, $artist1, $artist2, $artist3, $undef ) = $schema->resultset('Artist')->search({
d7f20fdf 65 name=>["001First Artist","002Second Artist","003Third Artist", undef]},
d0cefd99 66 {order_by => { -asc => 'artistid' }})->all;
d7f20fdf 67
68 isa_ok $artist1, 'DBICTest::Artist';
69 isa_ok $artist2, 'DBICTest::Artist';
70 isa_ok $artist3, 'DBICTest::Artist';
8273e845 71 isa_ok $undef, 'DBICTest::Artist';
d7f20fdf 72
73 ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
74 ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
75 ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
8273e845 76 ok !defined $undef->name, "Got Expected Artist Name for Artist004";
d7f20fdf 77
78 ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
79 ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
80 ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
8273e845 81 ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4";
d7f20fdf 82
d0cefd99 83 $post_jnap_monkeywrench->delete;
84
d7f20fdf 85 ARTIST1CDS: {
86
87 my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
88
89 isa_ok $cd1, 'DBICTest::CD';
90 isa_ok $cd2, 'DBICTest::CD';
91 isa_ok $cd3, 'DBICTest::CD';
92
93 ok $cd1->year == 2000;
94 ok $cd2->year == 2001;
95 ok $cd3->year == 2002;
96
97 ok $cd1->title eq '001Title1';
98 ok $cd2->title eq '001Title2';
99 ok $cd3->title eq '001Title3';
100 }
101
102 ARTIST3CDS: {
103
104 my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
105
106 isa_ok $cd1, 'DBICTest::CD';
107
108 ok $cd1->year == 2005;
109 ok $cd1->title eq '003Title1';
110 }
111
112 ARTIST4CDS: {
113
114 my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
115
116 isa_ok $cd1, 'DBICTest::CD';
117
118 ok $cd1->year == 2010;
119 ok $cd1->title eq '004Title1';
120 }
121
122 ## Need to do some cleanup so that later tests don't get borked
123
124 $undef->delete;
8b93a938 125}
126
127
128## ----------------------------------------------------------------------------
e8aef98d 129## Array context tests
130## ----------------------------------------------------------------------------
131
132ARRAY_CONTEXT: {
133
d7f20fdf 134 ## These first set of tests are cake because array context just delegates
3334d204 135 ## all its processing to $resultset->create
d7f20fdf 136
137 HAS_MANY_NO_PKS: {
138
139 ## This first group of tests checks to make sure we can call populate
140 ## with the parent having many children and let the keys be automatic
141
142 my $artists = [
143 {
144 name => 'Angsty-Whiny Girl',
145 cds => [
146 { title => 'My First CD', year => 2006 },
147 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
148 ],
149 },
150 {
151 name => 'Manufactured Crap',
152 },
153 {
154 name => 'Like I Give a Damn',
155 cds => [
156 { title => 'My parents sold me to a record company' ,year => 2005 },
157 { title => 'Why Am I So Ugly?', year => 2006 },
158 { title => 'I Got Surgery and am now Popular', year => 2007 }
159 ],
160 },
161 {
162 name => 'Formerly Named',
163 cds => [
164 { title => 'One Hit Wonder', year => 2006 },
165 ],
166 },
167 ];
168
169 ## Get the result row objects.
170
171 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
172
173 ## Do we have the right object?
174
175 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
176 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
8273e845 177 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
d7f20fdf 178 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
179
180 ## Find the expected information?
181
182 ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
183 ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
184 ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
185 ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
186
187 ## Create the expected children sub objects?
188
189 ok( $crap->cds->count == 0, "got Expected Number of Cds");
190 ok( $girl->cds->count == 2, "got Expected Number of Cds");
191 ok( $damn->cds->count == 3, "got Expected Number of Cds");
192 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
193
194 ## Did the cds get expected information?
195
196 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'});
197
198 ok( $cd1->title eq "My First CD", "Got Expected CD Title");
199 ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
200 }
201
202 HAS_MANY_WITH_PKS: {
203
204 ## This group tests the ability to specify the PK in the parent and let
205 ## DBIC transparently pass the PK down to the Child and also let's the
206 ## child create any other needed PK's for itself.
207
208 my $aid = $art_rs->get_column('artistid')->max || 0;
209
210 my $first_aid = ++$aid;
211
212 my $artists = [
213 {
214 artistid => $first_aid,
215 name => 'PK_Angsty-Whiny Girl',
216 cds => [
217 { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
218 { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
219 ],
220 },
221 {
222 artistid => ++$aid,
223 name => 'PK_Manufactured Crap',
224 },
225 {
226 artistid => ++$aid,
227 name => 'PK_Like I Give a Damn',
228 cds => [
229 { title => 'PK_My parents sold me to a record company' ,year => 2005 },
230 { title => 'PK_Why Am I So Ugly?', year => 2006 },
231 { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
232 ],
233 },
234 {
235 artistid => ++$aid,
236 name => 'PK_Formerly Named',
237 cds => [
238 { title => 'PK_One Hit Wonder', year => 2006 },
239 ],
240 },
241 ];
242
243 ## Get the result row objects.
244
245 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
246
247 ## Do we have the right object?
248
249 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
250 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
8273e845 251 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
d7f20fdf 252 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
253
254 ## Find the expected information?
255
256 ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
257 ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
258 ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
259 ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
260 ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
261
262 ## Create the expected children sub objects?
263
264 ok( $crap->cds->count == 0, "got Expected Number of Cds");
8273e845 265 ok( $girl->cds->count == 2, "got Expected Number of Cds");
d7f20fdf 266 ok( $damn->cds->count == 3, "got Expected Number of Cds");
267 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
268
269 ## Did the cds get expected information?
270
271 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
272
273 ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
274 ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
275 }
276
277 BELONGS_TO_NO_PKs: {
278
8273e845 279 ## Test from a belongs_to perspective, should create artist first,
d7f20fdf 280 ## then CD with artistid. This test we let the system automatically
281 ## create the PK's. Chances are good you'll use it this way mostly.
282
283 my $cds = [
284 {
285 title => 'Some CD3',
286 year => '1997',
287 artist => { name => 'Fred BloggsC'},
288 },
289 {
290 title => 'Some CD4',
291 year => '1997',
292 artist => { name => 'Fred BloggsD'},
8273e845 293 },
d7f20fdf 294 ];
295
296 my ($cdA, $cdB) = $cd_rs->populate($cds);
297
298
299 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
300 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
301 is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
302
303
304 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
305 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
306 is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
307 }
308
309 BELONGS_TO_WITH_PKs: {
310
8273e845 311 ## Test from a belongs_to perspective, should create artist first,
d7f20fdf 312 ## then CD with artistid. This time we try setting the PK's
313
314 my $aid = $art_rs->get_column('artistid')->max || 0;
315
316 my $cds = [
317 {
318 title => 'Some CD3',
319 year => '1997',
84f7e8a1 320 artist => { artistid=> ++$aid, name => 'Fred BloggsE'},
d7f20fdf 321 },
322 {
323 title => 'Some CD4',
324 year => '1997',
84f7e8a1 325 artist => { artistid=> ++$aid, name => 'Fred BloggsF'},
8273e845 326 },
d7f20fdf 327 ];
328
329 my ($cdA, $cdB) = $cd_rs->populate($cds);
330
331 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
332 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
84f7e8a1 333 is($cdA->artist->name, 'Fred BloggsE', 'Set Artist to FredE');
d7f20fdf 334
335 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
336 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
84f7e8a1 337 is($cdB->artist->name, 'Fred BloggsF', 'Set Artist to FredF');
d7f20fdf 338 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
339 }
7ec05166 340
341 WITH_COND_FROM_RS: {
d7f20fdf 342
7ec05166 343 my ($more_crap) = $restricted_art_rs->populate([
344 {
345 name => 'More Manufactured Crap',
346 },
347 ]);
d7f20fdf 348
7ec05166 349 ## Did it use the condition in the resultset?
8d005ad9 350 $more_crap->discard_changes;
7ec05166 351 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
8d005ad9 352 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
8273e845 353 }
e8aef98d 354}
71d496fe 355
71d496fe 356
e8aef98d 357## ----------------------------------------------------------------------------
358## Void context tests
359## ----------------------------------------------------------------------------
71d496fe 360
e8aef98d 361VOID_CONTEXT: {
71d496fe 362
8273e845 363 ## All these tests check the ability to use populate without asking for
d7f20fdf 364 ## any returned resultsets. This uses bulk_insert as much as possible
365 ## in order to increase speed.
366
367 HAS_MANY_WITH_PKS: {
368
369 ## This first group of tests checks to make sure we can call populate
370 ## with the parent having many children and the parent PK is set
371
372 my $aid = $art_rs->get_column('artistid')->max || 0;
373
374 my $first_aid = ++$aid;
375
376 my $artists = [
377 {
378 artistid => $first_aid,
379 name => 'VOID_PK_Angsty-Whiny Girl',
380 cds => [
381 { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
382 { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
383 ],
384 },
385 {
386 artistid => ++$aid,
387 name => 'VOID_PK_Manufactured Crap',
388 },
389 {
390 artistid => ++$aid,
391 name => 'VOID_PK_Like I Give a Damn',
392 cds => [
393 { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
394 { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
8273e845 395 { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
d7f20fdf 396 ],
397 },
398 {
399 artistid => ++$aid,
400 name => 'VOID_PK_Formerly Named',
401 cds => [
402 { title => 'VOID_PK_One Hit Wonder', year => 2006 },
403 ],
404 },
405 {
406 artistid => ++$aid,
407 name => undef,
408 cds => [
409 { title => 'VOID_PK_Zundef test', year => 2006 },
410 ],
411 },
412 ];
413
414 ## Get the result row objects.
415
416 $art_rs->populate($artists);
417
418 my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
419
420 {name=>[ map { $_->{name} } @$artists]},
421 {order_by=>'name ASC'},
422 );
423
424 ## Do we have the right object?
425
426 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
427 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
8273e845 428 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
429 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
430 isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'");
d7f20fdf 431
432 ## Find the expected information?
433
434 ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object");
435 ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
8273e845 436 ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
d7f20fdf 437 ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
8273e845 438 ok( !defined $undef->name, "Got Correct name 'is undef' for result object");
d7f20fdf 439
440 ## Create the expected children sub objects?
441 ok( $crap->can('cds'), "Has cds relationship");
442 ok( $girl->can('cds'), "Has cds relationship");
443 ok( $damn->can('cds'), "Has cds relationship");
444 ok( $formerly->can('cds'), "Has cds relationship");
8273e845 445 ok( $undef->can('cds'), "Has cds relationship");
d7f20fdf 446
447 ok( $crap->cds->count == 0, "got Expected Number of Cds");
8273e845 448 ok( $girl->cds->count == 2, "got Expected Number of Cds");
d7f20fdf 449 ok( $damn->cds->count == 3, "got Expected Number of Cds");
450 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
451 ok( $undef->cds->count == 1, "got Expected Number of Cds");
452
453 ## Did the cds get expected information?
454
455 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
456
457 ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
458 ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
459 }
460
461
462 BELONGS_TO_WITH_PKs: {
463
8273e845 464 ## Test from a belongs_to perspective, should create artist first,
d7f20fdf 465 ## then CD with artistid. This time we try setting the PK's
466
467 my $aid = $art_rs->get_column('artistid')->max || 0;
468
469 my $cds = [
470 {
471 title => 'Some CD3B',
472 year => '1997',
473 artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
474 },
475 {
476 title => 'Some CD4B',
477 year => '1997',
478 artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
479 },
480 ];
481
d0cefd99 482 warnings_exist {
483 $cd_rs->populate($cds)
484 } qr/\QFast-path populate() of belongs_to relationship data is not possible/;
d7f20fdf 485
486 my ($cdA, $cdB) = $cd_rs->search(
487 {title=>[sort map {$_->{title}} @$cds]},
488 {order_by=>'title ASC'},
489 );
490
491 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
492 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
493 is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
494
495 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
496 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
497 is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
498 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
499 }
500
501 BELONGS_TO_NO_PKs: {
502
8273e845 503 ## Test from a belongs_to perspective, should create artist first,
d7f20fdf 504 ## then CD with artistid.
505
506 my $cds = [
507 {
508 title => 'Some CD3BB',
509 year => '1997',
510 artist => { name => 'Fred BloggsCBB'},
511 },
512 {
513 title => 'Some CD4BB',
514 year => '1997',
515 artist => { name => 'Fred BloggsDBB'},
516 },
517 {
518 title => 'Some CD5BB',
519 year => '1997',
520 artist => { name => undef},
8273e845 521 },
d7f20fdf 522 ];
523
d0cefd99 524 warnings_exist {
525 $cd_rs->populate($cds);
526 } qr/\QFast-path populate() of belongs_to relationship data is not possible/;
d7f20fdf 527
528 my ($cdA, $cdB, $cdC) = $cd_rs->search(
529 {title=>[sort map {$_->{title}} @$cds]},
530 {order_by=>'title ASC'},
531 );
532
533 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
534 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
535 is($cdA->title, 'Some CD3BB', 'Found Expected title');
536 is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
537
538 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
539 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
540 is($cdB->title, 'Some CD4BB', 'Found Expected title');
541 is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
542
543 isa_ok($cdC, 'DBICTest::CD', 'Created CD');
544 isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist');
545 is($cdC->title, 'Some CD5BB', 'Found Expected title');
546 is( $cdC->artist->name, undef, 'Set Artist to something undefined');
547 }
548
549
550 HAS_MANY_NO_PKS: {
551
552 ## This first group of tests checks to make sure we can call populate
553 ## with the parent having many children and let the keys be automatic
554
555 my $artists = [
8273e845 556 {
d7f20fdf 557 name => 'VOID_Angsty-Whiny Girl',
558 cds => [
559 { title => 'VOID_My First CD', year => 2006 },
560 { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
8273e845 561 ],
562 },
d7f20fdf 563 {
564 name => 'VOID_Manufactured Crap',
565 },
566 {
567 name => 'VOID_Like I Give a Damn',
568 cds => [
569 { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
570 { title => 'VOID_Why Am I So Ugly?', year => 2006 },
8273e845 571 { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
d7f20fdf 572 ],
573 },
8273e845 574 {
d7f20fdf 575 name => 'VOID_Formerly Named',
576 cds => [
577 { title => 'VOID_One Hit Wonder', year => 2006 },
8273e845 578 ],
579 },
d7f20fdf 580 ];
581
582 ## Get the result row objects.
583
584 $art_rs->populate($artists);
585
586 my ($girl, $formerly, $damn, $crap) = $art_rs->search(
587 {name=>[sort map {$_->{name}} @$artists]},
588 {order_by=>'name ASC'},
589 );
590
591 ## Do we have the right object?
592
593 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
594 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
8273e845 595 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
596 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
d7f20fdf 597
598 ## Find the expected information?
599
600 ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
601 ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
8273e845 602 ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
d7f20fdf 603 ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
604
605 ## Create the expected children sub objects?
606 ok( $crap->can('cds'), "Has cds relationship");
607 ok( $girl->can('cds'), "Has cds relationship");
608 ok( $damn->can('cds'), "Has cds relationship");
609 ok( $formerly->can('cds'), "Has cds relationship");
610
611 ok( $crap->cds->count == 0, "got Expected Number of Cds");
8273e845 612 ok( $girl->cds->count == 2, "got Expected Number of Cds");
d7f20fdf 613 ok( $damn->cds->count == 3, "got Expected Number of Cds");
614 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
615
616 ## Did the cds get expected information?
617
618 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
619
620 ok($cd1, "Got a got CD");
621 ok($cd2, "Got a got CD");
622 ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
623 ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
624 }
d21161f5 625
7ec05166 626 WITH_COND_FROM_RS: {
d7f20fdf 627
7ec05166 628 $restricted_art_rs->populate([
629 {
630 name => 'VOID More Manufactured Crap',
631 },
632 ]);
633
634 my $more_crap = $art_rs->search({
635 name => 'VOID More Manufactured Crap'
636 })->first;
d7f20fdf 637
7ec05166 638 ## Did it use the condition in the resultset?
8d005ad9 639 $more_crap->discard_changes;
7ec05166 640 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
8d005ad9 641 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
8273e845 642 }
c4e67d31 643}
644
645ARRAYREF_OF_ARRAYREF_STYLE: {
7ec05166 646 $art_rs->populate([
c4e67d31 647 [qw/artistid name/],
648 [1000, 'A Formally Unknown Singer'],
649 [1001, 'A singer that jumped the shark two albums ago'],
650 [1002, 'An actually cool singer.'],
651 ]);
d7f20fdf 652
c4e67d31 653 ok my $unknown = $art_rs->find(1000), "got Unknown";
654 ok my $jumped = $art_rs->find(1001), "got Jumped";
655 ok my $cool = $art_rs->find(1002), "got Cool";
d7f20fdf 656
c4e67d31 657 is $unknown->name, 'A Formally Unknown Singer', 'Correct Name';
658 is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name';
659 is $cool->name, 'An actually cool singer.', 'Correct Name';
d7f20fdf 660
fa7a51af 661 my ($cooler, $lamer) = $restricted_art_rs->populate([
c4e67d31 662 [qw/artistid name/],
663 [1003, 'Cooler'],
8273e845 664 [1004, 'Lamer'],
c4e67d31 665 ]);
d7f20fdf 666
c4e67d31 667 is $cooler->name, 'Cooler', 'Correct Name';
8273e845 668 is $lamer->name, 'Lamer', 'Correct Name';
af928332 669
8d005ad9 670 for ($cooler, $lamer) {
671 $_->discard_changes;
672 cmp_ok( $_->rank, '==', 42, "Got Correct rank for result object");
673 cmp_ok( $_->charfield, '==', $_->id + 5, "Got Correct charfield for result object");
674 }
7ec05166 675
676 ARRAY_CONTEXT_WITH_COND_FROM_RS: {
d7f20fdf 677
7ec05166 678 my ($mega_lamer) = $restricted_art_rs->populate([
679 {
680 name => 'Mega Lamer',
681 },
682 ]);
683
684 ## Did it use the condition in the resultset?
8d005ad9 685 $mega_lamer->discard_changes;
7ec05166 686 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
8d005ad9 687 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
8273e845 688 }
7ec05166 689
690 VOID_CONTEXT_WITH_COND_FROM_RS: {
d7f20fdf 691
7ec05166 692 $restricted_art_rs->populate([
693 {
694 name => 'VOID Mega Lamer',
695 },
696 ]);
697
698 my $mega_lamer = $art_rs->search({
699 name => 'VOID Mega Lamer'
700 })->first;
d7f20fdf 701
7ec05166 702 ## Did it use the condition in the resultset?
703 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
8d005ad9 704 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
d7f20fdf 705 }
af928332 706}
fa238f1f 707
277e3014 708EMPTY_POPULATE: {
709 foreach(
710 [ empty => [] ],
711 [ columns_only => [ [qw(name rank charfield)] ] ],
712 ) {
713 my ($desc, $arg) = @{$_};
714
715 $schema->is_executed_sql_bind( sub {
716
717 my $rs = $art_rs;
718 lives_ok { $rs->populate($arg); 1 } "$desc populate in void context lives";
719
720 my @r = $art_rs->populate($arg);
721 is_deeply( \@r, [], "$desc populate in list context returns empty list" );
722
723 my $r = $art_rs->populate($arg);
724 is( $r, undef, "$desc populate in scalar context returns undef" );
725
726 }, [], "$desc populate executed no statements" );
727 }
728}
ce855fff 729
fa238f1f 730done_testing;