X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F25backcompat_v4.t;h=beb245d495dc45d32a114149333d709dbbdef644;hb=804c115dd211c89d1ab9317ee12b2af6063164b9;hp=81354459fda8f62b11f113f4985a46c7330a2b7f;hpb=b5f1b43c116380e8b58b5cba6c870f784bef4a6a;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t
index 8135445..beb245d 100644
--- a/t/25backcompat_v4.t
+++ b/t/25backcompat_v4.t
@@ -6,6 +6,7 @@ use File::Path qw/rmtree make_path/;
 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;
@@ -46,7 +47,7 @@ my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema';
 
 # 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;
@@ -99,13 +100,12 @@ EOF
 
     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;
@@ -158,14 +158,13 @@ EOF
 
     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;
@@ -213,7 +212,7 @@ EOF
 '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';
@@ -221,7 +220,6 @@ EOF
     like $code, qr/sub a_method { 'dongs' }/,
 'external custom content loaded into static dump correctly';
 
-    rmtree $temp_dir;
     pop @INC;
 }
 
@@ -248,7 +246,7 @@ EOF
     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;
@@ -263,6 +261,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # Rerun the loader in backcompat mode to make sure it's still in backcompat
@@ -305,7 +305,7 @@ EOF
         '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';
@@ -335,7 +335,7 @@ EOF
     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;
@@ -350,6 +350,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # now upgrade the schema
@@ -392,16 +394,46 @@ EOF
         '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];
 
@@ -417,12 +449,15 @@ EOF
 
     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;
@@ -437,11 +472,10 @@ EOF
                 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,
@@ -476,19 +510,36 @@ EOF
     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
@@ -519,7 +570,7 @@ EOF
     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;
@@ -534,6 +585,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # test that with no use_namespaces option, there is a warning and
@@ -595,7 +648,7 @@ EOF
         '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';
@@ -629,7 +682,7 @@ EOF
     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;
@@ -644,6 +697,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # test that with no use_namespaces option, use_namespaces is preserved
@@ -705,7 +760,7 @@ EOF
 '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 '.
@@ -743,7 +798,7 @@ EOF
     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;
@@ -758,6 +813,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # test that with no use_namespaces option, use_namespaces is preserved, and
@@ -820,17 +877,43 @@ EOF
 '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);
 
@@ -839,7 +922,7 @@ EOF
     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;
@@ -854,6 +937,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${quuxs_pm}.bak" or die $^E;
     }
 
     # Rewrite implicit 'Result' to 'MyResult'
@@ -885,7 +970,7 @@ EOF
 '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 '.
@@ -911,20 +996,38 @@ EOF
     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
@@ -935,7 +1038,7 @@ EOF
     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;
@@ -956,7 +1059,7 @@ EOF
     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;
@@ -971,6 +1074,8 @@ EOF
                 print;
             }
         }
+        close ARGV;
+        unlink "${bar_pm}.bak" or die $^E;
     }
 
     # now upgrade the schema
@@ -988,7 +1093,7 @@ EOF
 '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 ' .