From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Sun, 21 Jul 2013 12:23:11 +0000 (+0100)
Subject: Allow specifying the moniker part separator
X-Git-Tag: 0.07036_01~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=848731a7d8dd814bcf8cb982a96033dc40c90697

Allow specifying the moniker part separator

Used between the parts specified by "moniker_parts", defaults to the
empty string.
---

diff --git a/Changes b/Changes
index 36c80b1..b9a3923 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,8 @@ Revision history for Perl extension DBIx::Class::Schema::Loader
         - Don't ship MYMETA.* files (RT#87713)
         - Fix many_to_many bridges involving might_have relationships
         - Allow specifying custom attributes for many_to_many bridges
+        - Allow specifying the separator when joining database, schema
+          and table names to form a moniker
 
 0.07036  2013-07-08
         - Fix stray comma in Pg on_delete/on_update => CASCADE (RT#84706)
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index b37223c..c1786cc 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -109,6 +109,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 db_schema
                                 qualify_objects
                                 moniker_parts
+                                moniker_part_separator
 /);
 
 my $CURRENT_V = 'v7';
@@ -520,6 +521,7 @@ the table.
 The L</moniker_parts> option is an arrayref of methods on the table class
 corresponding to parts of the fully qualified table name, defaulting to
 C<['name']>, in the order those parts are used to create the moniker name.
+The parts are joined together using L</moniker_part_separator>.
 
 The C<'name'> entry B<must> be present.
 
@@ -537,6 +539,12 @@ C<database>, C<schema>, C<name>
 
 =back
 
+=head2 moniker_part_separator
+
+String used to join L</moniker_parts> when creating the moniker.
+Defaults to the empty string. Use C<::> to get a separate namespace per
+database and/or schema.
+
 =head2 constraint
 
 Only load tables matching regex.  Best specified as a qr// regex.
@@ -1173,6 +1181,10 @@ sub new {
         }
     }
 
+    if (not defined $self->moniker_part_separator) {
+        $self->moniker_part_separator('');
+    }
+
     return $self;
 }
 
@@ -2596,10 +2608,10 @@ sub _default_table2moniker {
             @part_parts = split /\s+/, $inflected;
         }
 
-        push @all_parts, map ucfirst, @part_parts;
+        push @all_parts, join '', map ucfirst, @part_parts;
     }
 
-    return join '', @all_parts;
+    return join $self->moniker_part_separator, @all_parts;
 }
 
 sub _table2moniker {
diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 0ca9461..6e903f8 100644
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -343,8 +343,31 @@ $t->dump_test(
   regexes => {
     'Result/MySchemaFoo' => [
       qr/^\Q__PACKAGE__->table("my_schema.foo");\E/m,
-      # the has_many relname should not have the schema in it!
-      qr/^__PACKAGE__->has_many\(\n  "bars"/m,
+      # the has_many relname should not have the schema in it, but the class should
+      qr/^__PACKAGE__->has_many\(\n  "bars",\n  "DBICTest::DumpMore::1::Result::MySchemaBar"/m,
+    ],
+  },
+);
+
+# test moniker_part_separator
+$t->dump_test(
+  classname => 'DBICTest::DumpMore::1',
+  options => {
+    db_schema => 'my_schema',
+    moniker_parts => ['_schema', 'name'],
+    moniker_part_separator => '::',
+    qualify_objects => 1,
+    use_namespaces => 1,
+  },
+  warnings => [
+    qr/^db_schema is not supported on SQLite/,
+  ],
+  regexes => {
+    'Result/MySchema/Foo' => [
+      qr/^package DBICTest::DumpMore::1::Result::MySchema::Foo;$/m,
+      qr/^\Q__PACKAGE__->table("my_schema.foo");\E/m,
+      # the has_many relname should not have the schema in it, but the class should
+      qr/^__PACKAGE__->has_many\(\n  "bars",\n  "DBICTest::DumpMore::1::Result::MySchema::Bar"/m,
     ],
   },
 );