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