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