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