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 test 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 11use strict; 12use warnings; 13 14use Test::More; 15use Test::Warn; 16use Test::Exception; 17use lib qw(t/lib); 18use DBICTest; 19 20 21## ---------------------------------------------------------------------------- 22## Get a Schema and some ResultSets we can play with. 23## ---------------------------------------------------------------------------- 24 25my $schema = DBICTest->init_schema(); 26my $art_rs = $schema->resultset('Artist'); 27my $cd_rs = $schema->resultset('CD'); 28 29my $restricted_art_rs = $art_rs->search({ -and => [ rank => 42, charfield => { '=', \['(SELECT MAX(artistid) FROM artist) + ?', 6] } ] }); 30 31ok( $schema, 'Got a Schema object'); 32ok( $art_rs, 'Got Good Artist Resultset'); 33ok( $cd_rs, 'Got Good CD Resultset'); 34 35 36## ---------------------------------------------------------------------------- 37## Schema populate Tests 38## ---------------------------------------------------------------------------- 39 40SCHEMA_POPULATE1: { 41 42 # throw a monkey wrench 43 my $post_jnap_monkeywrench = $schema->resultset('Artist')->find(1)->update({ name => undef }); 44 45 warnings_exist { $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 ]], 57 [undef, [ 58 {title=>"004Title1", year=>2010} 59 ]], 60 ]) } qr/\QFast-path populate() of non-uniquely identifiable rows with related data is not possible/; 61 62 isa_ok $schema, 'DBIx::Class::Schema'; 63 64 my ( $preexisting_undef, $artist1, $artist2, $artist3, $undef ) = $schema->resultset('Artist')->search({ 65 name=>["001First Artist","002Second Artist","003Third Artist", undef]}, 66 {order_by => { -asc => 'artistid' }})->all; 67 68 isa_ok $artist1, 'DBICTest::Artist'; 69 isa_ok $artist2, 'DBICTest::Artist'; 70 isa_ok $artist3, 'DBICTest::Artist'; 71 isa_ok $undef, 'DBICTest::Artist'; 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"; 76 ok !defined $undef->name, "Got Expected Artist Name for Artist004"; 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"; 81 ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4"; 82 83 $post_jnap_monkeywrench->delete; 84 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; 125} 126 127 128## ---------------------------------------------------------------------------- 129## Array context tests 130## ---------------------------------------------------------------------------- 131 132ARRAY_CONTEXT: { 133 134 ## These first set of tests are cake because array context just delegates 135 ## all its processing to $resultset->create 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'"); 177 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); 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'"); 251 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); 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"); 265 ok( $girl->cds->count == 2, "got Expected Number of Cds"); 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 279 ## Test from a belongs_to perspective, should create artist first, 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'}, 293 }, 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 311 ## Test from a belongs_to perspective, should create artist first, 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', 320 artist => { artistid=> ++$aid, name => 'Fred BloggsE'}, 321 }, 322 { 323 title => 'Some CD4', 324 year => '1997', 325 artist => { artistid=> ++$aid, name => 'Fred BloggsF'}, 326 }, 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'); 333 is($cdA->artist->name, 'Fred BloggsE', 'Set Artist to FredE'); 334 335 isa_ok($cdB, 'DBICTest::CD', 'Created CD'); 336 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist'); 337 is($cdB->artist->name, 'Fred BloggsF', 'Set Artist to FredF'); 338 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID"); 339 } 340 341 WITH_COND_FROM_RS: { 342 343 my ($more_crap) = $restricted_art_rs->populate([ 344 { 345 name => 'More Manufactured Crap', 346 }, 347 ]); 348 349 ## Did it use the condition in the resultset? 350 $more_crap->discard_changes; 351 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); 352 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object"); 353 } 354} 355 356 357## ---------------------------------------------------------------------------- 358## Void context tests 359## ---------------------------------------------------------------------------- 360 361VOID_CONTEXT: { 362 363 ## All these tests check the ability to use populate without asking for 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 }, 395 { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 } 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'"); 428 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); 429 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); 430 isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'"); 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"); 436 ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object"); 437 ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object"); 438 ok( !defined $undef->name, "Got Correct name 'is undef' for result object"); 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"); 445 ok( $undef->can('cds'), "Has cds relationship"); 446 447 ok( $crap->cds->count == 0, "got Expected Number of Cds"); 448 ok( $girl->cds->count == 2, "got Expected Number of Cds"); 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 464 ## Test from a belongs_to perspective, should create artist first, 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 482 warnings_exist { 483 $cd_rs->populate($cds) 484 } qr/\QFast-path populate() of belongs_to relationship data is not possible/; 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 503 ## Test from a belongs_to perspective, should create artist first, 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}, 521 }, 522 ]; 523 524 warnings_exist { 525 $cd_rs->populate($cds); 526 } qr/\QFast-path populate() of belongs_to relationship data is not possible/; 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 = [ 556 { 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 }, 561 ], 562 }, 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 }, 571 { title => 'VOID_I Got Surgery and am now Popular', year => 2007 } 572 ], 573 }, 574 { 575 name => 'VOID_Formerly Named', 576 cds => [ 577 { title => 'VOID_One Hit Wonder', year => 2006 }, 578 ], 579 }, 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'"); 595 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'"); 596 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'"); 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"); 602 ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object"); 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"); 612 ok( $girl->cds->count == 2, "got Expected Number of Cds"); 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 } 625 626 WITH_COND_FROM_RS: { 627 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; 637 638 ## Did it use the condition in the resultset? 639 $more_crap->discard_changes; 640 cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object"); 641 cmp_ok( $more_crap->charfield, '==', $more_crap->id + 5, "Got Correct charfield for result object"); 642 } 643} 644 645ARRAYREF_OF_ARRAYREF_STYLE: { 646 $art_rs->populate([ 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 ]); 652 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"; 656 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'; 660 661 my ($cooler, $lamer) = $restricted_art_rs->populate([ 662 [qw/artistid name/], 663 [1003, 'Cooler'], 664 [1004, 'Lamer'], 665 ]); 666 667 is $cooler->name, 'Cooler', 'Correct Name'; 668 is $lamer->name, 'Lamer', 'Correct Name'; 669 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 } 675 676 ARRAY_CONTEXT_WITH_COND_FROM_RS: { 677 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? 685 $mega_lamer->discard_changes; 686 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object"); 687 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object"); 688 } 689 690 VOID_CONTEXT_WITH_COND_FROM_RS: { 691 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; 701 702 ## Did it use the condition in the resultset? 703 cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object"); 704 cmp_ok( $mega_lamer->charfield, '==', $mega_lamer->id + 5, "Got Correct charfield for result object"); 705 } 706} 707 708EMPTY_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} 729 730done_testing; 731