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