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
  12 use strict;
  13 use warnings;
  14
  15 use Test::More;
  16 use lib qw(t/lib);
  17 use DBICTest;
  18
  19 plan tests => 53;
  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                 use Data::Dump qw/dump/;
 324
 325                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 326                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 327                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 328                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 329
 330                 ## Did the cds get expected information?
 331
 332                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 333
 334                 ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
 335                 ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 336         }
 337
 338
 339         BELONGS_TO_WITH_PKs: {
 340
 341                 ## Test from a belongs_to perspective, should create artist first,
 342                 ## then CD with artistid.  This time we try setting the PK's
 343
 344                 my $aid = $art_rs->get_column('artistid')->max || 0;
 345
 346                 my $cds = [
 347                         {
 348                                 title => 'Some CD3B',
 349                                 year => '1997',
 350                                 artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
 351                         },
 352                         {
 353                                 title => 'Some CD4B',
 354                                 year => '1997',
 355                                 artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
 356                         },
 357                 ];
 358
 359                 $cd_rs->populate($cds);
 360
 361                 my ($cdA, $cdB) = $cd_rs->search(
 362                         {title=>[sort map {$_->{title}} @$cds]},
 363                         {order_by=>'title ASC'},
 364                 );
 365
 366                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 367                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 368                 is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
 369
 370                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 371                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 372                 is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
 373                 ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
 374         }
 375
 376         BELONGS_TO_NO_PKs: {
 377
 378                 ## Test from a belongs_to perspective, should create artist first,
 379                 ## then CD with artistid.
 380
 381                 diag("Starting Void Context BelongsTO with No PKs");
 382
 383                 my $cds = [
 384                         {
 385                                 title => 'Some CD3BB',
 386                                 year => '1997',
 387                                 artist => { name => 'Fred BloggsCBB'},
 388                         },
 389                         {
 390                                 title => 'Some CD4BB',
 391                                 year => '1997',
 392                                 artist => { name => 'Fred BloggsDBB'},
 393                         },
 394                 ];
 395
 396                 $cd_rs->populate($cds);
 397
 398                 my ($cdA, $cdB) = $cd_rs->search(
 399                         {title=>[sort map {$_->{title}} @$cds]},
 400                         {order_by=>'title ASC'},
 401                 );
 402
 403                 isa_ok($cdA, 'DBICTest::CD', 'Created CD');
 404                 isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
 405                 is($cdA->title, 'Some CD3BB', 'Found Expected title');
 406                 is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
 407
 408                 isa_ok($cdB, 'DBICTest::CD', 'Created CD');
 409                 isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
 410                 is($cdB->title, 'Some CD4BB', 'Found Expected title');
 411                 is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
 412         }
 413
 414
 415         HAS_MANY_NO_PKS: {
 416
 417                 ## This first group of tests checks to make sure we can call populate
 418                 ## with the parent having many children and let the keys be automatic
 419
 420                 diag("Starting Void Context Has Many with No PKs");
 421
 422                 my $artists = [
 423                         {
 424                                 name => 'VOID_Angsty-Whiny Girl',
 425                                 cds => [
 426                                         { title => 'VOID_My First CD', year => 2006 },
 427                                         { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
 428                                 ],
 429                         },
 430                         {
 431                                 name => 'VOID_Manufactured Crap',
 432                         },
 433                         {
 434                                 name => 'VOID_Like I Give a Damn',
 435                                 cds => [
 436                                         { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
 437                                         { title => 'VOID_Why Am I So Ugly?', year => 2006 },
 438                                         { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
 439                                 ],
 440                         },
 441                         {
 442                                 name => 'VOID_Formerly Named',
 443                                 cds => [
 444                                         { title => 'VOID_One Hit Wonder', year => 2006 },
 445                                 ],
 446                         },
 447                 ];
 448
 449                 ## Get the result row objects.
 450
 451                 $art_rs->populate($artists);
 452
 453                 my ($girl, $formerly, $damn, $crap) = $art_rs->search(
 454                         {name=>[sort map {$_->{name}} @$artists]},
 455                         {order_by=>'name ASC'},
 456                 );
 457
 458                 ## Do we have the right object?
 459
 460                 isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
 461                 isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
 462                 isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
 463                 isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
 464
 465                 ## Find the expected information?
 466
 467                 ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
 468                 ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
 469                 ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
 470                 ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
 471
 472                 ## Create the expected children sub objects?
 473                 use Data::Dump qw/dump/;
 474
 475                 warn dump map { $_->get_columns } $damn->cds;
 476
 477                 ok( $crap->cds->count == 0, "got Expected Number of Cds");
 478                 ok( $girl->cds->count == 2, "got Expected Number of Cds");
 479                 ok( $damn->cds->count == 3, "got Expected Number of Cds");
 480                 ok( $formerly->cds->count == 1, "got Expected Number of Cds");
 481
 482                 ## Did the cds get expected information?
 483
 484                 my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
 485
 486                 ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
 487                 ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
 488         }
 489
 490 }
 491
 492 __END__
 493 ## ----------------------------------------------------------------------------
 494 ## Error cases
 495 ## ----------------------------------------------------------------------------
 496
 497 SHOULD_CAUSE_ERRORS: {
 498
 499         ## bad or missing PKs
 500         ## changing columns
 501         ## basically errors for non well formed data
 502         ## check for the first incomplete problem
 503         ## can we solve the problem of void context and no PKs?
 504
 505 }
 506
 507
 508
 509
 510
 511