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 | |
af928332 |
18 | plan tests => 182; |
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(); |
af928332 |
26 | |
27 | $schema->resultset('Genre')->create({ |
28 | genreid => 1, |
29 | name => 'Mixed', |
30 | }); |
31 | |
e8aef98d |
32 | my $art_rs = $schema->resultset('Artist'); |
af928332 |
33 | my $restricted_art_rs = $art_rs->search({rank => 42}); |
e8aef98d |
34 | my $cd_rs = $schema->resultset('CD'); |
af928332 |
35 | my $restricted_cd_rs = $cd_rs->search({genreid => 1}); |
e8aef98d |
36 | |
37 | ok( $schema, 'Got a Schema object'); |
38 | ok( $art_rs, 'Got Good Artist Resultset'); |
39 | ok( $cd_rs, 'Got Good CD Resultset'); |
40 | |
41 | |
42 | ## ---------------------------------------------------------------------------- |
8b93a938 |
43 | ## Schema populate Tests |
44 | ## ---------------------------------------------------------------------------- |
45 | |
7c325d53 |
46 | SCHEMA_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 | |
136 | ARRAY_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 |
367 | VOID_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 | |
649 | ARRAYREF_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 | } |