support arrayrefs for result_namespace and resultset_namespace (RT#40214)

diff --git a/Changes b/Changes
index 8e3e3ef..9e993cd 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - support arrayrefs for result_namespace and resultset_namespace
+          (RT#40214)
         - add naming => { monikers => 'preserve' } or 'singular'/'plural' to
           control moniker inflection (RT#44935)
         - add naming => { column_accessors => 'preserve' } to not normalize

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 1a62670..6ea127f 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -17,12 +17,12 @@ use File::Temp qw//;
 use Class::Unload;
 use Class::Inspector ();
 use Scalar::Util 'looks_like_number';
-use File::Slurp 'slurp';
+use File::Slurp 'read_file';
 use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/;
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
-use Encode qw/decode encode/;
+use Encode qw/encode/;
 use namespace::clean;
 
 our $VERSION = '0.07010';
@@ -821,7 +821,7 @@ EOF
     }
 
 # otherwise check if we need backcompat mode for a static schema
-    my $filename = $self->_get_dump_filename($self->schema_class);
+    my $filename = $self->get_dump_filename($self->schema_class);
     return unless -e $filename;
 
     my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
@@ -835,7 +835,14 @@ EOF
     }
 
     my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
-    my $result_namespace = do { ($old_gen =~ /result_namespace => '([^']+)'/) ? $1 : '' };
+
+    my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' };
+    my $ds = eval $result_namespace;
+    die <<"EOF" if $@;
+Could not eval expression '$result_namespace' for result_namespace from
+$filename: $@
+EOF
+    $result_namespace = $ds;
 
     if ($load_classes && (not defined $self->use_namespaces)) {
         warn <<"EOF"  unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
@@ -1023,7 +1030,7 @@ sub _load_external {
         warn qq/# Loaded external class definition for '$class'\n/
             if $self->debug;
 
-        my $code = $self->_rewrite_old_classnames(decode 'UTF-8', scalar slurp $real_inc_path);
+        my $code = $self->_rewrite_old_classnames(scalar read_file($real_inc_path, binmode => ':encoding(UTF-8)'));
 
         if ($self->dynamic) { # load the class too
             eval_package_without_redefine_warnings($class, $code);
@@ -1046,7 +1053,7 @@ sub _load_external {
     }
 
     if ($old_real_inc_path) {
-        my $code = decode 'UTF-8', scalar slurp $old_real_inc_path;
+        my $code = read_file($old_real_inc_path, binmode => ':encoding(UTF-8)');
 
         $self->_ext_stmt($class, <<"EOF");
 
@@ -1301,7 +1308,7 @@ sub _reload_class {
         eval_package_without_redefine_warnings ($class, "require $class");
     }
     catch {
-        my $source = decode 'UTF-8', scalar slurp $self->_get_dump_filename($class);
+        my $source = read_file($self->_get_dump_filename($class), binmode => ':encoding(UTF-8)');
         die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
     };
 }
@@ -1379,7 +1386,8 @@ sub _dump_to_dir {
 
         for my $attr (@attr) {
             if ($self->$attr) {
-                $namespace_options .= qq|    $attr => '| . $self->$attr . qq|',\n|
+                my $code = dumper_squashed $self->$attr;
+                $namespace_options .= qq|    $attr => $code,\n|
             }
         }
         $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
@@ -1652,6 +1660,8 @@ sub _result_namespace {
     my ($self, $schema_class, $ns) = @_;
     my @result_namespace;
 
+    $ns = $ns->[0] if ref $ns;
+
     if ($ns =~ /^\+(.*)/) {
         # Fully qualified namespace
         @result_namespace = ($1)

diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index c58f016..4cfd707 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -9,12 +9,11 @@ use Scalar::Util 'weaken';
 use Lingua::EN::Inflect::Phrase ();
 use Lingua::EN::Tagger ();
 use DBIx::Class::Schema::Loader::Utils 'split_name';
-use File::Slurp 'slurp';
+use File::Slurp 'read_file';
 use Try::Tiny;
 use Class::Unload ();
 use Class::Inspector ();
 use List::MoreUtils 'apply';
-use Encode 'decode';
 use namespace::clean;
 
 our $VERSION = '0.07010';
@@ -598,7 +597,7 @@ sub _relnames_and_method {
             my $class = "${remote_class}Temporary";
 
             if (not Class::Inspector->loaded($class)) {
-                my $code = decode 'UTF-8', scalar slurp $existing_remote_file;
+                my $code = read_file($existing_remote_file, binmode => ':encoding(UTF-8)');
 
                 $code =~ s/(?<=package $remote_class)/Temporary/g;
 

diff --git a/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm b/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
deleted file mode 100644 (file)
index b4c3c65..0000000
--- a/t/lib/DBIXCSL_Test/Schema/LoaderTest1.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package DBIXCSL_Test::Schema::LoaderTest1;
-
-sub loader_test1_classmeth { 'all is well' }
-
-sub loader_test1_rsmeth : ResultSet { 'all is still well' }
-
-1;

diff --git a/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm b/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm
new file mode 100644 (file)
index 0000000..f80a699
--- /dev/null
+++ b/t/lib/DBIXCSL_Test/Schema/MyResult/LoaderTest1.pm
@@ -0,0 +1,5 @@
+package DBIXCSL_Test::Schema::MyResult::LoaderTest1;
+
+sub loader_test1_classmeth { 'all is well' }
+
+1;

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index dc10b92..e3df577 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -16,19 +16,28 @@ use DBIx::Class::Schema::Loader::Utils 'dumper_squashed';
 use List::MoreUtils 'apply';
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
-use File::Slurp 'slurp';
+use File::Slurp 'read_file';
+use File::Spec::Functions 'catfile';
+use File::Basename 'basename';
 use namespace::clean;
 
 use dbixcsl_test_dir qw/$tdir/;
 
-my $DUMP_DIR = "$tdir/common_dump";
-rmtree $DUMP_DIR;
+use constant DUMP_DIR => "$tdir/common_dump";
+
+rmtree DUMP_DIR;
 
 use constant RESCAN_WARNINGS => qr/(?i:loader_test|LoaderTest)\d+s? has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/;
 
 # skip schema-qualified tables in the Pg tests
 use constant SOURCE_DDL => qr/CREATE (?:TABLE|VIEW) (?!"dbicsl[.-]test")/i;
 
+use constant SCHEMA_CLASS => 'DBIXCSL_Test::Schema';
+
+use constant RESULT_NAMESPACE => [ 'MyResult', 'MyResultTwo' ];
+
+use constant RESULTSET_NAMESPACE => [ 'MyResultSet', 'MyResultSetTwo' ];
+
 sub new {
     my $class = shift;
 
@@ -111,7 +120,7 @@ sub run_tests {
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (203 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (206 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -123,7 +132,7 @@ sub run_tests {
         my $schema_class = $self->setup_schema($info);
         $self->test_schema($schema_class);
 
-        rmtree $DUMP_DIR
+        rmtree DUMP_DIR
             unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#connect_info;
     }
 }
@@ -133,7 +142,7 @@ sub run_only_extra_tests {
 
     plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
 
-    rmtree $DUMP_DIR;
+    rmtree DUMP_DIR;
 
     foreach my $info_idx (0..$#$connect_info) {
         my $info = $connect_info->[$info_idx];
@@ -168,7 +177,7 @@ sub run_only_extra_tests {
 
         if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) {
             $self->drop_extra_tables_only;
-            rmtree $DUMP_DIR;
+            rmtree DUMP_DIR;
         }
     }
 }
@@ -198,8 +207,6 @@ my (@statements, @statements_reltests, @statements_advanced,
 sub setup_schema {
     my ($self, $connect_info, $expected_count) = @_;
 
-    my $schema_class = 'DBIXCSL_Test::Schema';
-
     my $debug = ($self->{verbose} > 1) ? 1 : 0;
 
     if ($ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}) {
@@ -214,7 +221,8 @@ sub setup_schema {
     my %loader_opts = (
         constraint              =>
           qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
-        relationships           => 1,
+        result_namespace        => RESULT_NAMESPACE,
+        resultset_namespace     => RESULTSET_NAMESPACE,
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
         left_base_classes       => [ qw/TestLeftBase/ ],
@@ -224,8 +232,7 @@ sub setup_schema {
         moniker_map             => \&_monikerize,
         custom_column_info      => \&_custom_column_info,
         debug                   => $debug,
-        use_namespaces          => 0,
-        dump_directory          => $DUMP_DIR,
+        dump_directory          => DUMP_DIR,
         datetime_timezone       => 'Europe/Berlin',
         datetime_locale         => 'de_DE',
         $self->{use_moose} ? (
@@ -242,14 +249,14 @@ sub setup_schema {
 
     $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
 
-    Class::Unload->unload($schema_class);
+    Class::Unload->unload(SCHEMA_CLASS);
 
     my $file_count;
     {
         my @loader_warnings;
         local $SIG{__WARN__} = sub { push(@loader_warnings, @_); };
          eval qq{
-             package $schema_class;
+             package @{[SCHEMA_CLASS]};
              use base qw/DBIx::Class::Schema::Loader/;
      
              __PACKAGE__->loader_options(\%loader_opts);
@@ -258,7 +265,7 @@ sub setup_schema {
  
         ok(!$@, "Loader initialization") or diag $@;
 
-        find sub { return if -d; $file_count++ }, $DUMP_DIR;
+        find sub { return if -d; $file_count++ }, DUMP_DIR;
 
         my $standard_sources = not defined $expected_count;
 
@@ -326,8 +333,8 @@ sub setup_schema {
     }
 
     exit if ($file_count||0) != $expected_count;
-   
-    return $schema_class;
+
+    return SCHEMA_CLASS;
 }
 
 sub test_schema {
@@ -368,6 +375,30 @@ sub test_schema {
     isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
 
+    # check result_namespace
+    my @schema_dir = split /::/, SCHEMA_CLASS;
+    my $result_dir = ref RESULT_NAMESPACE ? ${RESULT_NAMESPACE()}[0] : RESULT_NAMESPACE;
+
+    my $schema_files = [ sort map basename($_), glob catfile(DUMP_DIR, @schema_dir, '*') ];
+
+    is_deeply $schema_files, [ $result_dir ],
+        'first entry in result_namespace exists as a directory';
+
+    my $result_file_count =()= glob catfile(DUMP_DIR, @schema_dir, $result_dir, '*.pm');
+
+    ok $result_file_count,
+        'Result files dumped to first entry in result_namespace';
+
+    # parse out the resultset_namespace
+    my $schema_code = read_file($conn->_loader->get_dump_filename(SCHEMA_CLASS), binmode => ':encoding(UTF-8)');
+
+    my ($schema_resultset_namespace) = $schema_code =~ /\bresultset_namespace => (.*)/;
+    $schema_resultset_namespace = eval $schema_resultset_namespace;
+    die $@ if $@;
+
+    is_deeply $schema_resultset_namespace, RESULTSET_NAMESPACE,
+        'resultset_namespace set correctly on Schema';
+
     my @columns_lt2 = $class2->columns;
     is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" );
 
@@ -785,7 +816,7 @@ sub test_schema {
                        $class6->column_info('Id2');
         ok($id2_info->{is_foreign_key}, 'Foreign key detected');
 
-        unlike slurp($conn->_loader->get_dump_filename($class6)),
+        unlike read_file($conn->_loader->get_dump_filename($class6), binmode => ':encoding(UTF-8)'),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?
@@ -793,7 +824,7 @@ qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "\1"/xs,
 'did not create two relationships with the same name';
 
-       unlike slurp($conn->_loader->get_dump_filename($class8)),
+        unlike read_file($conn->_loader->get_dump_filename($class8), binmode => ':encoding(UTF-8)'),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?
@@ -1090,7 +1121,7 @@ EOF
             $digest->addfile($fh);
         };
 
-        find $find_cb, $DUMP_DIR;
+        find $find_cb, DUMP_DIR;
 
 #        system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*";
 #        system "cp $tdir/common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan";
@@ -1111,7 +1142,7 @@ EOF
 #        system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan";
 
         $digest = Digest::MD5->new;
-        find $find_cb, $DUMP_DIR;
+        find $find_cb, DUMP_DIR;
         my $after_digest = $digest->b64digest;
 
         is $before_digest, $after_digest,
@@ -1244,12 +1275,14 @@ sub monikers_and_classes {
 
         $table_name = $$table_name if ref $table_name;
 
+        my $result_class = $schema_class->source($source_name)->result_class;
+
         $monikers->{$table_name} = $source_name;
-        $classes->{$table_name} = $schema_class . q{::} . $source_name;
+        $classes->{$table_name} = $result_class;
 
         # some DBs (Firebird) uppercase everything
         $monikers->{lc $table_name} = $source_name;
-        $classes->{lc $table_name} = $schema_class . q{::} . $source_name;
+        $classes->{lc $table_name} = $result_class;
     }
 
     return ($monikers, $classes);
@@ -2150,7 +2183,7 @@ sub DESTROY {
     my $self = shift;
     unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
       $self->drop_tables if $self->{_created};
-      rmtree $DUMP_DIR
+      rmtree DUMP_DIR
     }
 }