5 use File::Path qw/rmtree make_path/;
7 use File::Temp qw/tempfile tempdir/;
9 use DBIx::Class::Schema::Loader ();
11 use make_dbictest_db2;
13 my $DUMP_DIR = './t/_common_dump';
15 my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema';
17 # test dynamic schema in 0.04006 mode
19 my $res = run_loader();
20 my $warning = $res->{warnings}[0];
22 like $warning, qr/dynamic schema/i,
23 'dynamic schema in backcompat mode detected';
24 like $warning, qr/run in 0\.04006 mode/i,
25 'dynamic schema in 0.04006 mode warning';
26 like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
27 'warning refers to upgrading doc';
32 # setting naming accessor on dynamic schema should disable warning (even when
33 # we're setting it to 'v4' .)
35 my $res = run_loader(naming => 'v4');
36 is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
40 # test upgraded dynamic schema
42 my $res = run_loader(naming => 'current');
43 is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
47 # test upgraded dynamic schema with external content loaded
49 my $temp_dir = tempdir;
52 my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
53 make_path $external_result_dir;
55 # make external content for Result that will be singularized
56 IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
57 package ${SCHEMA_CLASS}::Quuxs;
58 sub a_method { 'hlagh' }
60 __PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs',
61 { 'foreign.baz_num' => 'self.baz_id' });
66 # make external content for Result that will NOT be singularized
67 IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
68 package ${SCHEMA_CLASS}::Bar;
70 __PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos',
71 { 'foreign.fooid' => 'self.foo_id' });
76 my $res = run_loader(naming => 'current');
77 my $schema = $res->{schema};
79 is scalar @{ $res->{warnings} }, 1,
80 'correct nummber of warnings for upgraded dynamic schema with external ' .
81 'content for unsingularized Result.';
83 my $warning = $res->{warnings}[0];
84 like $warning, qr/Detected external content/i,
85 'detected external content warning';
87 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
88 'external custom content for unsingularized Result was loaded by upgraded ' .
91 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel,
92 $res->{classes}{bazs} }
93 'unsingularized class names in external content are translated';
95 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel,
96 $res->{classes}{foos} }
97 'unsingularized class names in external content from unchanged Result class ' .
98 'names are translated';
106 # test upgraded dynamic schema with use_namespaces with external content loaded
108 my $temp_dir = tempdir;
109 push @INC, $temp_dir;
111 my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
112 make_path $external_result_dir;
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' }
119 __PACKAGE__->has_one('bazrel4', 'DBIXCSL_Test::Schema::Bazs',
120 { 'foreign.baz_num' => 'self.baz_id' });
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;
129 __PACKAGE__->has_one('foorel4', 'DBIXCSL_Test::Schema::Foos',
130 { 'foreign.fooid' => 'self.foo_id' });
135 my $res = run_loader(naming => 'current', use_namespaces => 1);
136 my $schema = $res->{schema};
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.';
142 my $warning = $res->{warnings}[0];
143 like $warning, qr/Detected external content/i,
144 'detected external content warning';
146 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
147 'external custom content for unsingularized Result was loaded by upgraded ' .
150 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel4,
151 $res->{classes}{bazs} }
152 'unsingularized class names in external content are translated';
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';
166 # test upgraded static schema with external content loaded
168 my $temp_dir = tempdir;
169 push @INC, $temp_dir;
171 my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
172 make_path $external_result_dir;
174 # make external content for Result that will be singularized
175 IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
176 package ${SCHEMA_CLASS}::Quuxs;
177 sub a_method { 'dongs' }
179 __PACKAGE__->has_one('bazrel2', 'DBIXCSL_Test::Schema::Bazs',
180 { 'foreign.baz_num' => 'self.baz_id' });
185 # make external content for Result that will NOT be singularized
186 IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
187 package ${SCHEMA_CLASS}::Bar;
189 __PACKAGE__->has_one('foorel2', 'DBIXCSL_Test::Schema::Foos',
190 { 'foreign.fooid' => 'self.foo_id' });
195 write_v4_schema_pm();
197 my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
198 my $schema = $res->{schema};
202 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'dongs' }
203 'external custom content for unsingularized Result was loaded by upgraded ' .
206 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2,
207 $res->{classes}{bazs} }
208 'unsingularized class names in external content are translated';
210 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel2,
211 $res->{classes}{foos} }
212 'unsingularized class names in external content from unchanged Result class ' .
213 'names are translated in static schema';
215 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
216 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
218 like $code, qr/package ${SCHEMA_CLASS}::Quux;/,
219 'package line translated correctly from external custom content in static dump';
221 like $code, qr/sub a_method { 'dongs' }/,
222 'external custom content loaded into static dump correctly';
228 # test running against v4 schema without upgrade, twice, then upgrade
230 write_v4_schema_pm();
231 my $res = run_loader(dump_directory => $DUMP_DIR);
232 my $warning = $res->{warnings}[1];
234 like $warning, qr/static schema/i,
235 'static schema in backcompat mode detected';
236 like $warning, qr/0.04006/,
237 'correct version detected';
238 like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
239 'refers to upgrading doc';
241 is scalar @{ $res->{warnings} }, 4,
242 'correct number of warnings for static schema in backcompat mode';
246 # add some custom content to a Result that will be replaced
247 my $schema = $res->{schema};
248 my $quuxs_pm = $schema->_loader
249 ->_get_dump_filename($res->{classes}{quuxs});
251 local ($^I, @ARGV) = ('', $quuxs_pm);
253 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
256 sub a_method { 'mtfnpy' }
258 __PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
259 { 'foreign.baz_num' => 'self.baz_id' });
268 # Rerun the loader in backcompat mode to make sure it's still in backcompat
270 $res = run_loader(dump_directory => $DUMP_DIR);
273 # now upgrade the schema
275 dump_directory => $DUMP_DIR,
279 $schema = $res->{schema};
281 like $res->{warnings}[0], qr/Dumping manual schema/i,
282 'correct warnings on upgrading static schema (with "naming" set)';
284 like $res->{warnings}[1], qr/dump completed/i,
285 'correct warnings on upgrading static schema (with "naming" set)';
287 is scalar @{ $res->{warnings} }, 2,
288 'correct number of warnings on upgrading static schema (with "naming" set)'
289 or diag @{ $res->{warnings} };
293 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Result") =~ s{::}{/}g;
294 my $result_count =()= glob "$result_dir/*";
297 'un-singularized results were replaced during upgrade';
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';
303 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3,
304 $res->{classes}{bazs} }
305 'unsingularized class names in custom content are translated';
307 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
308 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
310 like $code, qr/sub a_method { 'mtfnpy' }/,
311 'custom content from unsingularized Result loaded into static dump correctly';
314 # test running against v4 schema without upgrade, then upgrade with
315 # use_namespaces not explicitly set
317 write_v4_schema_pm();
318 my $res = run_loader(dump_directory => $DUMP_DIR);
319 my $warning = $res->{warnings}[1];
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';
328 is scalar @{ $res->{warnings} }, 4,
329 'correct number of warnings for static schema in backcompat mode';
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});
338 local ($^I, @ARGV) = ('', $quuxs_pm);
340 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
343 sub a_method { 'mtfnpy' }
345 __PACKAGE__->has_one('bazrel5', 'DBIXCSL_Test::Schema::Bazs',
346 { 'foreign.baz_num' => 'self.baz_id' });
355 # now upgrade the schema
357 dump_directory => $DUMP_DIR,
360 $schema = $res->{schema};
362 like $res->{warnings}[0], qr/load_classes/i,
363 'correct warnings on upgrading static schema (with "naming" set and ' .
364 'use_namespaces not set)';
366 like $res->{warnings}[1], qr/Dumping manual schema/i,
367 'correct warnings on upgrading static schema (with "naming" set and ' .
368 'use_namespaces not set)';
370 like $res->{warnings}[2], qr/dump completed/i,
371 'correct warnings on upgrading static schema (with "naming" set and ' .
372 'use_namespaces not set)';
374 is scalar @{ $res->{warnings} }, 3,
375 'correct number of warnings on upgrading static schema (with "naming" set)'
376 or diag @{ $res->{warnings} };
380 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
381 my $result_count =()= glob "$result_dir/*";
384 'un-singularized results were replaced during upgrade';
386 # check that custom content was preserved
387 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
388 'custom content was carried over from un-singularized Result';
390 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel5,
391 $res->{classes}{bazs} }
392 'unsingularized class names in custom content are translated';
394 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
395 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
397 like $code, qr/sub a_method { 'mtfnpy' }/,
398 'custom content from unsingularized Result loaded into static dump correctly';
401 # test running against v4 schema with load_namespaces, upgrade to v5 but
402 # downgrade to load_classes
404 write_v4_schema_pm(use_namespaces => 1);
405 my $res = run_loader(dump_directory => $DUMP_DIR);
406 my $warning = $res->{warnings}[0];
408 like $warning, qr/static schema/i,
409 'static schema in backcompat mode detected';
410 like $warning, qr/0.04006/,
411 'correct version detected';
412 like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
413 'refers to upgrading doc';
415 is scalar @{ $res->{warnings} }, 3,
416 'correct number of warnings for static schema in backcompat mode';
420 # add some custom content to a Result that will be replaced
421 my $schema = $res->{schema};
422 my $quuxs_pm = $schema->_loader
423 ->_get_dump_filename($res->{classes}{quuxs});
425 local ($^I, @ARGV) = ('', $quuxs_pm);
427 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
430 sub a_method { 'mtfnpy' }
432 __PACKAGE__->has_one('bazrel6', 'DBIXCSL_Test::Schema::Result::Bazs',
433 { 'foreign.baz_num' => 'self.baz_id' });
442 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
443 'use_namespaces in backcompat mode';
445 # now upgrade the schema to v5 but downgrade to load_classes
447 dump_directory => $DUMP_DIR,
451 $schema = $res->{schema};
453 like $res->{warnings}[0], qr/Dumping manual schema/i,
454 'correct warnings on upgrading static schema (with "naming" set and ' .
455 'use_namespaces => 0)';
457 like $res->{warnings}[1], qr/dump completed/i,
458 'correct warnings on upgrading static schema (with "naming" set and ' .
459 'use_namespaces => 0)';
461 is scalar @{ $res->{warnings} }, 2,
462 'correct number of warnings on upgrading static schema (with "naming" set)'
463 or diag @{ $res->{warnings} };
467 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
468 my $result_count =()= glob "$result_dir/*";
471 'un-singularized results were replaced during upgrade and Result dir removed';
473 ok ((not -d "$result_dir/Result"),
474 'Result dir was removed for load_classes downgrade');
476 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
477 'load_classes in upgraded mode';
479 # check that custom content was preserved
480 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
481 'custom content was carried over from un-singularized Result';
483 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
484 $res->{classes}{bazs} }
485 'unsingularized class names in custom content are translated';
487 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
488 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
490 like $code, qr/sub a_method { 'mtfnpy' }/,
491 'custom content from unsingularized Result loaded into static dump correctly';
494 # test a regular schema with use_namespaces => 0 upgraded to
495 # use_namespaces => 1
500 my $res = run_loader(
501 dump_directory => $DUMP_DIR,
505 like $res->{warnings}[0], qr/Dumping manual schema/i,
506 'correct warnings on dumping static schema with use_namespaces => 0';
508 like $res->{warnings}[1], qr/dump completed/i,
509 'correct warnings on dumping static schema with use_namespaces => 0';
511 is scalar @{ $res->{warnings} }, 2,
512 'correct number of warnings on dumping static schema with use_namespaces => 0'
513 or diag @{ $res->{warnings} };
517 # add some custom content to a Result that will be replaced
518 my $schema = $res->{schema};
519 my $quuxs_pm = $schema->_loader
520 ->_get_dump_filename($res->{classes}{quuxs});
522 local ($^I, @ARGV) = ('', $quuxs_pm);
524 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
527 sub a_method { 'mtfnpy' }
529 __PACKAGE__->has_one('bazrel7', 'DBIXCSL_Test::Schema::Baz',
530 { 'foreign.baz_num' => 'self.baz_id' });
539 # test that with no use_namespaces option, there is a warning and
540 # load_classes is preserved
541 $res = run_loader(dump_directory => $DUMP_DIR);
543 like $res->{warnings}[0], qr/load_classes/i,
544 'correct warnings on re-dumping static schema with load_classes';
546 like $res->{warnings}[1], qr/Dumping manual schema/i,
547 'correct warnings on re-dumping static schema with load_classes';
549 like $res->{warnings}[2], qr/dump completed/i,
550 'correct warnings on re-dumping static schema with load_classes';
552 is scalar @{ $res->{warnings} }, 3,
553 'correct number of warnings on re-dumping static schema with load_classes'
554 or diag @{ $res->{warnings} };
556 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
557 'load_classes preserved on re-dump';
561 # now upgrade the schema to use_namespaces
563 dump_directory => $DUMP_DIR,
566 $schema = $res->{schema};
568 like $res->{warnings}[0], qr/Dumping manual schema/i,
569 'correct warnings on upgrading to use_namespaces';
571 like $res->{warnings}[1], qr/dump completed/i,
572 'correct warnings on upgrading to use_namespaces';
574 is scalar @{ $res->{warnings} }, 2,
575 'correct number of warnings on upgrading to use_namespaces'
576 or diag @{ $res->{warnings} };
580 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
581 my @schema_files = glob "$schema_dir/*";
583 is 1, (scalar @schema_files),
584 "schema dir $schema_dir contains only 1 entry";
586 like $schema_files[0], qr{/Result\z},
587 "schema dir contains only a Result/ directory";
589 # check that custom content was preserved
590 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
591 'custom content was carried over during use_namespaces upgrade';
593 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel7,
594 $res->{classes}{bazs} }
595 'un-namespaced class names in custom content are translated';
597 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
598 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
600 like $code, qr/sub a_method { 'mtfnpy' }/,
601 'custom content from un-namespaced Result loaded into static dump correctly';
604 # test a regular schema with default use_namespaces => 1, redump, and downgrade
610 my $res = run_loader(dump_directory => $DUMP_DIR);
612 like $res->{warnings}[0], qr/Dumping manual schema/i,
613 'correct warnings on dumping static schema';
615 like $res->{warnings}[1], qr/dump completed/i,
616 'correct warnings on dumping static schema';
618 is scalar @{ $res->{warnings} }, 2,
619 'correct number of warnings on dumping static schema'
620 or diag @{ $res->{warnings} };
624 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
625 'defaults to use_namespaces on regular dump';
627 # add some custom content to a Result that will be replaced
628 my $schema = $res->{schema};
629 my $quuxs_pm = $schema->_loader
630 ->_get_dump_filename($res->{classes}{quuxs});
632 local ($^I, @ARGV) = ('', $quuxs_pm);
634 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
637 sub a_method { 'mtfnpy' }
639 __PACKAGE__->has_one('bazrel8', 'DBIXCSL_Test::Schema::Result::Baz',
640 { 'foreign.baz_num' => 'self.baz_id' });
649 # test that with no use_namespaces option, use_namespaces is preserved
650 $res = run_loader(dump_directory => $DUMP_DIR);
652 like $res->{warnings}[0], qr/Dumping manual schema/i,
653 'correct warnings on re-dumping static schema';
655 like $res->{warnings}[1], qr/dump completed/i,
656 'correct warnings on re-dumping static schema';
658 is scalar @{ $res->{warnings} }, 2,
659 'correct number of warnings on re-dumping static schema'
660 or diag @{ $res->{warnings} };
662 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
663 'use_namespaces preserved on re-dump';
667 # now downgrade the schema to load_classes
669 dump_directory => $DUMP_DIR,
672 $schema = $res->{schema};
674 like $res->{warnings}[0], qr/Dumping manual schema/i,
675 'correct warnings on downgrading to load_classes';
677 like $res->{warnings}[1], qr/dump completed/i,
678 'correct warnings on downgrading to load_classes';
680 is scalar @{ $res->{warnings} }, 2,
681 'correct number of warnings on downgrading to load_classes'
682 or diag @{ $res->{warnings} };
686 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
687 'load_classes downgrade correct';
689 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
690 my $result_count =()= glob "$result_dir/*";
693 'correct number of Results after upgrade and Result dir removed';
695 ok ((not -d "$result_dir/Result"),
696 'Result dir was removed for load_classes downgrade');
698 # check that custom content was preserved
699 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
700 'custom content was carried over during load_classes downgrade';
702 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel8,
703 $res->{classes}{bazs} }
704 'namespaced class names in custom content are translated during load_classes '.
707 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
708 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
710 like $code, qr/sub a_method { 'mtfnpy' }/,
711 'custom content from namespaced Result loaded into static dump correctly '.
712 'during load_classes downgrade';
715 # test a regular schema with use_namespaces => 1 and a custom result_namespace
716 # downgraded to load_classes
721 my $res = run_loader(
722 dump_directory => $DUMP_DIR,
723 result_namespace => 'MyResult',
726 like $res->{warnings}[0], qr/Dumping manual schema/i,
727 'correct warnings on dumping static schema';
729 like $res->{warnings}[1], qr/dump completed/i,
730 'correct warnings on dumping static schema';
732 is scalar @{ $res->{warnings} }, 2,
733 'correct number of warnings on dumping static schema'
734 or diag @{ $res->{warnings} };
738 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
739 'defaults to use_namespaces and uses custom result_namespace';
741 # add some custom content to a Result that will be replaced
742 my $schema = $res->{schema};
743 my $quuxs_pm = $schema->_loader
744 ->_get_dump_filename($res->{classes}{quuxs});
746 local ($^I, @ARGV) = ('', $quuxs_pm);
748 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
751 sub a_method { 'mtfnpy' }
753 __PACKAGE__->has_one('bazrel9', 'DBIXCSL_Test::Schema::MyResult::Baz',
754 { 'foreign.baz_num' => 'self.baz_id' });
763 # test that with no use_namespaces option, use_namespaces is preserved, and
764 # the custom result_namespace is preserved
765 $res = run_loader(dump_directory => $DUMP_DIR);
767 like $res->{warnings}[0], qr/Dumping manual schema/i,
768 'correct warnings on re-dumping static schema';
770 like $res->{warnings}[1], qr/dump completed/i,
771 'correct warnings on re-dumping static schema';
773 is scalar @{ $res->{warnings} }, 2,
774 'correct number of warnings on re-dumping static schema'
775 or diag @{ $res->{warnings} };
777 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
778 'use_namespaces and custom result_namespace preserved on re-dump';
782 # now downgrade the schema to load_classes
784 dump_directory => $DUMP_DIR,
787 $schema = $res->{schema};
789 like $res->{warnings}[0], qr/Dumping manual schema/i,
790 'correct warnings on downgrading to load_classes';
792 like $res->{warnings}[1], qr/dump completed/i,
793 'correct warnings on downgrading to load_classes';
795 is scalar @{ $res->{warnings} }, 2,
796 'correct number of warnings on downgrading to load_classes'
797 or diag @{ $res->{warnings} };
801 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
802 'load_classes downgrade correct';
804 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
805 my $result_count =()= glob "$result_dir/*";
808 'correct number of Results after upgrade and Result dir removed';
810 ok ((not -d "$result_dir/MyResult"),
811 'Result dir was removed for load_classes downgrade');
813 # check that custom content was preserved
814 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
815 'custom content was carried over during load_classes downgrade';
817 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel9,
818 $res->{classes}{bazs} }
819 'namespaced class names in custom content are translated during load_classes '.
822 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
823 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
825 like $code, qr/sub a_method { 'mtfnpy' }/,
826 'custom content from namespaced Result loaded into static dump correctly '.
827 'during load_classes downgrade';
830 # rewrite from one result_namespace to another
835 my $res = run_loader(dump_directory => $DUMP_DIR);
837 # add some custom content to a Result that will be replaced
838 my $schema = $res->{schema};
839 my $quuxs_pm = $schema->_loader
840 ->_get_dump_filename($res->{classes}{quuxs});
842 local ($^I, @ARGV) = ('', $quuxs_pm);
844 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
847 sub a_method { 'mtfnpy' }
849 __PACKAGE__->has_one('bazrel10', 'DBIXCSL_Test::Schema::Result::Baz',
850 { 'foreign.baz_num' => 'self.baz_id' });
859 # Rewrite implicit 'Result' to 'MyResult'
861 dump_directory => $DUMP_DIR,
862 result_namespace => 'MyResult',
864 $schema = $res->{schema};
866 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
867 'using new result_namespace';
869 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
870 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/MyResult") =~ s{::}{/}g;
871 my $result_count =()= glob "$result_dir/*";
874 'correct number of Results after rewritten result_namespace';
876 ok ((not -d "$schema_dir/Result"),
877 'original Result dir was removed when rewriting result_namespace');
879 # check that custom content was preserved
880 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
881 'custom content was carried over when rewriting result_namespace';
883 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
884 $res->{classes}{bazs} }
885 'class names in custom content are translated when rewriting result_namespace';
887 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
888 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
890 like $code, qr/sub a_method { 'mtfnpy' }/,
891 'custom content from namespaced Result loaded into static dump correctly '.
892 'when rewriting result_namespace';
894 # Now rewrite 'MyResult' to 'Mtfnpy'
896 dump_directory => $DUMP_DIR,
897 result_namespace => 'Mtfnpy',
899 $schema = $res->{schema};
901 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux',
902 'using new result_namespace';
904 ($schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
905 ($result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Mtfnpy") =~ s{::}{/}g;
906 $result_count =()= glob "$result_dir/*";
909 'correct number of Results after rewritten result_namespace';
911 ok ((not -d "$schema_dir/MyResult"),
912 'original Result dir was removed when rewriting result_namespace');
914 # check that custom content was preserved
915 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
916 'custom content was carried over when rewriting result_namespace';
918 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
919 $res->{classes}{bazs} }
920 'class names in custom content are translated when rewriting result_namespace';
922 $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
923 $code = do { local ($/, @ARGV) = (undef, $file); <> };
925 like $code, qr/sub a_method { 'mtfnpy' }/,
926 'custom content from namespaced Result loaded into static dump correctly '.
927 'when rewriting result_namespace';
930 # test upgrading a v4 schema, the check that the version string is correct
932 write_v4_schema_pm();
933 run_loader(dump_directory => $DUMP_DIR);
934 my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
935 my $schema = $res->{schema};
937 my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
938 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
941 $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m;
943 is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION,
944 'correct version dumped after upgrade of v4 static schema';
947 # Test upgrading an already singular result with custom content that refers to
950 write_v4_schema_pm();
951 my $res = run_loader(dump_directory => $DUMP_DIR);
952 my $schema = $res->{schema};
955 # add some custom content to a Result that will be replaced
956 my $bar_pm = $schema->_loader
957 ->_get_dump_filename($res->{classes}{bar});
959 local ($^I, @ARGV) = ('', $bar_pm);
961 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
964 sub a_method { 'lalala' }
966 __PACKAGE__->has_one('foorel3', 'DBIXCSL_Test::Schema::Foos',
967 { 'foreign.fooid' => 'self.foo_id' });
976 # now upgrade the schema
977 $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
978 $schema = $res->{schema};
981 # check that custom content was preserved
982 lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'lalala' }
983 'custom content was preserved from Result pre-upgrade';
985 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel3,
986 $res->{classes}{foos} }
987 'unsingularized class names in custom content from Result with unchanged ' .
988 'name are translated';
990 my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar});
991 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
993 like $code, qr/sub a_method { 'lalala' }/,
994 'custom content from Result with unchanged name loaded into static dump ' .
1001 rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
1005 my %loader_opts = @_;
1008 foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
1009 Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
1012 Class::Unload->unload($SCHEMA_CLASS);
1016 my @connect_info = $make_dbictest_db2::dsn;
1017 my @loader_warnings;
1018 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
1020 package $SCHEMA_CLASS;
1021 use base qw/DBIx::Class::Schema::Loader/;
1023 __PACKAGE__->loader_options(\%loader_opts);
1024 __PACKAGE__->connection(\@connect_info);
1027 ok(!$@, "Loader initialization") or diag $@;
1029 my $schema = $SCHEMA_CLASS->clone;
1030 my (%monikers, %classes);
1031 foreach my $source_name ($schema->sources) {
1032 my $table_name = $schema->source($source_name)->from;
1033 $monikers{$table_name} = $source_name;
1034 $classes{$table_name} = $schema->source($source_name)->result_class;
1039 warnings => \@loader_warnings,
1040 monikers => \%monikers,
1041 classes => \%classes,
1045 sub write_v4_schema_pm {
1048 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//;
1050 make_path $schema_dir;
1051 my $schema_pm = "$schema_dir/Schema.pm";
1052 open my $fh, '>', $schema_pm or die $!;
1053 if (not $opts{use_namespaces}) {
1055 package DBIXCSL_Test::Schema;
1060 use base 'DBIx::Class::Schema';
1062 __PACKAGE__->load_classes;
1065 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-25 01:49:25
1066 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:ibIJTbfM1ji4pyD/lgSEog
1069 # You can replace this text with custom content, and it will be preserved on regeneration
1075 package DBIXCSL_Test::Schema;
1080 use base 'DBIx::Class::Schema';
1082 __PACKAGE__->load_namespaces;
1085 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2010-01-12 16:04:12
1086 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d3wRVsHBNisyhxeaWJZcZQ
1089 # You can replace this text with custom content, and it will be preserved on
1098 my $schema = $res->{schema};
1100 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1101 [qw/Foos Bar Bazs Quuxs/],
1102 'correct monikers in 0.04006 mode';
1104 isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }),
1105 $res->{classes}{bar},
1108 isa_ok eval { $bar->foo_id }, $res->{classes}{foos},
1109 'correct rel name in 0.04006 mode';
1111 ok my $baz = eval { $schema->resultset('Bazs')->find(1) };
1113 isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet',
1114 'correct rel type and name for UNIQUE FK in 0.04006 mode';
1119 my $schema = $res->{schema};
1121 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1122 [qw/Foo Bar Baz Quux/],
1123 'correct monikers in current mode';
1125 ok my $bar = eval { $schema->resultset('Bar')->find(1) };
1127 isa_ok eval { $bar->foo }, $res->{classes}{foos},
1128 'correct rel name in current mode';
1130 ok my $baz = eval { $schema->resultset('Baz')->find(1) };
1132 isa_ok eval { $baz->quux }, $res->{classes}{quuxs},
1133 'correct rel type and name for UNIQUE FK in current mode';