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, with external content
404 my $temp_dir = tempdir;
405 push @INC, $temp_dir;
407 my $external_result_dir = join '/', $temp_dir, split /::/,
408 "${SCHEMA_CLASS}::Result";
410 make_path $external_result_dir;
412 # make external content for Result that will be singularized
413 IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
414 package ${SCHEMA_CLASS}::Result::Quuxs;
415 sub b_method { 'dongs' }
417 __PACKAGE__->has_one('bazrel11', 'DBIXCSL_Test::Schema::Result::Bazs',
418 { 'foreign.baz_num' => 'self.baz_id' });
423 # make external content for Result that will NOT be singularized
424 IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
425 package ${SCHEMA_CLASS}::Result::Bar;
427 __PACKAGE__->has_one('foorel5', 'DBIXCSL_Test::Schema::Result::Foos',
428 { 'foreign.fooid' => 'self.foo_id' });
433 write_v4_schema_pm(use_namespaces => 1);
435 my $res = run_loader(dump_directory => $DUMP_DIR);
436 my $warning = $res->{warnings}[0];
438 like $warning, qr/static schema/i,
439 'static schema in backcompat mode detected';
440 like $warning, qr/0.04006/,
441 'correct version detected';
442 like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
443 'refers to upgrading doc';
445 is scalar @{ $res->{warnings} }, 3,
446 'correct number of warnings for static schema in backcompat mode';
450 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
451 'use_namespaces in backcompat mode';
453 # add some custom content to a Result that will be replaced
454 my $schema = $res->{schema};
455 my $quuxs_pm = $schema->_loader
456 ->_get_dump_filename($res->{classes}{quuxs});
458 local ($^I, @ARGV) = ('', $quuxs_pm);
460 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
463 sub a_method { 'mtfnpy' }
465 __PACKAGE__->has_one('bazrel6', 'DBIXCSL_Test::Schema::Result::Bazs',
466 { 'foreign.baz_num' => 'self.baz_id' });
475 # now upgrade the schema to v5 but downgrade to load_classes
477 dump_directory => $DUMP_DIR,
481 $schema = $res->{schema};
483 like $res->{warnings}[0], qr/Dumping manual schema/i,
484 'correct warnings on upgrading static schema (with "naming" set and ' .
485 'use_namespaces => 0)';
487 like $res->{warnings}[1], qr/dump completed/i,
488 'correct warnings on upgrading static schema (with "naming" set and ' .
489 'use_namespaces => 0)';
491 is scalar @{ $res->{warnings} }, 2,
492 'correct number of warnings on upgrading static schema (with "naming" set)'
493 or diag @{ $res->{warnings} };
497 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
498 my $result_count =()= glob "$result_dir/*";
501 'un-singularized results were replaced during upgrade and Result dir removed';
503 ok ((not -d "$result_dir/Result"),
504 'Result dir was removed for load_classes downgrade');
506 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
507 'load_classes in upgraded mode';
509 # check that custom and external content was preserved
510 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
511 'custom content was carried over from un-singularized Result';
513 lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' }
514 'external content was carried over from un-singularized Result';
516 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
517 $res->{classes}{bazs} }
518 'unsingularized class names in custom content are translated';
520 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel11,
521 $res->{classes}{bazs} }
522 'unsingularized class names in external content are translated';
524 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel5,
525 $res->{classes}{foos} }
526 'unsingularized class names in external content from unchanged Result class ' .
527 'names are translated in static schema';
529 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
530 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
532 like $code, qr/sub a_method { 'mtfnpy' }/,
533 'custom content from unsingularized Result loaded into static dump correctly';
535 like $code, qr/sub b_method { 'dongs' }/,
536 'external content from unsingularized Result loaded into static dump correctly';
542 # test a regular schema with use_namespaces => 0 upgraded to
543 # use_namespaces => 1
548 my $res = run_loader(
549 dump_directory => $DUMP_DIR,
553 like $res->{warnings}[0], qr/Dumping manual schema/i,
554 'correct warnings on dumping static schema with use_namespaces => 0';
556 like $res->{warnings}[1], qr/dump completed/i,
557 'correct warnings on dumping static schema with use_namespaces => 0';
559 is scalar @{ $res->{warnings} }, 2,
560 'correct number of warnings on dumping static schema with use_namespaces => 0'
561 or diag @{ $res->{warnings} };
565 # add some custom content to a Result that will be replaced
566 my $schema = $res->{schema};
567 my $quuxs_pm = $schema->_loader
568 ->_get_dump_filename($res->{classes}{quuxs});
570 local ($^I, @ARGV) = ('', $quuxs_pm);
572 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
575 sub a_method { 'mtfnpy' }
577 __PACKAGE__->has_one('bazrel7', 'DBIXCSL_Test::Schema::Baz',
578 { 'foreign.baz_num' => 'self.baz_id' });
587 # test that with no use_namespaces option, there is a warning and
588 # load_classes is preserved
589 $res = run_loader(dump_directory => $DUMP_DIR);
591 like $res->{warnings}[0], qr/load_classes/i,
592 'correct warnings on re-dumping static schema with load_classes';
594 like $res->{warnings}[1], qr/Dumping manual schema/i,
595 'correct warnings on re-dumping static schema with load_classes';
597 like $res->{warnings}[2], qr/dump completed/i,
598 'correct warnings on re-dumping static schema with load_classes';
600 is scalar @{ $res->{warnings} }, 3,
601 'correct number of warnings on re-dumping static schema with load_classes'
602 or diag @{ $res->{warnings} };
604 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
605 'load_classes preserved on re-dump';
609 # now upgrade the schema to use_namespaces
611 dump_directory => $DUMP_DIR,
614 $schema = $res->{schema};
616 like $res->{warnings}[0], qr/Dumping manual schema/i,
617 'correct warnings on upgrading to use_namespaces';
619 like $res->{warnings}[1], qr/dump completed/i,
620 'correct warnings on upgrading to use_namespaces';
622 is scalar @{ $res->{warnings} }, 2,
623 'correct number of warnings on upgrading to use_namespaces'
624 or diag @{ $res->{warnings} };
628 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
629 my @schema_files = glob "$schema_dir/*";
631 is 1, (scalar @schema_files),
632 "schema dir $schema_dir contains only 1 entry";
634 like $schema_files[0], qr{/Result\z},
635 "schema dir contains only a Result/ directory";
637 # check that custom content was preserved
638 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
639 'custom content was carried over during use_namespaces upgrade';
641 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel7,
642 $res->{classes}{bazs} }
643 'un-namespaced class names in custom content are translated';
645 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
646 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
648 like $code, qr/sub a_method { 'mtfnpy' }/,
649 'custom content from un-namespaced Result loaded into static dump correctly';
652 # test a regular schema with default use_namespaces => 1, redump, and downgrade
658 my $res = run_loader(dump_directory => $DUMP_DIR);
660 like $res->{warnings}[0], qr/Dumping manual schema/i,
661 'correct warnings on dumping static schema';
663 like $res->{warnings}[1], qr/dump completed/i,
664 'correct warnings on dumping static schema';
666 is scalar @{ $res->{warnings} }, 2,
667 'correct number of warnings on dumping static schema'
668 or diag @{ $res->{warnings} };
672 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
673 'defaults to use_namespaces on regular dump';
675 # add some custom content to a Result that will be replaced
676 my $schema = $res->{schema};
677 my $quuxs_pm = $schema->_loader
678 ->_get_dump_filename($res->{classes}{quuxs});
680 local ($^I, @ARGV) = ('', $quuxs_pm);
682 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
685 sub a_method { 'mtfnpy' }
687 __PACKAGE__->has_one('bazrel8', 'DBIXCSL_Test::Schema::Result::Baz',
688 { 'foreign.baz_num' => 'self.baz_id' });
697 # test that with no use_namespaces option, use_namespaces is preserved
698 $res = run_loader(dump_directory => $DUMP_DIR);
700 like $res->{warnings}[0], qr/Dumping manual schema/i,
701 'correct warnings on re-dumping static schema';
703 like $res->{warnings}[1], qr/dump completed/i,
704 'correct warnings on re-dumping static schema';
706 is scalar @{ $res->{warnings} }, 2,
707 'correct number of warnings on re-dumping static schema'
708 or diag @{ $res->{warnings} };
710 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
711 'use_namespaces preserved on re-dump';
715 # now downgrade the schema to load_classes
717 dump_directory => $DUMP_DIR,
720 $schema = $res->{schema};
722 like $res->{warnings}[0], qr/Dumping manual schema/i,
723 'correct warnings on downgrading to load_classes';
725 like $res->{warnings}[1], qr/dump completed/i,
726 'correct warnings on downgrading to load_classes';
728 is scalar @{ $res->{warnings} }, 2,
729 'correct number of warnings on downgrading to load_classes'
730 or diag @{ $res->{warnings} };
734 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
735 'load_classes downgrade correct';
737 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
738 my $result_count =()= glob "$result_dir/*";
741 'correct number of Results after upgrade and Result dir removed';
743 ok ((not -d "$result_dir/Result"),
744 'Result dir was removed for load_classes downgrade');
746 # check that custom content was preserved
747 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
748 'custom content was carried over during load_classes downgrade';
750 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel8,
751 $res->{classes}{bazs} }
752 'namespaced class names in custom content are translated during load_classes '.
755 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
756 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
758 like $code, qr/sub a_method { 'mtfnpy' }/,
759 'custom content from namespaced Result loaded into static dump correctly '.
760 'during load_classes downgrade';
763 # test a regular schema with use_namespaces => 1 and a custom result_namespace
764 # downgraded to load_classes
769 my $res = run_loader(
770 dump_directory => $DUMP_DIR,
771 result_namespace => 'MyResult',
774 like $res->{warnings}[0], qr/Dumping manual schema/i,
775 'correct warnings on dumping static schema';
777 like $res->{warnings}[1], qr/dump completed/i,
778 'correct warnings on dumping static schema';
780 is scalar @{ $res->{warnings} }, 2,
781 'correct number of warnings on dumping static schema'
782 or diag @{ $res->{warnings} };
786 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
787 'defaults to use_namespaces and uses custom result_namespace';
789 # add some custom content to a Result that will be replaced
790 my $schema = $res->{schema};
791 my $quuxs_pm = $schema->_loader
792 ->_get_dump_filename($res->{classes}{quuxs});
794 local ($^I, @ARGV) = ('', $quuxs_pm);
796 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
799 sub a_method { 'mtfnpy' }
801 __PACKAGE__->has_one('bazrel9', 'DBIXCSL_Test::Schema::MyResult::Baz',
802 { 'foreign.baz_num' => 'self.baz_id' });
811 # test that with no use_namespaces option, use_namespaces is preserved, and
812 # the custom result_namespace is preserved
813 $res = run_loader(dump_directory => $DUMP_DIR);
815 like $res->{warnings}[0], qr/Dumping manual schema/i,
816 'correct warnings on re-dumping static schema';
818 like $res->{warnings}[1], qr/dump completed/i,
819 'correct warnings on re-dumping static schema';
821 is scalar @{ $res->{warnings} }, 2,
822 'correct number of warnings on re-dumping static schema'
823 or diag @{ $res->{warnings} };
825 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
826 'use_namespaces and custom result_namespace preserved on re-dump';
830 # now downgrade the schema to load_classes
832 dump_directory => $DUMP_DIR,
835 $schema = $res->{schema};
837 like $res->{warnings}[0], qr/Dumping manual schema/i,
838 'correct warnings on downgrading to load_classes';
840 like $res->{warnings}[1], qr/dump completed/i,
841 'correct warnings on downgrading to load_classes';
843 is scalar @{ $res->{warnings} }, 2,
844 'correct number of warnings on downgrading to load_classes'
845 or diag @{ $res->{warnings} };
849 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
850 'load_classes downgrade correct';
852 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
853 my $result_count =()= glob "$result_dir/*";
856 'correct number of Results after upgrade and Result dir removed';
858 ok ((not -d "$result_dir/MyResult"),
859 'Result dir was removed for load_classes downgrade');
861 # check that custom content was preserved
862 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
863 'custom content was carried over during load_classes downgrade';
865 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel9,
866 $res->{classes}{bazs} }
867 'namespaced class names in custom content are translated during load_classes '.
870 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
871 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
873 like $code, qr/sub a_method { 'mtfnpy' }/,
874 'custom content from namespaced Result loaded into static dump correctly '.
875 'during load_classes downgrade';
878 # rewrite from one result_namespace to another, with external content
882 my $temp_dir = tempdir;
883 push @INC, $temp_dir;
885 my $external_result_dir = join '/', $temp_dir, split /::/,
886 "${SCHEMA_CLASS}::Result";
888 make_path $external_result_dir;
890 # make external content for Result that will be singularized
891 IO::File->new(">$external_result_dir/Quux.pm")->print(<<"EOF");
892 package ${SCHEMA_CLASS}::Result::Quux;
893 sub c_method { 'dongs' }
895 __PACKAGE__->has_one('bazrel12', 'DBIXCSL_Test::Schema::Result::Baz',
896 { 'foreign.baz_num' => 'self.baz_id' });
901 # make external content for Result that will NOT be singularized
902 IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
903 package ${SCHEMA_CLASS}::Result::Bar;
905 __PACKAGE__->has_one('foorel6', 'DBIXCSL_Test::Schema::Result::Foo',
906 { 'foreign.fooid' => 'self.foo_id' });
911 my $res = run_loader(dump_directory => $DUMP_DIR);
913 # add some custom content to a Result that will be replaced
914 my $schema = $res->{schema};
915 my $quuxs_pm = $schema->_loader
916 ->_get_dump_filename($res->{classes}{quuxs});
918 local ($^I, @ARGV) = ('', $quuxs_pm);
920 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
923 sub a_method { 'mtfnpy' }
925 __PACKAGE__->has_one('bazrel10', 'DBIXCSL_Test::Schema::Result::Baz',
926 { 'foreign.baz_num' => 'self.baz_id' });
935 # Rewrite implicit 'Result' to 'MyResult'
937 dump_directory => $DUMP_DIR,
938 result_namespace => 'MyResult',
940 $schema = $res->{schema};
942 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
943 'using new result_namespace';
945 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
946 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/MyResult") =~ s{::}{/}g;
947 my $result_count =()= glob "$result_dir/*";
950 'correct number of Results after rewritten result_namespace';
952 ok ((not -d "$schema_dir/Result"),
953 'original Result dir was removed when rewriting result_namespace');
955 # check that custom content was preserved
956 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
957 'custom content was carried over when rewriting result_namespace';
959 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
960 $res->{classes}{bazs} }
961 'class names in custom content are translated when rewriting result_namespace';
963 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
964 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
966 like $code, qr/sub a_method { 'mtfnpy' }/,
967 'custom content from namespaced Result loaded into static dump correctly '.
968 'when rewriting result_namespace';
970 # Now rewrite 'MyResult' to 'Mtfnpy'
972 dump_directory => $DUMP_DIR,
973 result_namespace => 'Mtfnpy',
975 $schema = $res->{schema};
977 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux',
978 'using new result_namespace';
980 ($schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
981 ($result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Mtfnpy") =~ s{::}{/}g;
982 $result_count =()= glob "$result_dir/*";
985 'correct number of Results after rewritten result_namespace';
987 ok ((not -d "$schema_dir/MyResult"),
988 'original Result dir was removed when rewriting result_namespace');
990 # check that custom and external content was preserved
991 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
992 'custom content was carried over when rewriting result_namespace';
994 lives_and { is $schema->resultset('Quux')->find(1)->c_method, 'dongs' }
995 'custom content was carried over when rewriting result_namespace';
997 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
998 $res->{classes}{bazs} }
999 'class names in custom content are translated when rewriting result_namespace';
1001 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel12,
1002 $res->{classes}{bazs} }
1003 'class names in external content are translated when rewriting '.
1006 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel6,
1007 $res->{classes}{foos} }
1008 'class names in external content are translated when rewriting '.
1011 $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
1012 $code = do { local ($/, @ARGV) = (undef, $file); <> };
1014 like $code, qr/sub a_method { 'mtfnpy' }/,
1015 'custom content from namespaced Result loaded into static dump correctly '.
1016 'when rewriting result_namespace';
1018 like $code, qr/sub c_method { 'dongs' }/,
1019 'external content from unsingularized Result loaded into static dump correctly';
1025 # test upgrading a v4 schema, the check that the version string is correct
1027 write_v4_schema_pm();
1028 run_loader(dump_directory => $DUMP_DIR);
1029 my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
1030 my $schema = $res->{schema};
1032 my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
1033 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
1036 $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m;
1038 is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION,
1039 'correct version dumped after upgrade of v4 static schema';
1042 # Test upgrading an already singular result with custom content that refers to
1045 write_v4_schema_pm();
1046 my $res = run_loader(dump_directory => $DUMP_DIR);
1047 my $schema = $res->{schema};
1050 # add some custom content to a Result that will be replaced
1051 my $bar_pm = $schema->_loader
1052 ->_get_dump_filename($res->{classes}{bar});
1054 local ($^I, @ARGV) = ('', $bar_pm);
1056 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
1059 sub a_method { 'lalala' }
1061 __PACKAGE__->has_one('foorel3', 'DBIXCSL_Test::Schema::Foos',
1062 { 'foreign.fooid' => 'self.foo_id' });
1071 # now upgrade the schema
1072 $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
1073 $schema = $res->{schema};
1076 # check that custom content was preserved
1077 lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'lalala' }
1078 'custom content was preserved from Result pre-upgrade';
1080 lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel3,
1081 $res->{classes}{foos} }
1082 'unsingularized class names in custom content from Result with unchanged ' .
1083 'name are translated';
1085 my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar});
1086 my $code = do { local ($/, @ARGV) = (undef, $file); <> };
1088 like $code, qr/sub a_method { 'lalala' }/,
1089 'custom content from Result with unchanged name loaded into static dump ' .
1096 rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
1100 my %loader_opts = @_;
1103 foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
1104 Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
1107 Class::Unload->unload($SCHEMA_CLASS);
1111 my @connect_info = $make_dbictest_db2::dsn;
1112 my @loader_warnings;
1113 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
1115 package $SCHEMA_CLASS;
1116 use base qw/DBIx::Class::Schema::Loader/;
1118 __PACKAGE__->loader_options(\%loader_opts);
1119 __PACKAGE__->connection(\@connect_info);
1122 ok(!$@, "Loader initialization") or diag $@;
1124 my $schema = $SCHEMA_CLASS->clone;
1125 my (%monikers, %classes);
1126 foreach my $source_name ($schema->sources) {
1127 my $table_name = $schema->source($source_name)->from;
1128 $monikers{$table_name} = $source_name;
1129 $classes{$table_name} = $schema->source($source_name)->result_class;
1134 warnings => \@loader_warnings,
1135 monikers => \%monikers,
1136 classes => \%classes,
1140 sub write_v4_schema_pm {
1143 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//;
1145 make_path $schema_dir;
1146 my $schema_pm = "$schema_dir/Schema.pm";
1147 open my $fh, '>', $schema_pm or die $!;
1148 if (not $opts{use_namespaces}) {
1150 package DBIXCSL_Test::Schema;
1155 use base 'DBIx::Class::Schema';
1157 __PACKAGE__->load_classes;
1160 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-25 01:49:25
1161 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:ibIJTbfM1ji4pyD/lgSEog
1164 # You can replace this text with custom content, and it will be preserved on regeneration
1170 package DBIXCSL_Test::Schema;
1175 use base 'DBIx::Class::Schema';
1177 __PACKAGE__->load_namespaces;
1180 # Created by DBIx::Class::Schema::Loader v0.04006 @ 2010-01-12 16:04:12
1181 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d3wRVsHBNisyhxeaWJZcZQ
1184 # You can replace this text with custom content, and it will be preserved on
1193 my $schema = $res->{schema};
1195 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1196 [qw/Foos Bar Bazs Quuxs/],
1197 'correct monikers in 0.04006 mode';
1199 isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }),
1200 $res->{classes}{bar},
1203 isa_ok eval { $bar->foo_id }, $res->{classes}{foos},
1204 'correct rel name in 0.04006 mode';
1206 ok my $baz = eval { $schema->resultset('Bazs')->find(1) };
1208 isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet',
1209 'correct rel type and name for UNIQUE FK in 0.04006 mode';
1214 my $schema = $res->{schema};
1216 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1217 [qw/Foo Bar Baz Quux/],
1218 'correct monikers in current mode';
1220 ok my $bar = eval { $schema->resultset('Bar')->find(1) };
1222 isa_ok eval { $bar->foo }, $res->{classes}{foos},
1223 'correct rel name in current mode';
1225 ok my $baz = eval { $schema->resultset('Baz')->find(1) };
1227 isa_ok eval { $baz->quux }, $res->{classes}{quuxs},
1228 'correct rel type and name for UNIQUE FK in current mode';