1 ## ----------------------------------------------------------------------------
2 ## Tests for the $resultset->populate method.
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
6 ## need to test each of those for both specified PK's and autogenerated PK's
8 ## Also need to test some stuff that should generate errors.
9 ## ----------------------------------------------------------------------------
19 ## ----------------------------------------------------------------------------
20 ## Get a Schema and some ResultSets we can play with.
21 ## ----------------------------------------------------------------------------
23 my $schema = DBICTest->init_schema();
24 my $art_rs = $schema->resultset('Artist');
25 my $cd_rs = $schema->resultset('CD');
27 my $restricted_art_rs = $art_rs->search({ -and => [ rank => 42, charfield => { '=', \['(SELECT MAX(artistid) FROM artist) + ?', 6] } ] });
29 ok( $schema, 'Got a Schema object');
30 ok( $art_rs, 'Got Good Artist Resultset');
31 ok( $cd_rs, 'Got Good CD Resultset');
34 ## ----------------------------------------------------------------------------
35 ## Schema populate Tests
36 ## ----------------------------------------------------------------------------
40 ## Test to make sure that the old $schema->populate is using the new method
41 ## for $resultset->populate when in void context and with sub objects.
43 $schema->populate('Artist', [
47 {title=>"001Title1", year=>2000},
48 {title=>"001Title2", year=>2001},
49 {title=>"001Title3", year=>2002},
51 ["002Second Artist", []],
53 {title=>"003Title1", year=>2005},
56 {title=>"004Title1", year=>2010}
60 isa_ok $schema, 'DBIx::Class::Schema';
62 my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({
63 name=>["001First Artist","002Second Artist","003Third Artist", undef]},
64 {order_by=>'name ASC'})->all;
66 isa_ok $artist1, 'DBICTest::Artist';
67 isa_ok $artist2, 'DBICTest::Artist';
68 isa_ok $artist3, 'DBICTest::Artist';
69 isa_ok $undef, 'DBICTest::Artist';
71 ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
72 ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
73 ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
74 ok !defined $undef->name, "Got Expected Artist Name for Artist004";
76 ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
77 ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
78 ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
79 ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4";
83 my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
85 isa_ok $cd1, 'DBICTest::CD';
86 isa_ok $cd2, 'DBICTest::CD';
87 isa_ok $cd3, 'DBICTest::CD';
89 ok $cd1->year == 2000;
90 ok $cd2->year == 2001;
91 ok $cd3->year == 2002;
93 ok $cd1->title eq '001Title1';
94 ok $cd2->title eq '001Title2';
95 ok $cd3->title eq '001Title3';
100 my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
102 isa_ok $cd1, 'DBICTest::CD';
104 ok $cd1->year == 2005;
105 ok $cd1->title eq '003Title1';
110 my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
112 isa_ok $cd1, 'DBICTest::CD';
114 ok $cd1->year == 2010;
115 ok $cd1->title eq '004Title1';
118 ## Need to do some cleanup so that later tests don't get borked
124 ## ----------------------------------------------------------------------------
125 ## Array context tests
126 ## ----------------------------------------------------------------------------
130 ## These first set of tests are cake because array context just delegates
131 ## all its processing to $resultset->create
135 ## This first group of tests checks to make sure we can call populate
136 ## with the parent having many children and let the keys be automatic
140 name => 'Angsty-Whiny Girl',
142 { title => 'My First CD', year => 2006 },
143 { title => 'Yet More Tweeny-Pop crap', year => 2007 },
147 name => 'Manufactured Crap',
150 name => 'Like I Give a Damn',
152 { title => 'My parents sold me to a record company' ,year => 2005 },
153 { title => 'Why Am I So Ugly?', year => 2006 },
154 { title => 'I Got Surgery and am now Popular', year => 2007 }
158 name => 'Formerly Named',
160 { title => 'One Hit Wonder', year => 2006 },
165 ## Get the result row objects.
167 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
169 ## Do we have the right object?
171 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
172 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
173 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
174 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
176 ## Find the expected information?
178 ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
179 ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
180 ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
181 ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
183 ## Create the expected children sub objects?
185 ok( $crap->cds->count == 0, "got Expected Number of Cds");
186 ok( $girl->cds->count == 2, "got Expected Number of Cds");
187 ok( $damn->cds->count == 3, "got Expected Number of Cds");
188 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
190 ## Did the cds get expected information?
192 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'});
194 ok( $cd1->title eq "My First CD", "Got Expected CD Title");
195 ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
200 ## This group tests the ability to specify the PK in the parent and let
201 ## DBIC transparently pass the PK down to the Child and also let's the
202 ## child create any other needed PK's for itself.
204 my $aid = $art_rs->get_column('artistid')->max || 0;
206 my $first_aid = ++$aid;
210 artistid => $first_aid,
211 name => 'PK_Angsty-Whiny Girl',
213 { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
214 { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
219 name => 'PK_Manufactured Crap',
223 name => 'PK_Like I Give a Damn',
225 { title => 'PK_My parents sold me to a record company' ,year => 2005 },
226 { title => 'PK_Why Am I So Ugly?', year => 2006 },
227 { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
232 name => 'PK_Formerly Named',
234 { title => 'PK_One Hit Wonder', year => 2006 },
239 ## Get the result row objects.
241 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
243 ## Do we have the right object?
245 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
246 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
247 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
248 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
250 ## Find the expected information?
252 ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
253 ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
254 ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
255 ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
256 ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
258 ## Create the expected children sub objects?
260 ok( $crap->cds->count == 0, "got Expected Number of Cds");
261 ok( $girl->cds->count == 2, "got Expected Number of Cds");
262 ok( $damn->cds->count == 3, "got Expected Number of Cds");
263 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
265 ## Did the cds get expected information?
267 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
269 ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
270 ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
275 ## Test from a belongs_to perspective, should create artist first,
276 ## then CD with artistid. This test we let the system automatically
277 ## create the PK's. Chances are good you'll use it this way mostly.
283 artist => { name => 'Fred BloggsC'},
288 artist => { name => 'Fred BloggsD'},
292 my ($cdA, $cdB) = $cd_rs->populate($cds);
295 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
296 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
297 is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
300 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
301 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
302 is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
305 BELONGS_TO_WITH_PKs: {
307 ## Test from a belongs_to perspective, should create artist first,
308 ## then CD with artistid. This time we try setting the PK's
310 my $aid = $art_rs->get_column('artistid')->max || 0;
316 artist => { artistid=> ++$aid, name => 'Fred BloggsE'},
321 artist => { artistid=> ++$aid, name => 'Fred BloggsF'},
325 my ($cdA, $cdB) = $cd_rs->populate($cds);
327 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
328 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
329 is($cdA->artist->name, 'Fred BloggsE', 'Set Artist to FredE');
331 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
332 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
333 is($cdB->artist->name, 'Fred BloggsF', 'Set Artist to FredF');
334 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
339 my ($more_crap) = $restricted_art_rs->populate([
341 name => 'More Manufactured Crap',
345 ## Did it use the condition in the resultset?
346 $more_crap->discard_changes;
347 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
348 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
353 ## ----------------------------------------------------------------------------
354 ## Void context tests
355 ## ----------------------------------------------------------------------------
359 ## All these tests check the ability to use populate without asking for
360 ## any returned resultsets. This uses bulk_insert as much as possible
361 ## in order to increase speed.
365 ## This first group of tests checks to make sure we can call populate
366 ## with the parent having many children and the parent PK is set
368 my $aid = $art_rs->get_column('artistid')->max || 0;
370 my $first_aid = ++$aid;
374 artistid => $first_aid,
375 name => 'VOID_PK_Angsty-Whiny Girl',
377 { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
378 { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
383 name => 'VOID_PK_Manufactured Crap',
387 name => 'VOID_PK_Like I Give a Damn',
389 { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
390 { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
391 { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
396 name => 'VOID_PK_Formerly Named',
398 { title => 'VOID_PK_One Hit Wonder', year => 2006 },
405 { title => 'VOID_PK_Zundef test', year => 2006 },
410 ## Get the result row objects.
412 $art_rs->populate($artists);
414 my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
416 {name=>[ map { $_->{name} } @$artists]},
417 {order_by=>'name ASC'},
420 ## Do we have the right object?
422 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
423 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
424 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
425 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
426 isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'");
428 ## Find the expected information?
430 ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object");
431 ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
432 ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
433 ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
434 ok( !defined $undef->name, "Got Correct name 'is undef' for result object");
436 ## Create the expected children sub objects?
437 ok( $crap->can('cds'), "Has cds relationship");
438 ok( $girl->can('cds'), "Has cds relationship");
439 ok( $damn->can('cds'), "Has cds relationship");
440 ok( $formerly->can('cds'), "Has cds relationship");
441 ok( $undef->can('cds'), "Has cds relationship");
443 ok( $crap->cds->count == 0, "got Expected Number of Cds");
444 ok( $girl->cds->count == 2, "got Expected Number of Cds");
445 ok( $damn->cds->count == 3, "got Expected Number of Cds");
446 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
447 ok( $undef->cds->count == 1, "got Expected Number of Cds");
449 ## Did the cds get expected information?
451 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
453 ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
454 ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
458 BELONGS_TO_WITH_PKs: {
460 ## Test from a belongs_to perspective, should create artist first,
461 ## then CD with artistid. This time we try setting the PK's
463 my $aid = $art_rs->get_column('artistid')->max || 0;
467 title => 'Some CD3B',
469 artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
472 title => 'Some CD4B',
474 artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
478 $cd_rs->populate($cds);
480 my ($cdA, $cdB) = $cd_rs->search(
481 {title=>[sort map {$_->{title}} @$cds]},
482 {order_by=>'title ASC'},
485 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
486 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
487 is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
489 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
490 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
491 is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
492 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
497 ## Test from a belongs_to perspective, should create artist first,
498 ## then CD with artistid.
502 title => 'Some CD3BB',
504 artist => { name => 'Fred BloggsCBB'},
507 title => 'Some CD4BB',
509 artist => { name => 'Fred BloggsDBB'},
512 title => 'Some CD5BB',
514 artist => { name => undef},
518 $cd_rs->populate($cds);
520 my ($cdA, $cdB, $cdC) = $cd_rs->search(
521 {title=>[sort map {$_->{title}} @$cds]},
522 {order_by=>'title ASC'},
525 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
526 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
527 is($cdA->title, 'Some CD3BB', 'Found Expected title');
528 is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
530 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
531 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
532 is($cdB->title, 'Some CD4BB', 'Found Expected title');
533 is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
535 isa_ok($cdC, 'DBICTest::CD', 'Created CD');
536 isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist');
537 is($cdC->title, 'Some CD5BB', 'Found Expected title');
538 is( $cdC->artist->name, undef, 'Set Artist to something undefined');
544 ## This first group of tests checks to make sure we can call populate
545 ## with the parent having many children and let the keys be automatic
549 name => 'VOID_Angsty-Whiny Girl',
551 { title => 'VOID_My First CD', year => 2006 },
552 { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
556 name => 'VOID_Manufactured Crap',
559 name => 'VOID_Like I Give a Damn',
561 { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
562 { title => 'VOID_Why Am I So Ugly?', year => 2006 },
563 { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
567 name => 'VOID_Formerly Named',
569 { title => 'VOID_One Hit Wonder', year => 2006 },
574 ## Get the result row objects.
576 $art_rs->populate($artists);
578 my ($girl, $formerly, $damn, $crap) = $art_rs->search(
579 {name=>[sort map {$_->{name}} @$artists]},
580 {order_by=>'name ASC'},
583 ## Do we have the right object?
585 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
586 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
587 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
588 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
590 ## Find the expected information?
592 ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
593 ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
594 ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
595 ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
597 ## Create the expected children sub objects?
598 ok( $crap->can('cds'), "Has cds relationship");
599 ok( $girl->can('cds'), "Has cds relationship");
600 ok( $damn->can('cds'), "Has cds relationship");
601 ok( $formerly->can('cds'), "Has cds relationship");
603 ok( $crap->cds->count == 0, "got Expected Number of Cds");
604 ok( $girl->cds->count == 2, "got Expected Number of Cds");
605 ok( $damn->cds->count == 3, "got Expected Number of Cds");
606 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
608 ## Did the cds get expected information?
610 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
612 ok($cd1, "Got a got CD");
613 ok($cd2, "Got a got CD");
614 ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
615 ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
620 $restricted_art_rs->populate([
622 name => 'VOID More Manufactured Crap',
626 my $more_crap = $art_rs->search({
627 name => 'VOID More Manufactured Crap'
630 ## Did it use the condition in the resultset?
631 $more_crap->discard_changes;
632 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
633 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object");
637 ARRAYREF_OF_ARRAYREF_STYLE: {
640 [1000, 'A Formally Unknown Singer'],
641 [1001, 'A singer that jumped the shark two albums ago'],
642 [1002, 'An actually cool singer.'],
645 ok my $unknown = $art_rs->find(1000), "got Unknown";
646 ok my $jumped = $art_rs->find(1001), "got Jumped";
647 ok my $cool = $art_rs->find(1002), "got Cool";
649 is $unknown->name, 'A Formally Unknown Singer', 'Correct Name';
650 is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name';
651 is $cool->name, 'An actually cool singer.', 'Correct Name';
653 my ($cooler, $lamer) = $restricted_art_rs->populate([
659 is $cooler->name, 'Cooler', 'Correct Name';
660 is $lamer->name, 'Lamer', 'Correct Name';
662 for ($cooler, $lamer) {
664 cmp_ok( $_->rank, '==', 42, "Got Correct rank for result object");
665 cmp_ok( $_->charfield, '==', $_->id + 5, "Got Correct charfield for result object");
668 ARRAY_CONTEXT_WITH_COND_FROM_RS: {
670 my ($mega_lamer) = $restricted_art_rs->populate([
672 name => 'Mega Lamer',
676 ## Did it use the condition in the resultset?
677 $mega_lamer->discard_changes;
678 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
679 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
682 VOID_CONTEXT_WITH_COND_FROM_RS: {
684 $restricted_art_rs->populate([
686 name => 'VOID Mega Lamer',
690 my $mega_lamer = $art_rs->search({
691 name => 'VOID Mega Lamer'
694 ## Did it use the condition in the resultset?
695 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
696 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object");
700 ok(eval { $art_rs->populate([]); 1 }, "Empty populate runs but does nothing");