t/101populate_rs.t

   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
  11 use strict;
  12 use warnings;
  13
  14 use Test::More;
  15 use lib qw(t/lib);
  16 use DBICTest;
  17
  18 plan tests => 120;
  19
  20
  21 ## ----------------------------------------------------------------------------
  22 ## Get a Schema and some ResultSets we can play with.
  23 ## ----------------------------------------------------------------------------
  24
  25 my $schema      = DBICTest->init_schema();
  26 my $art_rs      = $schema->resultset('Artist');
  27 my $cd_rs       = $schema->resultset('CD');
  28
  29 ok( $schema, 'Got a Schema object');
  30 ok( $art_rs, 'Got Good Artist Resultset');
  31 ok( $cd_rs, 'Got Good CD Resultset');
  32
  33
  34 ## ----------------------------------------------------------------------------
  35 ## Schema populate Tests
  36 ## ----------------------------------------------------------------------------
  37
  38 SCHEMA: {
  39
  40         ## Test to make sure that the old $schema->populate is using the new method
  41         ## for $resultset->populate when in void context and with sub objects.
  42
  43         $schema->populate('Artist', [
  44
  45                 [qw/name cds/],
  46                 ["001First Artist", [
  47                         {title=>"001Title1", year=>2000},
  48                         {title=>"001Title2", year=>2001},
  49                         {title=>"001Title3", year=>2002},
  50                 ]],
  51                 ["002Second Artist", []],
  52                 ["003Third Artist", [
  53                         {title=>"003Title1", year=>2005},
  54                 ]],
  55         ]);
  56
  57         isa_ok $schema, 'DBIx::Class::Schema';
  58
  59         my ($artist1, $artist2, $artist3) = $schema->resultset('Artist')->search({
  60                 name=>["001First Artist","002Second Artist","003Third Artist"]},
  61                 {order_by=>'name ASC'})->all;
  62
  63         isa_ok  $artist1, 'DBICTest::Artist';
  64         isa_ok  $artist2, 'DBICTest::Artist';
  65         isa_ok  $artist3, 'DBICTest::Artist';
  66
  67         ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
  68         ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
  69         ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
  70
  71         ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
  72         ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
  73         ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
  74
  75         ARTIST1CDS: {
  76
  77                 my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
  78
  79                 isa_ok $cd1, 'DBICTest::CD';
  80                 isa_ok $cd2, 'DBICTest::CD';
  81                 isa_ok $cd3, 'DBICTest::CD';
  82
  83                 ok $cd1->year == 2000;
  84                 ok $cd2->year == 2001;
  85                 ok $cd3->year == 2002;
  86
  87                 ok $cd1->title eq '001Title1';
  88                 ok $cd2->title eq '001Title2';
  89                 ok $cd3->title eq '001Title3';
  90         }
  91
  92         ARTIST3CDS: {
  93
  94                 my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
  95
  96                 isa_ok $cd1, 'DBICTest::CD';
  97
  98                 ok $cd1->year == 2005;
  99                 ok $cd1->title eq '003Title1';
 100         }
 101 }
 102
 103
 104 ## ----------------------------------------------------------------------------
 105 ## Array context tests
 106 ## ----------------------------------------------------------------------------
 107
 108 ARRAY_CONTEXT: {
 109
 110         ## These first set of tests are cake because array context just delegates
 111         ## all it's processing to $resultset->create
 112
 113         HAS_MANY_NO_PKS: {
 114
 115                 ## This first group of tests checks to make sure we can call populate
 116                 ## with the parent having many children and let the keys be automatic
 117
 118                 my $artists = [
 119                         {
 120                                 name => 'Angsty-Whiny Girl',
 121                                 cds => [
 122                                         { title => 'My First CD', year => 2006 },
 123                                         { title => 'Yet More Tweeny-Pop crap', year => 2007 },
 124                                 ],
 125                         },
 126                         {
 127                                 name => 'Manufactured Crap',
 128                         },
 129                         {
 130                                 name => 'Like I Give a Damn',
 131                                 cds => [
 132                                         { title => 'My parents sold me to a record company' ,year => 2005 },
 133                                         { title => 'Why Am I So Ugly?', year => 2006 },
 134                                         { title => 'I Got Surgery and am now Popular', year => 2007 }
 135                                 ],
 136                         },
 137                         {
 138                                 name => 'Formerly Named',
 139                                 cds => [
 140                                         { title => 'One Hit Wonder', year => 2006 },
 141                                 ],
 142                         },
 143                 ];
 144
 145                 ## Get the result row objects.
 146
 147                 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
 148
 149                 ## Do we have the right object?
 150
 151                 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 152                 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 153                 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 154                 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 155
 156                 ## Find the expected information?
 157
 158                 ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
 159                 ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
 160                 ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
 161                 ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
 162
 163                 ## Create the expected children sub objects?
 164
 165                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 166                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 167                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 168                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 169
 170                 ## Did the cds get expected information?
 171
 172                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 173
 174                 ok( $cd1->title eq "My First CD", "Got Expected CD Title");
 175                 ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
 176         }
 177
 178         HAS_MANY_WITH_PKS: {
 179
 180                 ## This group tests the ability to specify the PK in the parent and let
 181                 ## DBIC transparently pass the PK down to the Child and also let's the
 182                 ## child create any other needed PK's for itself.
 183
 184                 my $aid         =  $art_rs->get_column('artistid')->max || 0;
 185
 186                 my $first_aid = ++$aid;
 187
 188                 my $artists = [
 189                         {
 190                                 artistid => $first_aid,
 191                                 name => 'PK_Angsty-Whiny Girl',
 192                                 cds => [
 193                                         { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
 194                                         { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
 195                                 ],
 196                         },
 197                         {
 198                                 artistid => ++$aid,
 199                                 name => 'PK_Manufactured Crap',
 200                         },
 201                         {
 202                                 artistid => ++$aid,
 203                                 name => 'PK_Like I Give a Damn',
 204                                 cds => [
 205                                         { title => 'PK_My parents sold me to a record company' ,year => 2005 },
 206                                         { title => 'PK_Why Am I So Ugly?', year => 2006 },
 207                                         { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
 208                                 ],
 209                         },
 210                         {
 211                                 artistid => ++$aid,
 212                                 name => 'PK_Formerly Named',
 213                                 cds => [
 214                                         { title => 'PK_One Hit Wonder', year => 2006 },
 215                                 ],
 216                         },
 217                 ];
 218
 219                 ## Get the result row objects.
 220
 221                 my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
 222
 223                 ## Do we have the right object?
 224
 225                 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 226                 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 227                 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 228                 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 229
 230                 ## Find the expected information?
 231
 232                 ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
 233                 ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
 234                 ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
 235                 ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
 236                 ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
 237
 238                 ## Create the expected children sub objects?
 239
 240                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 241                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 242                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 243                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 244
 245                 ## Did the cds get expected information?
 246
 247                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 248
 249                 ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
 250                 ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 251         }
 252
 253         BELONGS_TO_NO_PKs: {
 254
 255                 ## Test from a belongs_to perspective, should create artist first,
 256                 ## then CD with artistid.  This test we let the system automatically
 257                 ## create the PK's.  Chances are good you'll use it this way mostly.
 258
 259                 my $cds = [
 260                         {
 261                                 title => 'Some CD3',
 262                                 year => '1997',
 263                                 artist => { name => 'Fred BloggsC'},
 264                         },
 265                         {
 266                                 title => 'Some CD4',
 267                                 year => '1997',
 268                                 artist => { name => 'Fred BloggsD'},
 269                         },
 270                 ];
 271
 272                 my ($cdA, $cdB) = $cd_rs->populate($cds);
 273
 274
 275                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 276                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 277                 is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
 278
 279
 280                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 281                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 282                 is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
 283         }
 284
 285         BELONGS_TO_WITH_PKs: {
 286
 287                 ## Test from a belongs_to perspective, should create artist first,
 288                 ## then CD with artistid.  This time we try setting the PK's
 289
 290                 my $aid = $art_rs->get_column('artistid')->max || 0;
 291
 292                 my $cds = [
 293                         {
 294                                 title => 'Some CD3',
 295                                 year => '1997',
 296                                 artist => { artistid=> ++$aid, name => 'Fred BloggsC'},
 297                         },
 298                         {
 299                                 title => 'Some CD4',
 300                                 year => '1997',
 301                                 artist => { artistid=> ++$aid, name => 'Fred BloggsD'},
 302                         },
 303                 ];
 304
 305                 my ($cdA, $cdB) = $cd_rs->populate($cds);
 306
 307                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 308                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 309                 is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
 310
 311                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 312                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 313                 is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
 314                 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
 315         }
 316 }
 317
 318
 319 ## ----------------------------------------------------------------------------
 320 ## Void context tests
 321 ## ----------------------------------------------------------------------------
 322
 323 VOID_CONTEXT: {
 324
 325         ## All these tests check the ability to use populate without asking for
 326         ## any returned resultsets.  This uses bulk_insert as much as possible
 327         ## in order to increase speed.
 328
 329         HAS_MANY_WITH_PKS: {
 330
 331                 ## This first group of tests checks to make sure we can call populate
 332                 ## with the parent having many children and the parent PK is set
 333
 334                 my $aid         =  $art_rs->get_column('artistid')->max || 0;
 335
 336                 my $first_aid = ++$aid;
 337
 338                 my $artists = [
 339                         {
 340                                 artistid => $first_aid,
 341                                 name => 'VOID_PK_Angsty-Whiny Girl',
 342                                 cds => [
 343                                         { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
 344                                         { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
 345                                 ],
 346                         },
 347                         {
 348                                 artistid => ++$aid,
 349                                 name => 'VOID_PK_Manufactured Crap',
 350                         },
 351                         {
 352                                 artistid => ++$aid,
 353                                 name => 'VOID_PK_Like I Give a Damn',
 354                                 cds => [
 355                                         { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
 356                                         { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
 357                                         { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
 358                                 ],
 359                         },
 360                         {
 361                                 artistid => ++$aid,
 362                                 name => 'VOID_PK_Formerly Named',
 363                                 cds => [
 364                                         { title => 'VOID_PK_One Hit Wonder', year => 2006 },
 365                                 ],
 366                         },
 367                 ];
 368
 369                 ## Get the result row objects.
 370
 371                 $art_rs->populate($artists);
 372
 373                 my ($girl, $formerly, $damn, $crap) = $art_rs->search(
 374                         {name=>[sort map {$_->{name}} @$artists]},
 375                         {order_by=>'name ASC'},
 376                 );
 377
 378                 ## Do we have the right object?
 379
 380                 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 381                 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 382                 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 383                 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 384
 385                 ## Find the expected information?
 386
 387                 ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name for result object");
 388                 ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
 389                 ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
 390                 ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
 391
 392                 ## Create the expected children sub objects?
 393                 ok( $crap->can('cds'), "Has cds relationship");
 394                 ok( $girl->can('cds'), "Has cds relationship");
 395                 ok( $damn->can('cds'), "Has cds relationship");
 396                 ok( $formerly->can('cds'), "Has cds relationship");
 397
 398                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 399                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 400                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 401                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 402
 403                 ## Did the cds get expected information?
 404
 405                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 406
 407                 ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
 408                 ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 409         }
 410
 411
 412         BELONGS_TO_WITH_PKs: {
 413
 414                 ## Test from a belongs_to perspective, should create artist first,
 415                 ## then CD with artistid.  This time we try setting the PK's
 416
 417                 my $aid = $art_rs->get_column('artistid')->max || 0;
 418
 419                 my $cds = [
 420                         {
 421                                 title => 'Some CD3B',
 422                                 year => '1997',
 423                                 artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
 424                         },
 425                         {
 426                                 title => 'Some CD4B',
 427                                 year => '1997',
 428                                 artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
 429                         },
 430                 ];
 431
 432                 $cd_rs->populate($cds);
 433
 434                 my ($cdA, $cdB) = $cd_rs->search(
 435                         {title=>[sort map {$_->{title}} @$cds]},
 436                         {order_by=>'title ASC'},
 437                 );
 438
 439                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 440                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 441                 is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
 442
 443                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 444                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 445                 is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
 446                 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
 447         }
 448
 449         BELONGS_TO_NO_PKs: {
 450
 451                 ## Test from a belongs_to perspective, should create artist first,
 452                 ## then CD with artistid.
 453
 454                 my $cds = [
 455                         {
 456                                 title => 'Some CD3BB',
 457                                 year => '1997',
 458                                 artist => { name => 'Fred BloggsCBB'},
 459                         },
 460                         {
 461                                 title => 'Some CD4BB',
 462                                 year => '1997',
 463                                 artist => { name => 'Fred BloggsDBB'},
 464                         },
 465                 ];
 466
 467                 $cd_rs->populate($cds);
 468
 469                 my ($cdA, $cdB) = $cd_rs->search(
 470                         {title=>[sort map {$_->{title}} @$cds]},
 471                         {order_by=>'title ASC'},
 472                 );
 473
 474                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 475                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 476                 is($cdA->title, 'Some CD3BB', 'Found Expected title');
 477                 is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
 478
 479                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 480                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 481                 is($cdB->title, 'Some CD4BB', 'Found Expected title');
 482                 is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
 483         }
 484
 485
 486         HAS_MANY_NO_PKS: {
 487
 488                 ## This first group of tests checks to make sure we can call populate
 489                 ## with the parent having many children and let the keys be automatic
 490
 491                 my $artists = [
 492                         {
 493                                 name => 'VOID_Angsty-Whiny Girl',
 494                                 cds => [
 495                                         { title => 'VOID_My First CD', year => 2006 },
 496                                         { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
 497                                 ],
 498                         },
 499                         {
 500                                 name => 'VOID_Manufactured Crap',
 501                         },
 502                         {
 503                                 name => 'VOID_Like I Give a Damn',
 504                                 cds => [
 505                                         { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
 506                                         { title => 'VOID_Why Am I So Ugly?', year => 2006 },
 507                                         { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
 508                                 ],
 509                         },
 510                         {
 511                                 name => 'VOID_Formerly Named',
 512                                 cds => [
 513                                         { title => 'VOID_One Hit Wonder', year => 2006 },
 514                                 ],
 515                         },
 516                 ];
 517
 518                 ## Get the result row objects.
 519
 520                 $art_rs->populate($artists);
 521
 522                 my ($girl, $formerly, $damn, $crap) = $art_rs->search(
 523                         {name=>[sort map {$_->{name}} @$artists]},
 524                         {order_by=>'name ASC'},
 525                 );
 526
 527                 ## Do we have the right object?
 528
 529                 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 530                 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 531                 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 532                 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 533
 534                 ## Find the expected information?
 535
 536                 ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
 537                 ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
 538                 ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
 539                 ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
 540
 541                 ## Create the expected children sub objects?
 542                 ok( $crap->can('cds'), "Has cds relationship");
 543                 ok( $girl->can('cds'), "Has cds relationship");
 544                 ok( $damn->can('cds'), "Has cds relationship");
 545                 ok( $formerly->can('cds'), "Has cds relationship");
 546
 547                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 548                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 549                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 550                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 551
 552                 ## Did the cds get expected information?
 553
 554                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 555
 556                 ok($cd1, "Got a got CD");
 557                 ok($cd2, "Got a got CD");
 558                 ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
 559                 ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 560         }
 561
 562 }