## ---------------------------------------------------------------------------- ## Tests for the $resultset->populate method. ## ## GOALS: We need to test the method for both void and array context for all ## the following relationship types: belongs_to, has_many. Additionally we ## need to each each of those for both specified PK's and autogenerated PK's ## ## Also need to test some stuff that should generate errors. ## ---------------------------------------------------------------------------- use strict; use warnings; use Test::More; use lib qw(t/lib); use DBICTest; ## ---------------------------------------------------------------------------- ## Get a Schema and some ResultSets we can play with. ## ---------------------------------------------------------------------------- my $schema = DBICTest->init_schema(); my $art_rs = $schema->resultset('Artist'); my $cd_rs = $schema->resultset('CD'); my $restricted_art_rs = $art_rs->search({rank => 42}); ok( $schema, 'Got a Schema object'); ok( $art_rs, 'Got Good Artist Resultset'); ok( $cd_rs, 'Got Good CD Resultset'); ## ---------------------------------------------------------------------------- ## Schema populate Tests ## ---------------------------------------------------------------------------- SCHEMA_POPULATE1: { ## Test to make sure that the old $schema->populate is using the new method ## for $resultset->populate when in void context and with sub objects. $schema->populate('Artist', [ [qw/name cds/], ["001First Artist", [ {title=>"001Title1", year=>2000}, {title=>"001Title2", year=>2001}, {title=>"001Title3", year=>2002}, ]], ["002Second Artist", []], ["003Third Artist", [ {title=>"003Title1", year=>2005}, ]], [undef, [ {title=>"004Title1", year=>2010} ]], ]); isa_ok $schema, 'DBIx::Class::Schema'; my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({ name=>["001First Artist","002Second Artist","003Third Artist", undef]}, {order_by=>'name ASC'})->all; isa_ok $artist1, 'DBICTest::Artist'; isa_ok $artist2, 'DBICTest::Artist'; isa_ok $artist3, 'DBICTest::Artist'; isa_ok $undef, 'DBICTest::Artist'; ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001"; ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002"; ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003"; ok !defined $undef->name, "Got Expected Artist Name for Artist004"; ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1"; ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2"; ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3"; ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4"; ARTIST1CDS: { my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'}); isa_ok $cd1, 'DBICTest::CD'; isa_ok $cd2, 'DBICTest::CD'; isa_ok $cd3, 'DBICTest::CD'; ok $cd1->year == 2000; ok $cd2->year == 2001; ok $cd3->year == 2002; ok $cd1->title eq '001Title1'; ok $cd2->title eq '001Title2'; ok $cd3->title eq '001Title3'; } ARTIST3CDS: { my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'}); isa_ok $cd1, 'DBICTest::CD'; ok $cd1->year == 2005; ok $cd1->title eq '003Title1'; } ARTIST4CDS: { my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'}); isa_ok $cd1, 'DBICTest::CD'; ok $cd1->year == 2010; ok $cd1->title eq '004Title1'; } ## Need to do some cleanup so that later tests don't get borked $undef->delete; } ## ---------------------------------------------------------------------------- ## Array context tests ## ---------------------------------------------------------------------------- ARRAY_CONTEXT: { ## These first set of tests are cake because array context just delegates ## all it's processing to $resultset->create HAS_MANY_NO_PKS: { ## This first group of tests checks to make sure we can call populate ## with the parent having many children and let the keys be automatic my $artists = [ { name => 'Angsty-Whiny Girl', cds => [ { title => 'My First CD', year => 2006 }, { title => 'Yet More Tweeny-Pop crap', year => 2007 }, ], }, { name => 'Manufactured Crap', }, { name => 'Like I Give a Damn', cds => [ { title => 'My parents sold me to a record company' ,year => 2005 }, { title => 'Why Am I So Ugly?', year => 2006 }, { title => 'I Got Surgery and am now Popular', year => 2007 } ], }, { name => 'Formerly Named', cds => [ { title => 'One Hit Wonder', year => 2006 }, ], }, ]; ## Get the result row objects. my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); ## Do we have the right object? isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); ## Find the expected information? ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object"); ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object"); ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object"); ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object"); ## Create the expected children sub objects? ok( $crap->cds->count == 0, "got Expected Number of Cds"); ok( $girl->cds->count == 2, "got Expected Number of Cds"); ok( $damn->cds->count == 3, "got Expected Number of Cds"); ok( $formerly->cds->count == 1, "got Expected Number of Cds"); ## Did the cds get expected information? my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'}); ok( $cd1->title eq "My First CD", "Got Expected CD Title"); ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title"); } HAS_MANY_WITH_PKS: { ## This group tests the ability to specify the PK in the parent and let ## DBIC transparently pass the PK down to the Child and also let's the ## child create any other needed PK's for itself. my $aid = $art_rs->get_column('artistid')->max || 0; my $first_aid = ++$aid; my $artists = [ { artistid => $first_aid, name => 'PK_Angsty-Whiny Girl', cds => [ { artist => $first_aid, title => 'PK_My First CD', year => 2006 }, { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 }, ], }, { artistid => ++$aid, name => 'PK_Manufactured Crap', }, { artistid => ++$aid, name => 'PK_Like I Give a Damn', cds => [ { title => 'PK_My parents sold me to a record company' ,year => 2005 }, { title => 'PK_Why Am I So Ugly?', year => 2006 }, { title => 'PK_I Got Surgery and am now Popular', year => 2007 } ], }, { artistid => ++$aid, name => 'PK_Formerly Named', cds => [ { title => 'PK_One Hit Wonder', year => 2006 }, ], }, ]; ## Get the result row objects. my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists); ## Do we have the right object? isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); ## Find the expected information? ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object"); ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object"); ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object"); ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object"); ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object"); ## Create the expected children sub objects? ok( $crap->cds->count == 0, "got Expected Number of Cds"); ok( $girl->cds->count == 2, "got Expected Number of Cds"); ok( $damn->cds->count == 3, "got Expected Number of Cds"); ok( $formerly->cds->count == 1, "got Expected Number of Cds"); ## Did the cds get expected information? my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title"); ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); } BELONGS_TO_NO_PKs: { ## Test from a belongs_to perspective, should create artist first, ## then CD with artistid. This test we let the system automatically ## create the PK's. Chances are good you'll use it this way mostly. my $cds = [ { title => 'Some CD3', year => '1997', artist => { name => 'Fred BloggsC'}, }, { title => 'Some CD4', year => '1997', artist => { name => 'Fred BloggsD'}, }, ]; my ($cdA, $cdB) = $cd_rs->populate($cds); isa_ok($cdA, 'DBICTest::CD', 'Created CD'); isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); isa_ok($cdB, 'DBICTest::CD', 'Created CD'); isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); } BELONGS_TO_WITH_PKs: { ## Test from a belongs_to perspective, should create artist first, ## then CD with artistid. This time we try setting the PK's my $aid = $art_rs->get_column('artistid')->max || 0; my $cds = [ { title => 'Some CD3', year => '1997', artist => { artistid=> ++$aid, name => 'Fred BloggsC'}, }, { title => 'Some CD4', year => '1997', artist => { artistid=> ++$aid, name => 'Fred BloggsD'}, }, ]; my ($cdA, $cdB) = $cd_rs->populate($cds); isa_ok($cdA, 'DBICTest::CD', 'Created CD'); isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC'); isa_ok($cdB, 'DBICTest::CD', 'Created CD'); isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD'); ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); } WITH_COND_FROM_RS: { my ($more_crap) = $restricted_art_rs->populate([ { name => 'More Manufactured Crap', }, ]); ## Did it use the condition in the resultset? cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); } } ## ---------------------------------------------------------------------------- ## Void context tests ## ---------------------------------------------------------------------------- VOID_CONTEXT: { ## All these tests check the ability to use populate without asking for ## any returned resultsets. This uses bulk_insert as much as possible ## in order to increase speed. HAS_MANY_WITH_PKS: { ## This first group of tests checks to make sure we can call populate ## with the parent having many children and the parent PK is set my $aid = $art_rs->get_column('artistid')->max || 0; my $first_aid = ++$aid; my $artists = [ { artistid => $first_aid, name => 'VOID_PK_Angsty-Whiny Girl', cds => [ { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 }, { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 }, ], }, { artistid => ++$aid, name => 'VOID_PK_Manufactured Crap', }, { artistid => ++$aid, name => 'VOID_PK_Like I Give a Damn', cds => [ { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 }, { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 }, { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 } ], }, { artistid => ++$aid, name => 'VOID_PK_Formerly Named', cds => [ { title => 'VOID_PK_One Hit Wonder', year => 2006 }, ], }, { artistid => ++$aid, name => undef, cds => [ { title => 'VOID_PK_Zundef test', year => 2006 }, ], }, ]; ## Get the result row objects. $art_rs->populate($artists); my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search( {name=>[ map { $_->{name} } @$artists]}, {order_by=>'name ASC'}, ); ## Do we have the right object? isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'"); ## Find the expected information? ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object"); ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object"); ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object"); ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object"); ok( !defined $undef->name, "Got Correct name 'is undef' for result object"); ## Create the expected children sub objects? ok( $crap->can('cds'), "Has cds relationship"); ok( $girl->can('cds'), "Has cds relationship"); ok( $damn->can('cds'), "Has cds relationship"); ok( $formerly->can('cds'), "Has cds relationship"); ok( $undef->can('cds'), "Has cds relationship"); ok( $crap->cds->count == 0, "got Expected Number of Cds"); ok( $girl->cds->count == 2, "got Expected Number of Cds"); ok( $damn->cds->count == 3, "got Expected Number of Cds"); ok( $formerly->cds->count == 1, "got Expected Number of Cds"); ok( $undef->cds->count == 1, "got Expected Number of Cds"); ## Did the cds get expected information? my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title"); ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title"); } BELONGS_TO_WITH_PKs: { ## Test from a belongs_to perspective, should create artist first, ## then CD with artistid. This time we try setting the PK's my $aid = $art_rs->get_column('artistid')->max || 0; my $cds = [ { title => 'Some CD3B', year => '1997', artist => { artistid=> ++$aid, name => 'Fred BloggsCB'}, }, { title => 'Some CD4B', year => '1997', artist => { artistid=> ++$aid, name => 'Fred BloggsDB'}, }, ]; $cd_rs->populate($cds); my ($cdA, $cdB) = $cd_rs->search( {title=>[sort map {$_->{title}} @$cds]}, {order_by=>'title ASC'}, ); isa_ok($cdA, 'DBICTest::CD', 'Created CD'); isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB'); isa_ok($cdB, 'DBICTest::CD', 'Created CD'); isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB'); ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); } BELONGS_TO_NO_PKs: { ## Test from a belongs_to perspective, should create artist first, ## then CD with artistid. my $cds = [ { title => 'Some CD3BB', year => '1997', artist => { name => 'Fred BloggsCBB'}, }, { title => 'Some CD4BB', year => '1997', artist => { name => 'Fred BloggsDBB'}, }, { title => 'Some CD5BB', year => '1997', artist => { name => undef}, }, ]; $cd_rs->populate($cds); my ($cdA, $cdB, $cdC) = $cd_rs->search( {title=>[sort map {$_->{title}} @$cds]}, {order_by=>'title ASC'}, ); isa_ok($cdA, 'DBICTest::CD', 'Created CD'); isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist'); is($cdA->title, 'Some CD3BB', 'Found Expected title'); is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB'); isa_ok($cdB, 'DBICTest::CD', 'Created CD'); isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); is($cdB->title, 'Some CD4BB', 'Found Expected title'); is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB'); isa_ok($cdC, 'DBICTest::CD', 'Created CD'); isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist'); is($cdC->title, 'Some CD5BB', 'Found Expected title'); is( $cdC->artist->name, undef, 'Set Artist to something undefined'); } HAS_MANY_NO_PKS: { ## This first group of tests checks to make sure we can call populate ## with the parent having many children and let the keys be automatic my $artists = [ { name => 'VOID_Angsty-Whiny Girl', cds => [ { title => 'VOID_My First CD', year => 2006 }, { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 }, ], }, { name => 'VOID_Manufactured Crap', }, { name => 'VOID_Like I Give a Damn', cds => [ { title => 'VOID_My parents sold me to a record company' ,year => 2005 }, { title => 'VOID_Why Am I So Ugly?', year => 2006 }, { title => 'VOID_I Got Surgery and am now Popular', year => 2007 } ], }, { name => 'VOID_Formerly Named', cds => [ { title => 'VOID_One Hit Wonder', year => 2006 }, ], }, ]; ## Get the result row objects. $art_rs->populate($artists); my ($girl, $formerly, $damn, $crap) = $art_rs->search( {name=>[sort map {$_->{name}} @$artists]}, {order_by=>'name ASC'}, ); ## Do we have the right object? isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); ## Find the expected information? ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object"); ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object"); ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object"); ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object"); ## Create the expected children sub objects? ok( $crap->can('cds'), "Has cds relationship"); ok( $girl->can('cds'), "Has cds relationship"); ok( $damn->can('cds'), "Has cds relationship"); ok( $formerly->can('cds'), "Has cds relationship"); ok( $crap->cds->count == 0, "got Expected Number of Cds"); ok( $girl->cds->count == 2, "got Expected Number of Cds"); ok( $damn->cds->count == 3, "got Expected Number of Cds"); ok( $formerly->cds->count == 1, "got Expected Number of Cds"); ## Did the cds get expected information? my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'}); ok($cd1, "Got a got CD"); ok($cd2, "Got a got CD"); ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title"); ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title"); } WITH_COND_FROM_RS: { $restricted_art_rs->populate([ { name => 'VOID More Manufactured Crap', }, ]); my $more_crap = $art_rs->search({ name => 'VOID More Manufactured Crap' })->first; ## Did it use the condition in the resultset? cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); } } ARRAYREF_OF_ARRAYREF_STYLE: { $art_rs->populate([ [qw/artistid name/], [1000, 'A Formally Unknown Singer'], [1001, 'A singer that jumped the shark two albums ago'], [1002, 'An actually cool singer.'], ]); ok my $unknown = $art_rs->find(1000), "got Unknown"; ok my $jumped = $art_rs->find(1001), "got Jumped"; ok my $cool = $art_rs->find(1002), "got Cool"; is $unknown->name, 'A Formally Unknown Singer', 'Correct Name'; is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name'; is $cool->name, 'An actually cool singer.', 'Correct Name'; my ($cooler, $lamer) = $restricted_art_rs->populate([ [qw/artistid name/], [1003, 'Cooler'], [1004, 'Lamer'], ]); is $cooler->name, 'Cooler', 'Correct Name'; is $lamer->name, 'Lamer', 'Correct Name'; cmp_ok $cooler->rank, '==', 42, 'Correct Rank'; ARRAY_CONTEXT_WITH_COND_FROM_RS: { my ($mega_lamer) = $restricted_art_rs->populate([ { name => 'Mega Lamer', }, ]); ## Did it use the condition in the resultset? cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object"); } VOID_CONTEXT_WITH_COND_FROM_RS: { $restricted_art_rs->populate([ { name => 'VOID Mega Lamer', }, ]); my $mega_lamer = $art_rs->search({ name => 'VOID Mega Lamer' })->first; ## Did it use the condition in the resultset? cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object"); } } done_testing;