add more naming options

diff --git a/Changes b/Changes
index fb780d2..8e3e3ef 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - add naming => { monikers => 'preserve' } or 'singular'/'plural' to
+          control moniker inflection (RT#44935)
+        - add naming => { column_accessors => 'preserve' } to not normalize
+          CamelCase column names to lower case for accessors (RT#64668)
         - support quoted PostgreSQL schema names with special chars (RT#64766)
         - automatically turn on quoting for MySQL (RT#60469)
         - become utf8-aware (RT#67920)

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 324f7e5..8d881fb 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -205,6 +205,23 @@ transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
 If you don't have any CamelCase table or column names, you can upgrade without
 breaking any of your code.
 
+=item preserve
+
+For L</monikers>, this option does not inflect the table names but makes
+monikers based on the actual name. For L</column_accessors> this option does
+not normalize CamelCase column names to lowercase column accessors, but makes
+accessors that are the same names as the columns (with any non-\w chars
+replaced with underscores.)
+
+=item singular
+
+For L</monikers>, singularizes the names using the most current inflector. This
+is the same as setting the option to L</current>.
+
+=item plural
+
+For L</monikers>, pluralizes the names, using the most current inflector.
+
 =back
 
 Dynamic schemas will always default to the 0.04XXX relationship names and won't
@@ -1827,9 +1844,11 @@ sub _default_column_accessor_name {
         # older naming just lc'd the col accessor and that's all.
         return lc $accessor_name;
     }
+    elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
+        return $accessor_name;
+    }
 
     return join '_', map lc, split_name $column_name;
-
 }
 
 sub _make_column_accessor_name {
@@ -1997,7 +2016,13 @@ sub _default_table2moniker {
     my @words = map lc, split_name $table;
     my $as_phrase = join ' ', @words;
 
-    my $inflected = Lingua::EN::Inflect::Phrase::to_S($as_phrase);
+    my $inflected = $self->naming->{monikers} eq 'plural' ?
+        Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
+        :
+        $self->naming->{monikers} eq 'preserve' ?
+            $as_phrase
+            :
+            Lingua::EN::Inflect::Phrase::to_S($as_phrase);
 
     return join '', map ucfirst, split /\W+/, $inflected;
 }

diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 6c94007..e3f6d7a 100644 (file)
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -74,6 +74,86 @@ $t->dump_test(
 
 $t->cleanup;
 
+# test naming => { column_accessors => 'preserve' }
+$t->dump_test(
+    classname => 'DBICTest::Schema::_preserve_column_accessors',
+    test_db_class => 'make_dbictest_db_with_unique',
+    options => { naming => { column_accessors => 'preserve' } },
+    warnings => [
+        qr/Dumping manual schema for DBICTest::Schema::_preserve_column_accessors to directory /,
+        qr/Schema dump completed/,
+    ],
+    neg_regexes => {
+        RouteChange => [
+            qr/\baccessor\b/,
+        ],
+    },
+);
+
+$t->cleanup;
+
+# test naming => { monikers => 'plural' }
+$t->dump_test(
+    classname => 'DBICTest::Schema::_plural_monikers',
+    options => { naming => { monikers => 'plural' } },
+    warnings => [
+        qr/Dumping manual schema for DBICTest::Schema::_plural_monikers to directory /,
+        qr/Schema dump completed/,
+    ],
+    regexes => {
+        Foos => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Foos\n\n=cut\n\n/,
+        ],
+        Bars => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Bars\n\n=cut\n\n/,
+        ],
+    },
+);
+
+$t->cleanup;
+
+# test naming => { monikers => 'singular' }
+$t->dump_test(
+    classname => 'DBICTest::Schema::_singular_monikers',
+    test_db_class => 'make_dbictest_db_plural_tables',
+    options => { naming => { monikers => 'singular' } },
+    warnings => [
+        qr/Dumping manual schema for DBICTest::Schema::_singular_monikers to directory /,
+        qr/Schema dump completed/,
+    ],
+    regexes => {
+        Foo => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Foo\n\n=cut\n\n/,
+        ],
+        Bar => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Bar\n\n=cut\n\n/,
+        ],
+    },
+);
+
+$t->cleanup;
+
+# test naming => { monikers => 'preserve' }
+$t->dump_test(
+    classname => 'DBICTest::Schema::_preserve_monikers',
+    test_db_class => 'make_dbictest_db_plural_tables',
+    options => { naming => { monikers => 'preserve' } },
+    warnings => [
+        qr/Dumping manual schema for DBICTest::Schema::_preserve_monikers to directory /,
+        qr/Schema dump completed/,
+    ],
+    regexes => {
+        Foos => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Foos\n\n=cut\n\n/,
+        ],
+        Bars => [
+            qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Bars\n\n=cut\n\n/,
+        ],
+    },
+);
+
+$t->cleanup;
+
 # test out the POD
 $t->dump_test(
   classname => 'DBICTest::DumpMore::1',
@@ -363,3 +443,4 @@ $t->dump_test(
 );
 
 done_testing;
+# vim:et sts=4 sw=4 tw=0:

diff --git a/t/lib/make_dbictest_db_plural_tables.pm b/t/lib/make_dbictest_db_plural_tables.pm
new file mode 100644 (file)
index 0000000..48a6608
--- /dev/null
+++ b/t/lib/make_dbictest_db_plural_tables.pm
@@ -0,0 +1,40 @@
+package make_dbictest_db_plural_tables;
+
+use strict;
+use warnings;
+use DBI;
+use dbixcsl_test_dir qw/$tdir/;
+
+eval { require DBD::SQLite };
+my $class = $@ ? 'SQLite2' : 'SQLite';
+
+my $fn = "$tdir/dbictest.db";
+
+unlink($fn);
+our $dsn = "dbi:$class:dbname=$fn";
+my $dbh = DBI->connect($dsn);
+$dbh->do('PRAGMA SYNCHRONOUS = OFF');
+
+$dbh->do($_) for (
+    q|CREATE TABLE foos (
+        fooid INTEGER PRIMARY KEY,
+        footext TEXT DEFAULT 'footext',
+        foodt TIMESTAMP DEFAULT CURRENT_TIMESTAMP
+      )|,
+    q|CREATE TABLE bars (
+        barid INTEGER PRIMARY KEY,
+        fooref INTEGER REFERENCES foo(fooid)
+      )|,
+    q|INSERT INTO foos (fooid, footext) VALUES (1,'Foo text for number 1')|,
+    q|INSERT INTO foos (fooid, footext) VALUES (2,'Foo record associated with the Bar with barid 3')|,
+    q|INSERT INTO foos (fooid, footext) VALUES (3,'Foo text for number 3')|,
+    q|INSERT INTO foos (fooid, footext) VALUES (4,'Foo text for number 4')|,
+    q|INSERT INTO bars VALUES (1,4)|,
+    q|INSERT INTO bars VALUES (2,3)|,
+    q|INSERT INTO bars VALUES (3,2)|,
+    q|INSERT INTO bars VALUES (4,1)|,
+);
+
+END { unlink($fn); }
+
+1;