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