t/25backcompat_v4.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Test::Exception;
   5 use File::Path qw/rmtree make_path/;
   6 use Class::Unload;
   7 use File::Temp qw/tempfile tempdir/;
   8 use IO::File;
   9 use File::Slurp 'slurp';
  10 use DBIx::Class::Schema::Loader ();
  11 use lib qw(t/lib);
  12 use make_dbictest_db2;
  13
  14 my $DUMP_DIR = './t/_common_dump';
  15 rmtree $DUMP_DIR;
  16 my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema';
  17
  18 # test dynamic schema in 0.04006 mode
  19 {
  20     my $res = run_loader();
  21     my $warning = $res->{warnings}[0];
  22
  23     like $warning, qr/dynamic schema/i,
  24         'dynamic schema in backcompat mode detected';
  25     like $warning, qr/run in 0\.04006 mode/i,
  26         'dynamic schema in 0.04006 mode warning';
  27     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
  28         'warning refers to upgrading doc';
  29
  30     run_v4_tests($res);
  31 }
  32
  33 # setting naming accessor on dynamic schema should disable warning (even when
  34 # we're setting it to 'v4' .)
  35 {
  36     my $res = run_loader(naming => 'v4');
  37     is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
  38     run_v4_tests($res);
  39 }
  40
  41 # test upgraded dynamic schema
  42 {
  43     my $res = run_loader(naming => 'current');
  44     is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
  45     run_v5_tests($res);
  46 }
  47
  48 # test upgraded dynamic schema with external content loaded
  49 {
  50     my $temp_dir = tempdir(CLEANUP => 1);
  51     push @INC, $temp_dir;
  52
  53     my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
  54     make_path $external_result_dir;
  55
  56     # make external content for Result that will be singularized
  57     IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
  58 package ${SCHEMA_CLASS}::Quuxs;
  59 sub a_method { 'hlagh' }
  60
  61 __PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs',
  62     { 'foreign.baz_num' => 'self.baz_id' });
  63
  64 1;
  65 EOF
  66
  67     # make external content for Result that will NOT be singularized
  68     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
  69 package ${SCHEMA_CLASS}::Bar;
  70
  71 __PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos',
  72     { 'foreign.fooid' => 'self.foo_id' });
  73
  74 1;
  75 EOF
  76
  77     my $res = run_loader(naming => 'current');
  78     my $schema = $res->{schema};
  79
  80     is scalar @{ $res->{warnings} }, 1,
  81 'correct nummber of warnings for upgraded dynamic schema with external ' .
  82 'content for unsingularized Result.';
  83
  84     my $warning = $res->{warnings}[0];
  85     like $warning, qr/Detected external content/i,
  86         'detected external content warning';
  87
  88     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
  89 'external custom content for unsingularized Result was loaded by upgraded ' .
  90 'dynamic Schema';
  91
  92     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel,
  93         $res->{classes}{bazs} }
  94         'unsingularized class names in external content are translated';
  95
  96     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel,
  97         $res->{classes}{foos} }
  98 'unsingularized class names in external content from unchanged Result class ' .
  99 'names are translated';
 100
 101     run_v5_tests($res);
 102
 103     pop @INC;
 104 }
 105
 106 # test upgraded dynamic schema with use_namespaces with external content loaded
 107 {
 108     my $temp_dir = tempdir(CLEANUP => 1);
 109     push @INC, $temp_dir;
 110
 111     my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
 112     make_path $external_result_dir;
 113
 114     # make external content for Result that will be singularized
 115     IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
 116 package ${SCHEMA_CLASS}::Quuxs;
 117 sub a_method { 'hlagh' }
 118
 119 __PACKAGE__->has_one('bazrel4', 'DBIXCSL_Test::Schema::Bazs',
 120     { 'foreign.baz_num' => 'self.baz_id' });
 121
 122 1;
 123 EOF
 124
 125     # make external content for Result that will NOT be singularized
 126     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
 127 package ${SCHEMA_CLASS}::Bar;
 128
 129 __PACKAGE__->has_one('foorel4', 'DBIXCSL_Test::Schema::Foos',
 130     { 'foreign.fooid' => 'self.foo_id' });
 131
 132 1;
 133 EOF
 134
 135     my $res = run_loader(naming => 'current', use_namespaces => 1);
 136     my $schema = $res->{schema};
 137
 138     is scalar @{ $res->{warnings} }, 2,
 139 'correct nummber of warnings for upgraded dynamic schema with external ' .
 140 'content for unsingularized Result with use_namespaces.';
 141
 142     my $warning = $res->{warnings}[0];
 143     like $warning, qr/Detected external content/i,
 144         'detected external content warning';
 145
 146     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
 147 'external custom content for unsingularized Result was loaded by upgraded ' .
 148 'dynamic Schema';
 149
 150     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel4,
 151         $res->{classes}{bazs} }
 152         'unsingularized class names in external content are translated';
 153
 154     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel4,
 155         $res->{classes}{foos} }
 156 'unsingularized class names in external content from unchanged Result class ' .
 157 'names are translated';
 158
 159     run_v5_tests($res);
 160
 161     pop @INC;
 162 }
 163
 164
 165 # test upgraded static schema with external content loaded
 166 {
 167     my $temp_dir = tempdir(CLEANUP => 1);
 168     push @INC, $temp_dir;
 169
 170     my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
 171     make_path $external_result_dir;
 172
 173     # make external content for Result that will be singularized
 174     IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
 175 package ${SCHEMA_CLASS}::Quuxs;
 176 sub a_method { 'dongs' }
 177
 178 __PACKAGE__->has_one('bazrel2', 'DBIXCSL_Test::Schema::Bazs',
 179     { 'foreign.baz_num' => 'self.baz_id' });
 180
 181 1;
 182 EOF
 183
 184     # make external content for Result that will NOT be singularized
 185     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
 186 package ${SCHEMA_CLASS}::Bar;
 187
 188 __PACKAGE__->has_one('foorel2', 'DBIXCSL_Test::Schema::Foos',
 189     { 'foreign.fooid' => 'self.foo_id' });
 190
 191 1;
 192 EOF
 193
 194     write_v4_schema_pm();
 195
 196     my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
 197     my $schema = $res->{schema};
 198
 199     run_v5_tests($res);
 200
 201     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'dongs' }
 202 'external custom content for unsingularized Result was loaded by upgraded ' .
 203 'static Schema';
 204
 205     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2,
 206         $res->{classes}{bazs} }
 207         'unsingularized class names in external content are translated';
 208
 209     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel2,
 210         $res->{classes}{foos} }
 211 'unsingularized class names in external content from unchanged Result class ' .
 212 'names are translated in static schema';
 213
 214     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 215     my $code = slurp $file;
 216
 217     like $code, qr/package ${SCHEMA_CLASS}::Quux;/,
 218 'package line translated correctly from external custom content in static dump';
 219
 220     like $code, qr/sub a_method { 'dongs' }/,
 221 'external custom content loaded into static dump correctly';
 222
 223     pop @INC;
 224 }
 225
 226 # test running against v4 schema without upgrade, twice, then upgrade
 227 {
 228     write_v4_schema_pm();
 229     my $res = run_loader(dump_directory => $DUMP_DIR);
 230     my $warning = $res->{warnings}[1];
 231
 232     like $warning, qr/static schema/i,
 233         'static schema in backcompat mode detected';
 234     like $warning, qr/0.04006/,
 235         'correct version detected';
 236     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
 237         'refers to upgrading doc';
 238
 239     is scalar @{ $res->{warnings} }, 4,
 240         'correct number of warnings for static schema in backcompat mode';
 241
 242     run_v4_tests($res);
 243
 244     # add some custom content to a Result that will be replaced
 245     my $schema   = $res->{schema};
 246     my $quuxs_pm = $schema->_loader
 247         ->_get_dump_filename($res->{classes}{quuxs});
 248     {
 249         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 250         while (<>) {
 251             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 252                 print;
 253                 print <<EOF;
 254 sub a_method { 'mtfnpy' }
 255
 256 __PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
 257     { 'foreign.baz_num' => 'self.baz_id' });
 258 EOF
 259             }
 260             else {
 261                 print;
 262             }
 263         }
 264         close ARGV;
 265         unlink "${quuxs_pm}.bak" or die $^E;
 266     }
 267
 268     # Rerun the loader in backcompat mode to make sure it's still in backcompat
 269     # mode.
 270     $res = run_loader(dump_directory => $DUMP_DIR);
 271     run_v4_tests($res);
 272
 273     # now upgrade the schema
 274     $res = run_loader(
 275         dump_directory => $DUMP_DIR,
 276         naming => 'current',
 277         use_namespaces => 1
 278     );
 279     $schema = $res->{schema};
 280
 281     like $res->{warnings}[0], qr/Dumping manual schema/i,
 282         'correct warnings on upgrading static schema (with "naming" set)';
 283
 284     like $res->{warnings}[1], qr/dump completed/i,
 285         'correct warnings on upgrading static schema (with "naming" set)';
 286
 287     is scalar @{ $res->{warnings} }, 2,
 288 'correct number of warnings on upgrading static schema (with "naming" set)'
 289         or diag @{ $res->{warnings} };
 290
 291     run_v5_tests($res);
 292
 293     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Result") =~ s{::}{/}g;
 294     my $result_count =()= glob "$result_dir/*";
 295
 296     is $result_count, 4,
 297         'un-singularized results were replaced during upgrade';
 298
 299     # check that custom content was preserved
 300     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 301         'custom content was carried over from un-singularized Result';
 302
 303     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3,
 304         $res->{classes}{bazs} }
 305         'unsingularized class names in custom content are translated';
 306
 307     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 308     my $code = slurp $file;
 309
 310     like $code, qr/sub a_method { 'mtfnpy' }/,
 311 'custom content from unsingularized Result loaded into static dump correctly';
 312 }
 313
 314 # test running against v4 schema without upgrade, then upgrade with
 315 # use_namespaces not explicitly set
 316 {
 317     write_v4_schema_pm();
 318     my $res = run_loader(dump_directory => $DUMP_DIR);
 319     my $warning = $res->{warnings}[1];
 320
 321     like $warning, qr/static schema/i,
 322         'static schema in backcompat mode detected';
 323     like $warning, qr/0.04006/,
 324         'correct version detected';
 325     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
 326         'refers to upgrading doc';
 327
 328     is scalar @{ $res->{warnings} }, 4,
 329         'correct number of warnings for static schema in backcompat mode';
 330
 331     run_v4_tests($res);
 332
 333     # add some custom content to a Result that will be replaced
 334     my $schema   = $res->{schema};
 335     my $quuxs_pm = $schema->_loader
 336         ->_get_dump_filename($res->{classes}{quuxs});
 337     {
 338         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 339         while (<>) {
 340             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 341                 print;
 342                 print <<EOF;
 343 sub a_method { 'mtfnpy' }
 344
 345 __PACKAGE__->has_one('bazrel5', 'DBIXCSL_Test::Schema::Bazs',
 346     { 'foreign.baz_num' => 'self.baz_id' });
 347 EOF
 348             }
 349             else {
 350                 print;
 351             }
 352         }
 353         close ARGV;
 354         unlink "${quuxs_pm}.bak" or die $^E;
 355     }
 356
 357     # now upgrade the schema
 358     $res = run_loader(
 359         dump_directory => $DUMP_DIR,
 360         naming => 'current'
 361     );
 362     $schema = $res->{schema};
 363
 364     like $res->{warnings}[0], qr/load_classes/i,
 365 'correct warnings on upgrading static schema (with "naming" set and ' .
 366 'use_namespaces not set)';
 367
 368     like $res->{warnings}[1], qr/Dumping manual schema/i,
 369 'correct warnings on upgrading static schema (with "naming" set and ' .
 370 'use_namespaces not set)';
 371
 372     like $res->{warnings}[2], qr/dump completed/i,
 373 'correct warnings on upgrading static schema (with "naming" set and ' .
 374 'use_namespaces not set)';
 375
 376     is scalar @{ $res->{warnings} }, 3,
 377 'correct number of warnings on upgrading static schema (with "naming" set)'
 378         or diag @{ $res->{warnings} };
 379
 380     run_v5_tests($res);
 381
 382     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
 383     my $result_count =()= glob "$result_dir/*";
 384
 385     is $result_count, 4,
 386         'un-singularized results were replaced during upgrade';
 387
 388     # check that custom content was preserved
 389     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 390         'custom content was carried over from un-singularized Result';
 391
 392     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel5,
 393         $res->{classes}{bazs} }
 394         'unsingularized class names in custom content are translated';
 395
 396     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 397     my $code = slurp $file;
 398
 399     like $code, qr/sub a_method { 'mtfnpy' }/,
 400 'custom content from unsingularized Result loaded into static dump correctly';
 401 }
 402
 403 # test running against v4 schema with load_namespaces, upgrade to v5 but
 404 # downgrade to load_classes, with external content
 405 {
 406     my $temp_dir = tempdir(CLEANUP => 1);
 407     push @INC, $temp_dir;
 408
 409     my $external_result_dir = join '/', $temp_dir, split /::/,
 410         "${SCHEMA_CLASS}::Result";
 411
 412     make_path $external_result_dir;
 413
 414     # make external content for Result that will be singularized
 415     IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
 416 package ${SCHEMA_CLASS}::Result::Quuxs;
 417 sub b_method { 'dongs' }
 418
 419 __PACKAGE__->has_one('bazrel11', 'DBIXCSL_Test::Schema::Result::Bazs',
 420     { 'foreign.baz_num' => 'self.baz_id' });
 421
 422 1;
 423 EOF
 424
 425     # make external content for Result that will NOT be singularized
 426     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
 427 package ${SCHEMA_CLASS}::Result::Bar;
 428
 429 __PACKAGE__->has_one('foorel5', 'DBIXCSL_Test::Schema::Result::Foos',
 430     { 'foreign.fooid' => 'self.foo_id' });
 431
 432 1;
 433 EOF
 434
 435     write_v4_schema_pm(use_namespaces => 1);
 436
 437     my $res = run_loader(dump_directory => $DUMP_DIR);
 438     my $warning = $res->{warnings}[0];
 439
 440     like $warning, qr/static schema/i,
 441         'static schema in backcompat mode detected';
 442     like $warning, qr/0.04006/,
 443         'correct version detected';
 444     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
 445         'refers to upgrading doc';
 446
 447     is scalar @{ $res->{warnings} }, 3,
 448         'correct number of warnings for static schema in backcompat mode';
 449
 450     run_v4_tests($res);
 451
 452     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
 453         'use_namespaces in backcompat mode';
 454
 455     # add some custom content to a Result that will be replaced
 456     my $schema   = $res->{schema};
 457     my $quuxs_pm = $schema->_loader
 458         ->_get_dump_filename($res->{classes}{quuxs});
 459     {
 460         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 461         while (<>) {
 462             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 463                 print;
 464                 print <<EOF;
 465 sub a_method { 'mtfnpy' }
 466
 467 __PACKAGE__->has_one('bazrel6', 'DBIXCSL_Test::Schema::Result::Bazs',
 468     { 'foreign.baz_num' => 'self.baz_id' });
 469 EOF
 470             }
 471             else {
 472                 print;
 473             }
 474         }
 475         close ARGV;
 476         unlink "${quuxs_pm}.bak" or die $^E;
 477     }
 478
 479     # now upgrade the schema to v5 but downgrade to load_classes
 480     $res = run_loader(
 481         dump_directory => $DUMP_DIR,
 482         naming => 'current',
 483         use_namespaces => 0,
 484     );
 485     $schema = $res->{schema};
 486
 487     like $res->{warnings}[0], qr/Dumping manual schema/i,
 488 'correct warnings on upgrading static schema (with "naming" set and ' .
 489 'use_namespaces => 0)';
 490
 491     like $res->{warnings}[1], qr/dump completed/i,
 492 'correct warnings on upgrading static schema (with "naming" set and ' .
 493 'use_namespaces => 0)';
 494
 495     is scalar @{ $res->{warnings} }, 2,
 496 'correct number of warnings on upgrading static schema (with "naming" set)'
 497         or diag @{ $res->{warnings} };
 498
 499     run_v5_tests($res);
 500
 501     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
 502     my $result_count =()= glob "$result_dir/*";
 503
 504     is $result_count, 4,
 505 'un-singularized results were replaced during upgrade and Result dir removed';
 506
 507     ok ((not -d "$result_dir/Result"),
 508         'Result dir was removed for load_classes downgrade');
 509
 510     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
 511         'load_classes in upgraded mode';
 512
 513     # check that custom and external content was preserved
 514     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 515         'custom content was carried over from un-singularized Result';
 516
 517     lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' }
 518         'external content was carried over from un-singularized Result';
 519
 520     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
 521         $res->{classes}{bazs} }
 522         'unsingularized class names in custom content are translated';
 523
 524     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel11,
 525         $res->{classes}{bazs} }
 526         'unsingularized class names in external content are translated';
 527
 528     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel5,
 529         $res->{classes}{foos} }
 530 'unsingularized class names in external content from unchanged Result class ' .
 531 'names are translated in static schema';
 532
 533     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 534     my $code = slurp $file;
 535
 536     like $code, qr/sub a_method { 'mtfnpy' }/,
 537 'custom content from unsingularized Result loaded into static dump correctly';
 538
 539     like $code, qr/sub b_method { 'dongs' }/,
 540 'external content from unsingularized Result loaded into static dump correctly';
 541
 542     pop @INC;
 543 }
 544
 545 # test a regular schema with use_namespaces => 0 upgraded to
 546 # use_namespaces => 1
 547 {
 548     rmtree $DUMP_DIR;
 549     mkdir $DUMP_DIR;
 550
 551     my $res = run_loader(
 552         dump_directory => $DUMP_DIR,
 553         use_namespaces => 0,
 554     );
 555
 556     like $res->{warnings}[0], qr/Dumping manual schema/i,
 557 'correct warnings on dumping static schema with use_namespaces => 0';
 558
 559     like $res->{warnings}[1], qr/dump completed/i,
 560 'correct warnings on dumping static schema with use_namespaces => 0';
 561
 562     is scalar @{ $res->{warnings} }, 2,
 563 'correct number of warnings on dumping static schema with use_namespaces => 0'
 564         or diag @{ $res->{warnings} };
 565
 566     run_v5_tests($res);
 567
 568     # add some custom content to a Result that will be replaced
 569     my $schema   = $res->{schema};
 570     my $quuxs_pm = $schema->_loader
 571         ->_get_dump_filename($res->{classes}{quuxs});
 572     {
 573         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 574         while (<>) {
 575             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 576                 print;
 577                 print <<EOF;
 578 sub a_method { 'mtfnpy' }
 579
 580 __PACKAGE__->has_one('bazrel7', 'DBIXCSL_Test::Schema::Baz',
 581     { 'foreign.baz_num' => 'self.baz_id' });
 582 EOF
 583             }
 584             else {
 585                 print;
 586             }
 587         }
 588         close ARGV;
 589         unlink "${quuxs_pm}.bak" or die $^E;
 590     }
 591
 592     # test that with no use_namespaces option, there is a warning and
 593     # load_classes is preserved
 594     $res = run_loader(dump_directory => $DUMP_DIR);
 595
 596     like $res->{warnings}[0], qr/load_classes/i,
 597 'correct warnings on re-dumping static schema with load_classes';
 598
 599     like $res->{warnings}[1], qr/Dumping manual schema/i,
 600 'correct warnings on re-dumping static schema with load_classes';
 601
 602     like $res->{warnings}[2], qr/dump completed/i,
 603 'correct warnings on re-dumping static schema with load_classes';
 604
 605     is scalar @{ $res->{warnings} }, 3,
 606 'correct number of warnings on re-dumping static schema with load_classes'
 607         or diag @{ $res->{warnings} };
 608
 609     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
 610         'load_classes preserved on re-dump';
 611
 612     run_v5_tests($res);
 613
 614     # now upgrade the schema to use_namespaces
 615     $res = run_loader(
 616         dump_directory => $DUMP_DIR,
 617         use_namespaces => 1,
 618     );
 619     $schema = $res->{schema};
 620
 621     like $res->{warnings}[0], qr/Dumping manual schema/i,
 622 'correct warnings on upgrading to use_namespaces';
 623
 624     like $res->{warnings}[1], qr/dump completed/i,
 625 'correct warnings on upgrading to use_namespaces';
 626
 627     is scalar @{ $res->{warnings} }, 2,
 628 'correct number of warnings on upgrading to use_namespaces'
 629         or diag @{ $res->{warnings} };
 630
 631     run_v5_tests($res);
 632
 633     (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
 634     my @schema_files = glob "$schema_dir/*";
 635
 636     is 1, (scalar @schema_files),
 637         "schema dir $schema_dir contains only 1 entry";
 638
 639     like $schema_files[0], qr{/Result\z},
 640         "schema dir contains only a Result/ directory";
 641
 642     # check that custom content was preserved
 643     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 644         'custom content was carried over during use_namespaces upgrade';
 645
 646     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel7,
 647         $res->{classes}{bazs} }
 648         'un-namespaced class names in custom content are translated';
 649
 650     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 651     my $code = slurp $file;
 652
 653     like $code, qr/sub a_method { 'mtfnpy' }/,
 654 'custom content from un-namespaced Result loaded into static dump correctly';
 655 }
 656
 657 # test a regular schema with default use_namespaces => 1, redump, and downgrade
 658 # to load_classes
 659 {
 660     rmtree $DUMP_DIR;
 661     mkdir $DUMP_DIR;
 662
 663     my $res = run_loader(dump_directory => $DUMP_DIR);
 664
 665     like $res->{warnings}[0], qr/Dumping manual schema/i,
 666 'correct warnings on dumping static schema';
 667
 668     like $res->{warnings}[1], qr/dump completed/i,
 669 'correct warnings on dumping static schema';
 670
 671     is scalar @{ $res->{warnings} }, 2,
 672 'correct number of warnings on dumping static schema'
 673         or diag @{ $res->{warnings} };
 674
 675     run_v5_tests($res);
 676
 677     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
 678         'defaults to use_namespaces on regular dump';
 679
 680     # add some custom content to a Result that will be replaced
 681     my $schema   = $res->{schema};
 682     my $quuxs_pm = $schema->_loader
 683         ->_get_dump_filename($res->{classes}{quuxs});
 684     {
 685         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 686         while (<>) {
 687             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 688                 print;
 689                 print <<EOF;
 690 sub a_method { 'mtfnpy' }
 691
 692 __PACKAGE__->has_one('bazrel8', 'DBIXCSL_Test::Schema::Result::Baz',
 693     { 'foreign.baz_num' => 'self.baz_id' });
 694 EOF
 695             }
 696             else {
 697                 print;
 698             }
 699         }
 700         close ARGV;
 701         unlink "${quuxs_pm}.bak" or die $^E;
 702     }
 703
 704     # test that with no use_namespaces option, use_namespaces is preserved
 705     $res = run_loader(dump_directory => $DUMP_DIR);
 706
 707     like $res->{warnings}[0], qr/Dumping manual schema/i,
 708 'correct warnings on re-dumping static schema';
 709
 710     like $res->{warnings}[1], qr/dump completed/i,
 711 'correct warnings on re-dumping static schema';
 712
 713     is scalar @{ $res->{warnings} }, 2,
 714 'correct number of warnings on re-dumping static schema'
 715         or diag @{ $res->{warnings} };
 716
 717     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
 718         'use_namespaces preserved on re-dump';
 719
 720     run_v5_tests($res);
 721
 722     # now downgrade the schema to load_classes
 723     $res = run_loader(
 724         dump_directory => $DUMP_DIR,
 725         use_namespaces => 0,
 726     );
 727     $schema = $res->{schema};
 728
 729     like $res->{warnings}[0], qr/Dumping manual schema/i,
 730 'correct warnings on downgrading to load_classes';
 731
 732     like $res->{warnings}[1], qr/dump completed/i,
 733 'correct warnings on downgrading to load_classes';
 734
 735     is scalar @{ $res->{warnings} }, 2,
 736 'correct number of warnings on downgrading to load_classes'
 737         or diag @{ $res->{warnings} };
 738
 739     run_v5_tests($res);
 740
 741     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
 742         'load_classes downgrade correct';
 743
 744     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
 745     my $result_count =()= glob "$result_dir/*";
 746
 747     is $result_count, 4,
 748 'correct number of Results after upgrade and Result dir removed';
 749
 750     ok ((not -d "$result_dir/Result"),
 751         'Result dir was removed for load_classes downgrade');
 752
 753     # check that custom content was preserved
 754     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 755         'custom content was carried over during load_classes downgrade';
 756
 757     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel8,
 758         $res->{classes}{bazs} }
 759 'namespaced class names in custom content are translated during load_classes '.
 760 'downgrade';
 761
 762     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 763     my $code = slurp $file;
 764
 765     like $code, qr/sub a_method { 'mtfnpy' }/,
 766 'custom content from namespaced Result loaded into static dump correctly '.
 767 'during load_classes downgrade';
 768 }
 769
 770 # test a regular schema with use_namespaces => 1 and a custom result_namespace
 771 # downgraded to load_classes
 772 {
 773     rmtree $DUMP_DIR;
 774     mkdir $DUMP_DIR;
 775
 776     my $res = run_loader(
 777         dump_directory => $DUMP_DIR,
 778         result_namespace => 'MyResult',
 779     );
 780
 781     like $res->{warnings}[0], qr/Dumping manual schema/i,
 782 'correct warnings on dumping static schema';
 783
 784     like $res->{warnings}[1], qr/dump completed/i,
 785 'correct warnings on dumping static schema';
 786
 787     is scalar @{ $res->{warnings} }, 2,
 788 'correct number of warnings on dumping static schema'
 789         or diag @{ $res->{warnings} };
 790
 791     run_v5_tests($res);
 792
 793     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
 794         'defaults to use_namespaces and uses custom result_namespace';
 795
 796     # add some custom content to a Result that will be replaced
 797     my $schema   = $res->{schema};
 798     my $quuxs_pm = $schema->_loader
 799         ->_get_dump_filename($res->{classes}{quuxs});
 800     {
 801         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 802         while (<>) {
 803             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 804                 print;
 805                 print <<EOF;
 806 sub a_method { 'mtfnpy' }
 807
 808 __PACKAGE__->has_one('bazrel9', 'DBIXCSL_Test::Schema::MyResult::Baz',
 809     { 'foreign.baz_num' => 'self.baz_id' });
 810 EOF
 811             }
 812             else {
 813                 print;
 814             }
 815         }
 816         close ARGV;
 817         unlink "${quuxs_pm}.bak" or die $^E;
 818     }
 819
 820     # test that with no use_namespaces option, use_namespaces is preserved, and
 821     # the custom result_namespace is preserved
 822     $res = run_loader(dump_directory => $DUMP_DIR);
 823
 824     like $res->{warnings}[0], qr/Dumping manual schema/i,
 825 'correct warnings on re-dumping static schema';
 826
 827     like $res->{warnings}[1], qr/dump completed/i,
 828 'correct warnings on re-dumping static schema';
 829
 830     is scalar @{ $res->{warnings} }, 2,
 831 'correct number of warnings on re-dumping static schema'
 832         or diag @{ $res->{warnings} };
 833
 834     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
 835         'use_namespaces and custom result_namespace preserved on re-dump';
 836
 837     run_v5_tests($res);
 838
 839     # now downgrade the schema to load_classes
 840     $res = run_loader(
 841         dump_directory => $DUMP_DIR,
 842         use_namespaces => 0,
 843     );
 844     $schema = $res->{schema};
 845
 846     like $res->{warnings}[0], qr/Dumping manual schema/i,
 847 'correct warnings on downgrading to load_classes';
 848
 849     like $res->{warnings}[1], qr/dump completed/i,
 850 'correct warnings on downgrading to load_classes';
 851
 852     is scalar @{ $res->{warnings} }, 2,
 853 'correct number of warnings on downgrading to load_classes'
 854         or diag @{ $res->{warnings} };
 855
 856     run_v5_tests($res);
 857
 858     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
 859         'load_classes downgrade correct';
 860
 861     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
 862     my $result_count =()= glob "$result_dir/*";
 863
 864     is $result_count, 4,
 865 'correct number of Results after upgrade and Result dir removed';
 866
 867     ok ((not -d "$result_dir/MyResult"),
 868         'Result dir was removed for load_classes downgrade');
 869
 870     # check that custom content was preserved
 871     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 872         'custom content was carried over during load_classes downgrade';
 873
 874     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel9,
 875         $res->{classes}{bazs} }
 876 'namespaced class names in custom content are translated during load_classes '.
 877 'downgrade';
 878
 879     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 880     my $code = slurp $file;
 881
 882     like $code, qr/sub a_method { 'mtfnpy' }/,
 883 'custom content from namespaced Result loaded into static dump correctly '.
 884 'during load_classes downgrade';
 885 }
 886
 887 # rewrite from one result_namespace to another, with external content
 888 {
 889     rmtree $DUMP_DIR;
 890     mkdir $DUMP_DIR;
 891     my $temp_dir = tempdir(CLEANUP => 1);
 892     push @INC, $temp_dir;
 893
 894     my $external_result_dir = join '/', $temp_dir, split /::/,
 895         "${SCHEMA_CLASS}::Result";
 896
 897     make_path $external_result_dir;
 898
 899     IO::File->new(">$external_result_dir/Quux.pm")->print(<<"EOF");
 900 package ${SCHEMA_CLASS}::Result::Quux;
 901 sub c_method { 'dongs' }
 902
 903 __PACKAGE__->has_one('bazrel12', 'DBIXCSL_Test::Schema::Result::Baz',
 904     { 'foreign.baz_num' => 'self.baz_id' });
 905
 906 1;
 907 EOF
 908
 909     IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
 910 package ${SCHEMA_CLASS}::Result::Bar;
 911
 912 __PACKAGE__->has_one('foorel6', 'DBIXCSL_Test::Schema::Result::Foo',
 913     { 'foreign.fooid' => 'self.foo_id' });
 914
 915 1;
 916 EOF
 917
 918     my $res = run_loader(dump_directory => $DUMP_DIR);
 919
 920     # add some custom content to a Result that will be replaced
 921     my $schema   = $res->{schema};
 922     my $quuxs_pm = $schema->_loader
 923         ->_get_dump_filename($res->{classes}{quuxs});
 924     {
 925         local ($^I, @ARGV) = ('.bak', $quuxs_pm);
 926         while (<>) {
 927             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
 928                 print;
 929                 print <<EOF;
 930 sub a_method { 'mtfnpy' }
 931
 932 __PACKAGE__->has_one('bazrel10', 'DBIXCSL_Test::Schema::Result::Baz',
 933     { 'foreign.baz_num' => 'self.baz_id' });
 934 EOF
 935             }
 936             else {
 937                 print;
 938             }
 939         }
 940         close ARGV;
 941         unlink "${quuxs_pm}.bak" or die $^E;
 942     }
 943
 944     # Rewrite implicit 'Result' to 'MyResult'
 945     $res = run_loader(
 946         dump_directory => $DUMP_DIR,
 947         result_namespace => 'MyResult',
 948     );
 949     $schema = $res->{schema};
 950
 951     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
 952         'using new result_namespace';
 953
 954     (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS")          =~ s{::}{/}g;
 955     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/MyResult") =~ s{::}{/}g;
 956     my $result_count =()= glob "$result_dir/*";
 957
 958     is $result_count, 4,
 959 'correct number of Results after rewritten result_namespace';
 960
 961     ok ((not -d "$schema_dir/Result"),
 962         'original Result dir was removed when rewriting result_namespace');
 963
 964     # check that custom content was preserved
 965     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
 966         'custom content was carried over when rewriting result_namespace';
 967
 968     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
 969         $res->{classes}{bazs} }
 970 'class names in custom content are translated when rewriting result_namespace';
 971
 972     my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
 973     my $code = slurp $file;
 974
 975     like $code, qr/sub a_method { 'mtfnpy' }/,
 976 'custom content from namespaced Result loaded into static dump correctly '.
 977 'when rewriting result_namespace';
 978
 979     # Now rewrite 'MyResult' to 'Mtfnpy'
 980     $res = run_loader(
 981         dump_directory => $DUMP_DIR,
 982         result_namespace => 'Mtfnpy',
 983     );
 984     $schema = $res->{schema};
 985
 986     is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux',
 987         'using new result_namespace';
 988
 989     ($schema_dir = "$DUMP_DIR/$SCHEMA_CLASS")        =~ s{::}{/}g;
 990     ($result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Mtfnpy") =~ s{::}{/}g;
 991     $result_count =()= glob "$result_dir/*";
 992
 993     is $result_count, 4,
 994 'correct number of Results after rewritten result_namespace';
 995
 996     ok ((not -d "$schema_dir/MyResult"),
 997         'original Result dir was removed when rewriting result_namespace');
 998
 999     # check that custom and external content was preserved
1000     lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
1001         'custom content was carried over when rewriting result_namespace';
1002
1003     lives_and { is $schema->resultset('Quux')->find(1)->c_method, 'dongs' }
1004         'custom content was carried over when rewriting result_namespace';
1005
1006     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
1007         $res->{classes}{bazs} }
1008 'class names in custom content are translated when rewriting result_namespace';
1009
1010     lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel12,
1011         $res->{classes}{bazs} }
1012 'class names in external content are translated when rewriting '.
1013 'result_namespace';
1014
1015     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel6,
1016         $res->{classes}{foos} }
1017 'class names in external content are translated when rewriting '.
1018 'result_namespace';
1019
1020     $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
1021     $code = slurp $file;
1022
1023     like $code, qr/sub a_method { 'mtfnpy' }/,
1024 'custom content from namespaced Result loaded into static dump correctly '.
1025 'when rewriting result_namespace';
1026
1027     like $code, qr/sub c_method { 'dongs' }/,
1028 'external content from unsingularized Result loaded into static dump correctly';
1029
1030     pop @INC;
1031 }
1032
1033 # test upgrading a v4 schema, the check that the version string is correct
1034 {
1035     write_v4_schema_pm();
1036     run_loader(dump_directory => $DUMP_DIR);
1037     my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
1038     my $schema = $res->{schema};
1039
1040     my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
1041     my $code = slurp $file;
1042
1043     my ($dumped_ver) =
1044         $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m;
1045
1046     is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION,
1047         'correct version dumped after upgrade of v4 static schema';
1048 }
1049
1050 # Test upgrading an already singular result with custom content that refers to
1051 # old class names.
1052 {
1053     write_v4_schema_pm();
1054     my $res = run_loader(dump_directory => $DUMP_DIR);
1055     my $schema   = $res->{schema};
1056     run_v4_tests($res);
1057
1058     # add some custom content to a Result that will be replaced
1059     my $bar_pm = $schema->_loader
1060         ->_get_dump_filename($res->{classes}{bar});
1061     {
1062         local ($^I, @ARGV) = ('.bak', $bar_pm);
1063         while (<>) {
1064             if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
1065                 print;
1066                 print <<EOF;
1067 sub a_method { 'lalala' }
1068
1069 __PACKAGE__->has_one('foorel3', 'DBIXCSL_Test::Schema::Foos',
1070     { 'foreign.fooid' => 'self.foo_id' });
1071 EOF
1072             }
1073             else {
1074                 print;
1075             }
1076         }
1077         close ARGV;
1078         unlink "${bar_pm}.bak" or die $^E;
1079     }
1080
1081     # now upgrade the schema
1082     $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
1083     $schema = $res->{schema};
1084     run_v5_tests($res);
1085
1086     # check that custom content was preserved
1087     lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'lalala' }
1088         'custom content was preserved from Result pre-upgrade';
1089
1090     lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel3,
1091         $res->{classes}{foos} }
1092 'unsingularized class names in custom content from Result with unchanged ' .
1093 'name are translated';
1094
1095     my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar});
1096     my $code = slurp $file;
1097
1098     like $code, qr/sub a_method { 'lalala' }/,
1099 'custom content from Result with unchanged name loaded into static dump ' .
1100 'correctly';
1101 }
1102
1103 done_testing;
1104
1105 END {
1106     rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
1107 }
1108
1109 sub run_loader {
1110     my %loader_opts = @_;
1111
1112     eval {
1113         foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
1114             Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
1115         }
1116
1117         Class::Unload->unload($SCHEMA_CLASS);
1118     };
1119     undef $@;
1120
1121     my @connect_info = $make_dbictest_db2::dsn;
1122     my @loader_warnings;
1123     local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
1124     eval qq{
1125         package $SCHEMA_CLASS;
1126         use base qw/DBIx::Class::Schema::Loader/;
1127
1128         __PACKAGE__->loader_options(\%loader_opts);
1129         __PACKAGE__->connection(\@connect_info);
1130     };
1131
1132     ok(!$@, "Loader initialization") or diag $@;
1133
1134     my $schema = $SCHEMA_CLASS->clone;
1135     my (%monikers, %classes);
1136     foreach my $source_name ($schema->sources) {
1137         my $table_name = $schema->source($source_name)->from;
1138         $monikers{$table_name} = $source_name;
1139         $classes{$table_name}  = $schema->source($source_name)->result_class;
1140     }
1141
1142     return {
1143         schema => $schema,
1144         warnings => \@loader_warnings,
1145         monikers => \%monikers,
1146         classes => \%classes,
1147     };
1148 }
1149
1150 sub write_v4_schema_pm {
1151     my %opts = @_;
1152
1153     (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//;
1154     rmtree $schema_dir;
1155     make_path $schema_dir;
1156     my $schema_pm = "$schema_dir/Schema.pm";
1157     open my $fh, '>', $schema_pm or die $!;
1158     if (not $opts{use_namespaces}) {
1159         print $fh <<'EOF';
1160 package DBIXCSL_Test::Schema;
1161
1162 use strict;
1163 use warnings;
1164
1165 use base 'DBIx::Class::Schema';
1166
1167 __PACKAGE__->load_classes;
1168
1169
1170 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-25 01:49:25
1171 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:ibIJTbfM1ji4pyD/lgSEog
1172
1173
1174 # You can replace this text with custom content, and it will be preserved on regeneration
1175 1;
1176 EOF
1177     }
1178     else {
1179         print $fh <<'EOF';
1180 package DBIXCSL_Test::Schema;
1181
1182 use strict;
1183 use warnings;
1184
1185 use base 'DBIx::Class::Schema';
1186
1187 __PACKAGE__->load_namespaces;
1188
1189
1190 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2010-01-12 16:04:12
1191 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d3wRVsHBNisyhxeaWJZcZQ
1192
1193
1194 # You can replace this text with custom content, and it will be preserved on
1195 # regeneration
1196 1;
1197 EOF
1198     }
1199 }
1200
1201 sub run_v4_tests {
1202     my $res = shift;
1203     my $schema = $res->{schema};
1204
1205     is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1206         [qw/Foos Bar Bazs Quuxs/],
1207         'correct monikers in 0.04006 mode';
1208
1209     isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }),
1210         $res->{classes}{bar},
1211         'found a bar');
1212
1213     isa_ok eval { $bar->foo_id }, $res->{classes}{foos},
1214         'correct rel name in 0.04006 mode';
1215
1216     ok my $baz  = eval { $schema->resultset('Bazs')->find(1) };
1217
1218     isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet',
1219         'correct rel type and name for UNIQUE FK in 0.04006 mode';
1220 }
1221
1222 sub run_v5_tests {
1223     my $res = shift;
1224     my $schema = $res->{schema};
1225
1226     is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1227         [qw/Foo Bar Baz Quux/],
1228         'correct monikers in current mode';
1229
1230     ok my $bar = eval { $schema->resultset('Bar')->find(1) };
1231
1232     isa_ok eval { $bar->foo }, $res->{classes}{foos},
1233         'correct rel name in current mode';
1234
1235     ok my $baz  = eval { $schema->resultset('Baz')->find(1) };
1236
1237     isa_ok eval { $baz->quux }, $res->{classes}{quuxs},
1238         'correct rel type and name for UNIQUE FK in current mode';
1239 }