use Class::Unload;
use File::Temp qw/tempfile tempdir/;
use IO::File;
+use File::Slurp 'slurp';
use DBIx::Class::Schema::Loader ();
use lib qw(t/lib);
use make_dbictest_db2;
# test upgraded dynamic schema with external content loaded
{
- my $temp_dir = tempdir;
+ my $temp_dir = tempdir(CLEANUP => 1);
push @INC, $temp_dir;
my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
run_v5_tests($res);
- rmtree $temp_dir;
pop @INC;
}
# test upgraded dynamic schema with use_namespaces with external content loaded
{
- my $temp_dir = tempdir;
+ my $temp_dir = tempdir(CLEANUP => 1);
push @INC, $temp_dir;
my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
run_v5_tests($res);
- rmtree $temp_dir;
pop @INC;
}
# test upgraded static schema with external content loaded
{
- my $temp_dir = tempdir;
+ my $temp_dir = tempdir(CLEANUP => 1);
push @INC, $temp_dir;
my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
'names are translated in static schema';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/package ${SCHEMA_CLASS}::Quux;/,
'package line translated correctly from external custom content in static dump';
like $code, qr/sub a_method { 'dongs' }/,
'external custom content loaded into static dump correctly';
- rmtree $temp_dir;
pop @INC;
}
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# Rerun the loader in backcompat mode to make sure it's still in backcompat
'unsingularized class names in custom content are translated';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from unsingularized Result loaded into static dump correctly';
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# now upgrade the schema
'unsingularized class names in custom content are translated';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from unsingularized Result loaded into static dump correctly';
}
# test running against v4 schema with load_namespaces, upgrade to v5 but
-# downgrade to load_classes
+# downgrade to load_classes, with external content
{
+ my $temp_dir = tempdir(CLEANUP => 1);
+ push @INC, $temp_dir;
+
+ my $external_result_dir = join '/', $temp_dir, split /::/,
+ "${SCHEMA_CLASS}::Result";
+
+ make_path $external_result_dir;
+
+ # make external content for Result that will be singularized
+ IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Result::Quuxs;
+sub b_method { 'dongs' }
+
+__PACKAGE__->has_one('bazrel11', 'DBIXCSL_Test::Schema::Result::Bazs',
+ { 'foreign.baz_num' => 'self.baz_id' });
+
+1;
+EOF
+
+ # make external content for Result that will NOT be singularized
+ IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Result::Bar;
+
+__PACKAGE__->has_one('foorel5', 'DBIXCSL_Test::Schema::Result::Foos',
+ { 'foreign.fooid' => 'self.foo_id' });
+
+1;
+EOF
+
write_v4_schema_pm(use_namespaces => 1);
+
my $res = run_loader(dump_directory => $DUMP_DIR);
my $warning = $res->{warnings}[0];
run_v4_tests($res);
+ is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
+ 'use_namespaces in backcompat mode';
+
# add some custom content to a Result that will be replaced
my $schema = $res->{schema};
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
- is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs',
- 'use_namespaces in backcompat mode';
-
# now upgrade the schema to v5 but downgrade to load_classes
$res = run_loader(
dump_directory => $DUMP_DIR,
is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux',
'load_classes in upgraded mode';
- # check that custom content was preserved
+ # check that custom and external content was preserved
lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
'custom content was carried over from un-singularized Result';
+ lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' }
+ 'external content was carried over from un-singularized Result';
+
lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel6,
$res->{classes}{bazs} }
'unsingularized class names in custom content are translated';
+ lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel11,
+ $res->{classes}{bazs} }
+ 'unsingularized class names in external content are translated';
+
+ lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel5,
+ $res->{classes}{foos} }
+'unsingularized class names in external content from unchanged Result class ' .
+'names are translated in static schema';
+
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from unsingularized Result loaded into static dump correctly';
+
+ like $code, qr/sub b_method { 'dongs' }/,
+'external content from unsingularized Result loaded into static dump correctly';
+
+ pop @INC;
}
# test a regular schema with use_namespaces => 0 upgraded to
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# test that with no use_namespaces option, there is a warning and
'un-namespaced class names in custom content are translated';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from un-namespaced Result loaded into static dump correctly';
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# test that with no use_namespaces option, use_namespaces is preserved
'downgrade';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from namespaced Result loaded into static dump correctly '.
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# test that with no use_namespaces option, use_namespaces is preserved, and
'downgrade';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from namespaced Result loaded into static dump correctly '.
'during load_classes downgrade';
}
-# rewrite from one result_namespace to another
+# rewrite from one result_namespace to another, with external content
{
rmtree $DUMP_DIR;
mkdir $DUMP_DIR;
+ my $temp_dir = tempdir(CLEANUP => 1);
+ push @INC, $temp_dir;
+
+ my $external_result_dir = join '/', $temp_dir, split /::/,
+ "${SCHEMA_CLASS}::Result";
+
+ make_path $external_result_dir;
+
+ IO::File->new(">$external_result_dir/Quux.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Result::Quux;
+sub c_method { 'dongs' }
+
+__PACKAGE__->has_one('bazrel12', 'DBIXCSL_Test::Schema::Result::Baz',
+ { 'foreign.baz_num' => 'self.baz_id' });
+
+1;
+EOF
+
+ IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Result::Bar;
+
+__PACKAGE__->has_one('foorel6', 'DBIXCSL_Test::Schema::Result::Foo',
+ { 'foreign.fooid' => 'self.foo_id' });
+
+1;
+EOF
my $res = run_loader(dump_directory => $DUMP_DIR);
my $quuxs_pm = $schema->_loader
->_get_dump_filename($res->{classes}{quuxs});
{
- local ($^I, @ARGV) = ('', $quuxs_pm);
+ local ($^I, @ARGV) = ('.bak', $quuxs_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${quuxs_pm}.bak" or die $^E;
}
# Rewrite implicit 'Result' to 'MyResult'
'class names in custom content are translated when rewriting result_namespace';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from namespaced Result loaded into static dump correctly '.
ok ((not -d "$schema_dir/MyResult"),
'original Result dir was removed when rewriting result_namespace');
- # check that custom content was preserved
+ # check that custom and external content was preserved
lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
'custom content was carried over when rewriting result_namespace';
+ lives_and { is $schema->resultset('Quux')->find(1)->c_method, 'dongs' }
+ 'custom content was carried over when rewriting result_namespace';
+
lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10,
$res->{classes}{bazs} }
'class names in custom content are translated when rewriting result_namespace';
+ lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel12,
+ $res->{classes}{bazs} }
+'class names in external content are translated when rewriting '.
+'result_namespace';
+
+ lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel6,
+ $res->{classes}{foos} }
+'class names in external content are translated when rewriting '.
+'result_namespace';
+
$file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
- $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ $code = slurp $file;
like $code, qr/sub a_method { 'mtfnpy' }/,
'custom content from namespaced Result loaded into static dump correctly '.
'when rewriting result_namespace';
+
+ like $code, qr/sub c_method { 'dongs' }/,
+'external content from unsingularized Result loaded into static dump correctly';
+
+ pop @INC;
}
# test upgrading a v4 schema, the check that the version string is correct
my $schema = $res->{schema};
my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
my ($dumped_ver) =
$code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m;
my $bar_pm = $schema->_loader
->_get_dump_filename($res->{classes}{bar});
{
- local ($^I, @ARGV) = ('', $bar_pm);
+ local ($^I, @ARGV) = ('.bak', $bar_pm);
while (<>) {
if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
print;
print;
}
}
+ close ARGV;
+ unlink "${bar_pm}.bak" or die $^E;
}
# now upgrade the schema
'name are translated';
my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar});
- my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+ my $code = slurp $file;
like $code, qr/sub a_method { 'lalala' }/,
'custom content from Result with unchanged name loaded into static dump ' .