5 use File::Path qw/rmtree make_path/;
7 use File::Temp qw/tempfile tempdir/;
9 use File::Slurp 'slurp';
10 use DBIx::Class::Schema::Loader ();
12 use make_dbictest_db2;
14 my $DUMP_DIR = './t/_common_dump';
16 my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema';
18 # test dynamic schema in 0.04006 mode
20 my $res = run_loader();
21 my $warning = $res->{warnings}[0];
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';
33 # setting naming accessor on dynamic schema should disable warning (even when
34 # we're setting it to 'v4' .)
36 my $res = run_loader(naming => 'v4');
37 is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
41 # test upgraded dynamic schema
43 my $res = run_loader(naming => 'current');
44 is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
48 # test upgraded dynamic schema with external content loaded
50 my $temp_dir = tempdir(CLEANUP => 1);
53 my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
54 make_path $external_result_dir;
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' }
61 __PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs',
62 { 'foreign.baz_num' => 'self.baz_id' });
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;
71 __PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos',
72 { 'foreign.fooid' => 'self.foo_id' });
77 my $res = run_loader(naming => 'current');
78 my $schema = $res->{schema};
80 is scalar @{ $res->{warnings} }, 1,
81 'correct nummber of warnings for upgraded dynamic schema with external ' .
82 'content for unsingularized Result.';
84 my $warning = $res->{warnings}[0];
85 like $warning, qr/Detected external content/i,
86 'detected external content warning';
88 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
89 'external custom content for unsingularized Result was loaded by upgraded ' .
92 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel,
93 $res->{classes}{bazs} }
94 'unsingularized class names in external content are translated';
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';
106 # test upgraded dynamic schema with use_namespaces with external content loaded
108 my $temp_dir = tempdir(CLEANUP => 1);
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';
165 # test upgraded static schema with external content loaded
167 my $temp_dir = tempdir(CLEANUP => 1);
168 push @INC, $temp_dir;
170 my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
171 make_path $external_result_dir;
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' }
178 __PACKAGE__->has_one('bazrel2', 'DBIXCSL_Test::Schema::Bazs',
179 { 'foreign.baz_num' => 'self.baz_id' });
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;
188 __PACKAGE__->has_one('foorel2', 'DBIXCSL_Test::Schema::Foos',
189 { 'foreign.fooid' => 'self.foo_id' });
194 write_v4_schema_pm();
196 my $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
197 my $schema = $res->{schema};
201 lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'dongs' }
202 'external custom content for unsingularized Result was loaded by upgraded ' .
205 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2,
206 $res->{classes}{bazs} }
207 'unsingularized class names in external content are translated';
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';
214 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
215 my $code = slurp $file;
217 like $code, qr/package ${SCHEMA_CLASS}::Quux;/,
218 'package line translated correctly from external custom content in static dump';
220 like $code, qr/sub a_method { 'dongs' }/,
221 'external custom content loaded into static dump correctly';
226 # test running against v4 schema without upgrade, twice, then upgrade
228 write_v4_schema_pm();
229 my $res = run_loader(dump_directory => $DUMP_DIR);
230 my $warning = $res->{warnings}[1];
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';
239 is scalar @{ $res->{warnings} }, 4,
240 'correct number of warnings for static schema in backcompat mode';
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});
249 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
251 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
254 sub a_method { 'mtfnpy' }
256 __PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
257 { 'foreign.baz_num' => 'self.baz_id' });
265 unlink "${quuxs_pm}.bak" or die $^E;
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 = slurp $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) = ('.bak', $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' });
354 unlink "${quuxs_pm}.bak" or die $^E;
357 # now upgrade the schema
359 dump_directory => $DUMP_DIR,
362 $schema = $res->{schema};
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)';
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)';
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)';
376 is scalar @{ $res->{warnings} }, 3,
377 'correct number of warnings on upgrading static schema (with "naming" set)'
378 or diag @{ $res->{warnings} };
382 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
383 my $result_count =()= glob "$result_dir/*";
386 'un-singularized results were replaced during upgrade';
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';
392 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel5,
393 $res->{classes}{bazs} }
394 'unsingularized class names in custom content are translated';
396 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
397 my $code = slurp $file;
399 like $code, qr/sub a_method { 'mtfnpy' }/,
400 'custom content from unsingularized Result loaded into static dump correctly';
403 # test running against v4 schema with load_namespaces, upgrade to v5 but
404 # downgrade to load_classes, with external content
406 my $temp_dir = tempdir(CLEANUP => 1);
407 push @INC, $temp_dir;
409 my $external_result_dir = join '/', $temp_dir, split /::/,
410 "${SCHEMA_CLASS}::Result";
412 make_path $external_result_dir;
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' }
419 __PACKAGE__->has_one('bazrel11', 'DBIXCSL_Test::Schema::Result::Bazs',
420 { 'foreign.baz_num' => 'self.baz_id' });
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;
429 __PACKAGE__->has_one('foorel5', 'DBIXCSL_Test::Schema::Result::Foos',
430 { 'foreign.fooid' => 'self.foo_id' });
435 write_v4_schema_pm(use_namespaces => 1);
437 my $res = run_loader(dump_directory => $DUMP_DIR);
438 my $warning = $res->{warnings}[0];
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';
447 is scalar @{ $res->{warnings} }, 3,
448 'correct number of warnings for static schema in backcompat mode';
452 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
453 'use_namespaces in backcompat mode';
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});
460 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
462 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
465 sub a_method { 'mtfnpy' }
467 __PACKAGE__->has_one('bazrel6', 'DBIXCSL_Test::Schema::Result::Bazs',
468 { 'foreign.baz_num' => 'self.baz_id' });
476 unlink "${quuxs_pm}.bak" or die $^E;
479 # now upgrade the schema to v5 but downgrade to load_classes
481 dump_directory => $DUMP_DIR,
485 $schema = $res->{schema};
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)';
491 like $res->{warnings}[1], qr/dump completed/i,
492 'correct warnings on upgrading static schema (with "naming" set and ' .
493 'use_namespaces => 0)';
495 is scalar @{ $res->{warnings} }, 2,
496 'correct number of warnings on upgrading static schema (with "naming" set)'
497 or diag @{ $res->{warnings} };
501 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
502 my $result_count =()= glob "$result_dir/*";
505 'un-singularized results were replaced during upgrade and Result dir removed';
507 ok ((not -d "$result_dir/Result"),
508 'Result dir was removed for load_classes downgrade');
510 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
511 'load_classes in upgraded mode';
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';
517 lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' }
518 'external content was carried over from un-singularized Result';
520 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
521 $res->{classes}{bazs} }
522 'unsingularized class names in custom content are translated';
524 lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel11,
525 $res->{classes}{bazs} }
526 'unsingularized class names in external content are translated';
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';
533 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
534 my $code = slurp $file;
536 like $code, qr/sub a_method { 'mtfnpy' }/,
537 'custom content from unsingularized Result loaded into static dump correctly';
539 like $code, qr/sub b_method { 'dongs' }/,
540 'external content from unsingularized Result loaded into static dump correctly';
545 # test a regular schema with use_namespaces => 0 upgraded to
546 # use_namespaces => 1
551 my $res = run_loader(
552 dump_directory => $DUMP_DIR,
556 like $res->{warnings}[0], qr/Dumping manual schema/i,
557 'correct warnings on dumping static schema with use_namespaces => 0';
559 like $res->{warnings}[1], qr/dump completed/i,
560 'correct warnings on dumping static schema with use_namespaces => 0';
562 is scalar @{ $res->{warnings} }, 2,
563 'correct number of warnings on dumping static schema with use_namespaces => 0'
564 or diag @{ $res->{warnings} };
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});
573 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
575 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
578 sub a_method { 'mtfnpy' }
580 __PACKAGE__->has_one('bazrel7', 'DBIXCSL_Test::Schema::Baz',
581 { 'foreign.baz_num' => 'self.baz_id' });
589 unlink "${quuxs_pm}.bak" or die $^E;
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);
596 like $res->{warnings}[0], qr/load_classes/i,
597 'correct warnings on re-dumping static schema with load_classes';
599 like $res->{warnings}[1], qr/Dumping manual schema/i,
600 'correct warnings on re-dumping static schema with load_classes';
602 like $res->{warnings}[2], qr/dump completed/i,
603 'correct warnings on re-dumping static schema with load_classes';
605 is scalar @{ $res->{warnings} }, 3,
606 'correct number of warnings on re-dumping static schema with load_classes'
607 or diag @{ $res->{warnings} };
609 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
610 'load_classes preserved on re-dump';
614 # now upgrade the schema to use_namespaces
616 dump_directory => $DUMP_DIR,
619 $schema = $res->{schema};
621 like $res->{warnings}[0], qr/Dumping manual schema/i,
622 'correct warnings on upgrading to use_namespaces';
624 like $res->{warnings}[1], qr/dump completed/i,
625 'correct warnings on upgrading to use_namespaces';
627 is scalar @{ $res->{warnings} }, 2,
628 'correct number of warnings on upgrading to use_namespaces'
629 or diag @{ $res->{warnings} };
633 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
634 my @schema_files = glob "$schema_dir/*";
636 is 1, (scalar @schema_files),
637 "schema dir $schema_dir contains only 1 entry";
639 like $schema_files[0], qr{/Result\z},
640 "schema dir contains only a Result/ directory";
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';
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';
650 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
651 my $code = slurp $file;
653 like $code, qr/sub a_method { 'mtfnpy' }/,
654 'custom content from un-namespaced Result loaded into static dump correctly';
657 # test a regular schema with default use_namespaces => 1, redump, and downgrade
663 my $res = run_loader(dump_directory => $DUMP_DIR);
665 like $res->{warnings}[0], qr/Dumping manual schema/i,
666 'correct warnings on dumping static schema';
668 like $res->{warnings}[1], qr/dump completed/i,
669 'correct warnings on dumping static schema';
671 is scalar @{ $res->{warnings} }, 2,
672 'correct number of warnings on dumping static schema'
673 or diag @{ $res->{warnings} };
677 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
678 'defaults to use_namespaces on regular dump';
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});
685 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
687 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
690 sub a_method { 'mtfnpy' }
692 __PACKAGE__->has_one('bazrel8', 'DBIXCSL_Test::Schema::Result::Baz',
693 { 'foreign.baz_num' => 'self.baz_id' });
701 unlink "${quuxs_pm}.bak" or die $^E;
704 # test that with no use_namespaces option, use_namespaces is preserved
705 $res = run_loader(dump_directory => $DUMP_DIR);
707 like $res->{warnings}[0], qr/Dumping manual schema/i,
708 'correct warnings on re-dumping static schema';
710 like $res->{warnings}[1], qr/dump completed/i,
711 'correct warnings on re-dumping static schema';
713 is scalar @{ $res->{warnings} }, 2,
714 'correct number of warnings on re-dumping static schema'
715 or diag @{ $res->{warnings} };
717 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux',
718 'use_namespaces preserved on re-dump';
722 # now downgrade the schema to load_classes
724 dump_directory => $DUMP_DIR,
727 $schema = $res->{schema};
729 like $res->{warnings}[0], qr/Dumping manual schema/i,
730 'correct warnings on downgrading to load_classes';
732 like $res->{warnings}[1], qr/dump completed/i,
733 'correct warnings on downgrading to load_classes';
735 is scalar @{ $res->{warnings} }, 2,
736 'correct number of warnings on downgrading to load_classes'
737 or diag @{ $res->{warnings} };
741 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
742 'load_classes downgrade correct';
744 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
745 my $result_count =()= glob "$result_dir/*";
748 'correct number of Results after upgrade and Result dir removed';
750 ok ((not -d "$result_dir/Result"),
751 'Result dir was removed for load_classes downgrade');
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';
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 '.
762 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
763 my $code = slurp $file;
765 like $code, qr/sub a_method { 'mtfnpy' }/,
766 'custom content from namespaced Result loaded into static dump correctly '.
767 'during load_classes downgrade';
770 # test a regular schema with use_namespaces => 1 and a custom result_namespace
771 # downgraded to load_classes
776 my $res = run_loader(
777 dump_directory => $DUMP_DIR,
778 result_namespace => 'MyResult',
781 like $res->{warnings}[0], qr/Dumping manual schema/i,
782 'correct warnings on dumping static schema';
784 like $res->{warnings}[1], qr/dump completed/i,
785 'correct warnings on dumping static schema';
787 is scalar @{ $res->{warnings} }, 2,
788 'correct number of warnings on dumping static schema'
789 or diag @{ $res->{warnings} };
793 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
794 'defaults to use_namespaces and uses custom result_namespace';
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});
801 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
803 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
806 sub a_method { 'mtfnpy' }
808 __PACKAGE__->has_one('bazrel9', 'DBIXCSL_Test::Schema::MyResult::Baz',
809 { 'foreign.baz_num' => 'self.baz_id' });
817 unlink "${quuxs_pm}.bak" or die $^E;
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);
824 like $res->{warnings}[0], qr/Dumping manual schema/i,
825 'correct warnings on re-dumping static schema';
827 like $res->{warnings}[1], qr/dump completed/i,
828 'correct warnings on re-dumping static schema';
830 is scalar @{ $res->{warnings} }, 2,
831 'correct number of warnings on re-dumping static schema'
832 or diag @{ $res->{warnings} };
834 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
835 'use_namespaces and custom result_namespace preserved on re-dump';
839 # now downgrade the schema to load_classes
841 dump_directory => $DUMP_DIR,
844 $schema = $res->{schema};
846 like $res->{warnings}[0], qr/Dumping manual schema/i,
847 'correct warnings on downgrading to load_classes';
849 like $res->{warnings}[1], qr/dump completed/i,
850 'correct warnings on downgrading to load_classes';
852 is scalar @{ $res->{warnings} }, 2,
853 'correct number of warnings on downgrading to load_classes'
854 or diag @{ $res->{warnings} };
858 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
859 'load_classes downgrade correct';
861 (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
862 my $result_count =()= glob "$result_dir/*";
865 'correct number of Results after upgrade and Result dir removed';
867 ok ((not -d "$result_dir/MyResult"),
868 'Result dir was removed for load_classes downgrade');
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';
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 '.
879 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
880 my $code = slurp $file;
882 like $code, qr/sub a_method { 'mtfnpy' }/,
883 'custom content from namespaced Result loaded into static dump correctly '.
884 'during load_classes downgrade';
887 # rewrite from one result_namespace to another, with external content
891 my $temp_dir = tempdir(CLEANUP => 1);
892 push @INC, $temp_dir;
894 my $external_result_dir = join '/', $temp_dir, split /::/,
895 "${SCHEMA_CLASS}::Result";
897 make_path $external_result_dir;
899 IO::File->new(">$external_result_dir/Quux.pm")->print(<<"EOF");
900 package ${SCHEMA_CLASS}::Result::Quux;
901 sub c_method { 'dongs' }
903 __PACKAGE__->has_one('bazrel12', 'DBIXCSL_Test::Schema::Result::Baz',
904 { 'foreign.baz_num' => 'self.baz_id' });
909 IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
910 package ${SCHEMA_CLASS}::Result::Bar;
912 __PACKAGE__->has_one('foorel6', 'DBIXCSL_Test::Schema::Result::Foo',
913 { 'foreign.fooid' => 'self.foo_id' });
918 my $res = run_loader(dump_directory => $DUMP_DIR);
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});
925 local ($^I, @ARGV) = ('.bak', $quuxs_pm);
927 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
930 sub a_method { 'mtfnpy' }
932 __PACKAGE__->has_one('bazrel10', 'DBIXCSL_Test::Schema::Result::Baz',
933 { 'foreign.baz_num' => 'self.baz_id' });
941 unlink "${quuxs_pm}.bak" or die $^E;
944 # Rewrite implicit 'Result' to 'MyResult'
946 dump_directory => $DUMP_DIR,
947 result_namespace => 'MyResult',
949 $schema = $res->{schema};
951 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux',
952 'using new result_namespace';
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/*";
959 'correct number of Results after rewritten result_namespace';
961 ok ((not -d "$schema_dir/Result"),
962 'original Result dir was removed when rewriting result_namespace');
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';
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';
972 my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
973 my $code = slurp $file;
975 like $code, qr/sub a_method { 'mtfnpy' }/,
976 'custom content from namespaced Result loaded into static dump correctly '.
977 'when rewriting result_namespace';
979 # Now rewrite 'MyResult' to 'Mtfnpy'
981 dump_directory => $DUMP_DIR,
982 result_namespace => 'Mtfnpy',
984 $schema = $res->{schema};
986 is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux',
987 'using new result_namespace';
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/*";
994 'correct number of Results after rewritten result_namespace';
996 ok ((not -d "$schema_dir/MyResult"),
997 'original Result dir was removed when rewriting result_namespace');
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';
1003 lives_and { is $schema->resultset('Quux')->find(1)->c_method, 'dongs' }
1004 'custom content was carried over when rewriting result_namespace';
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';
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 '.
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 '.
1020 $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
1021 $code = slurp $file;
1023 like $code, qr/sub a_method { 'mtfnpy' }/,
1024 'custom content from namespaced Result loaded into static dump correctly '.
1025 'when rewriting result_namespace';
1027 like $code, qr/sub c_method { 'dongs' }/,
1028 'external content from unsingularized Result loaded into static dump correctly';
1033 # test upgrading a v4 schema, the check that the version string is correct
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};
1040 my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
1041 my $code = slurp $file;
1044 $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m;
1046 is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION,
1047 'correct version dumped after upgrade of v4 static schema';
1050 # Test upgrading an already singular result with custom content that refers to
1053 write_v4_schema_pm();
1054 my $res = run_loader(dump_directory => $DUMP_DIR);
1055 my $schema = $res->{schema};
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});
1062 local ($^I, @ARGV) = ('.bak', $bar_pm);
1064 if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
1067 sub a_method { 'lalala' }
1069 __PACKAGE__->has_one('foorel3', 'DBIXCSL_Test::Schema::Foos',
1070 { 'foreign.fooid' => 'self.foo_id' });
1078 unlink "${bar_pm}.bak" or die $^E;
1081 # now upgrade the schema
1082 $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
1083 $schema = $res->{schema};
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';
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';
1095 my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar});
1096 my $code = slurp $file;
1098 like $code, qr/sub a_method { 'lalala' }/,
1099 'custom content from Result with unchanged name loaded into static dump ' .
1106 rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
1110 my %loader_opts = @_;
1113 foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
1114 Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
1117 Class::Unload->unload($SCHEMA_CLASS);
1121 my @connect_info = $make_dbictest_db2::dsn;
1122 my @loader_warnings;
1123 local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
1125 package $SCHEMA_CLASS;
1126 use base qw/DBIx::Class::Schema::Loader/;
1128 __PACKAGE__->loader_options(\%loader_opts);
1129 __PACKAGE__->connection(\@connect_info);
1132 ok(!$@, "Loader initialization") or diag $@;
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;
1144 warnings => \@loader_warnings,
1145 monikers => \%monikers,
1146 classes => \%classes,
1150 sub write_v4_schema_pm {
1153 (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//;
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}) {
1160 package DBIXCSL_Test::Schema;
1165 use base 'DBIx::Class::Schema';
1167 __PACKAGE__->load_classes;
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
1174 # You can replace this text with custom content, and it will be preserved on regeneration
1180 package DBIXCSL_Test::Schema;
1185 use base 'DBIx::Class::Schema';
1187 __PACKAGE__->load_namespaces;
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
1194 # You can replace this text with custom content, and it will be preserved on
1203 my $schema = $res->{schema};
1205 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1206 [qw/Foos Bar Bazs Quuxs/],
1207 'correct monikers in 0.04006 mode';
1209 isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }),
1210 $res->{classes}{bar},
1213 isa_ok eval { $bar->foo_id }, $res->{classes}{foos},
1214 'correct rel name in 0.04006 mode';
1216 ok my $baz = eval { $schema->resultset('Bazs')->find(1) };
1218 isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet',
1219 'correct rel type and name for UNIQUE FK in 0.04006 mode';
1224 my $schema = $res->{schema};
1226 is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs/} ],
1227 [qw/Foo Bar Baz Quux/],
1228 'correct monikers in current mode';
1230 ok my $bar = eval { $schema->resultset('Bar')->find(1) };
1232 isa_ok eval { $bar->foo }, $res->{classes}{foos},
1233 'correct rel name in current mode';
1235 ok my $baz = eval { $schema->resultset('Baz')->find(1) };
1237 isa_ok eval { $baz->quux }, $res->{classes}{quuxs},
1238 'correct rel type and name for UNIQUE FK in current mode';