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