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