+## ----------------------------------------------------------------------------
+## 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 lib qw(t/lib);
use DBICTest;
-plan tests => 25;
+plan tests => 98;
+
+
+## ----------------------------------------------------------------------------
+## 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 $schema = DBICTest->init_schema();
-my $rs = $schema->resultset('Artist');
+ok( $schema, 'Got a Schema object');
+ok( $art_rs, 'Got Good Artist Resultset');
+ok( $cd_rs, 'Got Good CD Resultset');
-RETURN_RESULTSETS: {
- my ($crap, $girl, $damn) = $rs->populate( [
- { artistid => 4, name => 'Manufactured Crap', cds => [
- { title => 'My First CD', year => 2006 },
- { title => 'Yet More Tweeny-Pop crap', year => 2007 },
- ]
- },
- { artistid => 5, name => 'Angsty-Whiny Girl', 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 }
+## ----------------------------------------------------------------------------
+## Array context tests
+## ----------------------------------------------------------------------------
- ]
- },
- { artistid=>6, name => 'Like I Give a Damn' }
+ARRAY_CONTEXT: {
- ] );
+ ## These first set of tests are cake because array context just delegates
+ ## all it's processing to $resultset->create
- isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
+ HAS_MANY_NO_PKS: {
- 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");
+ ## 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 ASC'});
+
+ ok( $cd1->title eq "My First CD", "Got Expected CD Title");
+ ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
+ }
- use Data::Dump qw/dump/;
+ HAS_MANY_WITH_PKS: {
- ok( $crap->cds->count == 2, "got Expected Number of Cds");
- ok( $girl->cds->count == 3, "got Expected Number of Cds");
-}
+ ## 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?
-RETURN_VOID: {
+ 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");
- $rs->populate( [
- { artistid => 7, name => 'Manufactured CrapB', cds => [
- { title => 'My First CDB', year => 2006 },
- { title => 'Yet More Tweeny-Pop crapB', year => 2007 },
- ]
- },
- { artistid => 8, name => 'Angsty-Whiny GirlB', cds => [
- { title => 'My parents sold me to a record companyB' ,year => 2005 },
- { title => 'Why Am I So Ugly?B', year => 2006 },
- { title => 'I Got Surgery and am now PopularB', year => 2007 }
+ ## 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: {
- ]
- },
- {artistid=>9, name => 'XXXX' }
+ ## 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);
+
- ] );
-
- my $artist = $rs->find(7);
+ 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');
- ok($artist, 'Found artist');
- is($artist->name, 'Manufactured CrapB');
- is($artist->cds->count, 2, 'Has CDs');
+
+ 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');
+ }
- my @cds = $artist->cds;
+ BELONGS_TO_WITH_PKs: {
- is($cds[0]->title, 'My First CDB', 'A CD');
- is($cds[0]->year, 2006, 'Published in 2006');
+ ## 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;
- is($cds[1]->title, 'Yet More Tweeny-Pop crapB', 'Another crap CD');
- is($cds[1]->year, 2007, 'Published in 2007');
+ 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");
+ }
+}
- $artist = $rs->find(8);
- ok($artist, 'Found artist');
- is($artist->name, 'Angsty-Whiny GirlB');
- is($artist->cds->count, 3, 'Has CDs');
- @cds = $artist->cds;
+## ----------------------------------------------------------------------------
+## Void context tests
+## ----------------------------------------------------------------------------
+VOID_CONTEXT: {
- is($cds[0]->title, 'My parents sold me to a record companyB', 'A CD');
- is($cds[0]->year, 2005, 'Published in 2005');
+ ## 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
- is($cds[1]->title, 'Why Am I So Ugly?B', 'A Coaster');
- is($cds[1]->year, 2006, 'Published in 2006');
+ 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 },
+ ],
+ },
+ ];
+
+ ## 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?
- is($cds[2]->title, 'I Got Surgery and am now PopularB', 'Selling un-attainable dreams');
- is($cds[2]->year, 2007, 'Published in 2007');
+ ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 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");
+
+ ## 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");
- $artist = $rs->search({name => 'XXXX'})->single;
- ok($artist, "Got Expected Artist Result");
+ ## 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: {
- is($artist->cds->count, 0, 'No CDs');
+ ## 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'},
+ },
+ ];
+
+ $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->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');
+ }
+
+
+ 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");
+ }
+}
\ No newline at end of file
projects / dbsrgits/DBIx-Class.git / blobdiff