From: Rafael Kitover <rkitover@cpan.org>
Date: Sat, 29 Oct 2011 17:29:27 +0000 (-0400)
Subject: better CamelCASE support for naming=v8
X-Git-Tag: 0.07011~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=ea3b8f030cb1cd0c41558e757c9d6f0081f8bc05

better CamelCASE support for naming=v8

The previous method of splitting CamelCase identifiers did not work
identifiers containing words in all caps, such as 'VLANValidID'.

Use 'wordsplit' from String::CamelCase which handles these types of
identifiers correctly for naming=v8 mode, while preserving the old
behavior for v7 mode for monikers, column accessors and relationship
names.

New features related to multischema support also use the v8 mode
implicitly.

Add t/80split_name.t to test the 'split_name' utility sub from ::Utils,
at the heart of this change; for both v8 and v7 modes.
---

diff --git a/Makefile.PL b/Makefile.PL
index 6fbe289..56401b5 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -56,6 +56,7 @@ requires 'Scope::Guard'                => 0;
 requires 'Exporter'                    => '5.63';
 requires 'Try::Tiny'                   => 0;
 requires 'String::ToIdentifier::EN'    => '0.05';
+requires 'String::CamelCase'           => '0.02';
 
 if ($Module::Install::AUTHOR && ! $args->{skip_author_deps}) {
     eval { require Module::Install::ReadmeFromPod }
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 5b8bb11..c94c09d 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -263,9 +263,12 @@ L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
 L</force_ascii> is set; this is only significant for names with non-C<\w>
 characters such as C<.>.
 
+CamelCase identifiers with words in all caps, e.g. C<VLANValidID> are supported
+correctly in this mode.
+
 For relationships, belongs_to accessors are made from column names by stripping
-postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
-and C<_num>.
+postfixes other than C<_id> as well, for example just C<Id>, C<_?ref>, C<_?cd>,
+C<_?code> and C<_?num>, case insensitively.
 
 =item preserve
 
@@ -723,15 +726,16 @@ loader options.
 
 =head2 preserve_case
 
-Usually column names are lowercased, to make them easier to work with in
-L<DBIx::Class>. This option lets you turn this behavior off, if the driver
-supports it.
+Normally database names are lowercased and split by underscore, use this option
+if you have CamelCase database names.
 
 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
 case-sensitive collation will turn this option on unconditionally.
 
-Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
-setting this option.
+B<NOTE:> L</naming> = C<v8> is highly recommended with this option as the
+semantics of this mode are much improved for CamelCase database names.
+
+L</naming> = C<v7> or greater is required with this option.
 
 =head2 qualify_objects
 
@@ -2209,20 +2213,27 @@ sub _run_user_map {
 sub _default_column_accessor_name {
     my ( $self, $column_name ) = @_;
 
-    my $accessor_name = $self->_to_identifier('column_accessors', $column_name, '_');
+    my $preserve = ($self->naming->{column_accessors}||'') eq 'preserve';
+
+    my $v = $self->_get_naming_v('column_accessors');
+
+    my $accessor_name = $preserve ?
+        $self->_to_identifier('column_accessors', $column_name) # assume CamelCase
+        :
+        $self->_to_identifier('column_accessors', $column_name, '_');
 
     $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
                                  # takes care of it
 
-    if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
+    if ($preserve) {
+        return $accessor_name;
+    }
+    elsif ($v < 7 || (not $self->preserve_case)) {
         # 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;
+    return join '_', map lc, split_name $column_name, $v;
 }
 
 sub _make_column_accessor_name {
@@ -2387,7 +2398,7 @@ sub _get_naming_v {
 }
 
 sub _to_identifier {
-    my ($self, $naming_key, $name, $sep_char) = @_;
+    my ($self, $naming_key, $name, $sep_char, $force) = @_;
 
     my $v = $self->_get_naming_v($naming_key);
 
@@ -2395,7 +2406,7 @@ sub _to_identifier {
         \&String::ToIdentifier::EN::to_identifier
         : \&String::ToIdentifier::EN::Unicode::to_identifier;
 
-    return $v >= 8 ? $to_identifier->($name, $sep_char) : $name;
+    return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name;
 }
 
 # Make a moniker from a table
@@ -2414,14 +2425,17 @@ sub _default_table2moniker {
         my $part = $name_parts[$i];
 
         if ($i != $name_idx || $v >= 8) {
-            $part = $self->_to_identifier('monikers', $part, '_');
+            $part = $self->_to_identifier('monikers', $part, '_', 1);
         }
 
         if ($i == $name_idx && $v == 5) {
             $part = Lingua::EN::Inflect::Number::to_S($part);
         }
 
-        my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
+        my @part_parts = map lc, $v > 6 ?
+            # use v8 semantics for all moniker parts except name
+            ($i == $name_idx ? split_name $part, $v : split_name $part)
+            : split /[\W_]+/, $part;
 
         if ($i == $name_idx && $v >= 6) {
             my $as_phrase = join ' ', @part_parts;
diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index 9d89f49..0f4005e 100644
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -316,7 +316,7 @@ sub _normalize_name {
 
     $name = $self->_sanitize_name($name);
 
-    my @words = split_name $name;
+    my @words = split_name $name, $self->loader->_get_naming_v('relationships');
 
     return join '_', map lc, @words;
 }
diff --git a/lib/DBIx/Class/Schema/Loader/Utils.pm b/lib/DBIx/Class/Schema/Loader/Utils.pm
index 5b19370..e5d7146 100644
--- a/lib/DBIx/Class/Schema/Loader/Utils.pm
+++ b/lib/DBIx/Class/Schema/Loader/Utils.pm
@@ -3,14 +3,15 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Data::Dumper ();
 use Test::More;
+use String::CamelCase 'wordsplit';
 use namespace::clean;
 use Exporter 'import';
+use Data::Dumper ();
 
 our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent slurp_file/;
 
-use constant BY_CASE_TRANSITION =>
+use constant BY_CASE_TRANSITION_V7 =>
     qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
 
 use constant BY_NON_ALPHANUM =>
@@ -19,10 +20,16 @@ use constant BY_NON_ALPHANUM =>
 my $LF   = "\x0a";
 my $CRLF = "\x0d\x0a";
 
-sub split_name($) {
-    my $name = shift;
+sub split_name($;$) {
+    my ($name, $v) = @_;
+
+    my $is_camel_case = $name =~ /[[:upper:]]/ && $name =~ /[[:lower:]]/;
+
+    if ((not $v) || $v >= 8) {
+        return map split(BY_NON_ALPHANUM, $_), wordsplit($name);
+    }
 
-    split $name =~ /[[:upper:]]/ && $name =~ /[[:lower:]]/ ? BY_CASE_TRANSITION : BY_NON_ALPHANUM, $name;
+    return split $is_camel_case ? BY_CASE_TRANSITION_V7 : BY_NON_ALPHANUM, $name;
 }
 
 sub dumper($) {
diff --git a/t/70schema_base_dispatched.t b/t/70schema_base_dispatched.t
index feacd28..3d70db5 100644
--- a/t/70schema_base_dispatched.t
+++ b/t/70schema_base_dispatched.t
@@ -1,6 +1,5 @@
 use strict;
 use warnings;
-no warnings 'once';
 use Test::More tests => 8;
 use DBIx::Class::Schema::Loader 'make_schema_at';
 use lib 't/lib';
diff --git a/t/80split_name.t b/t/80split_name.t
new file mode 100644
index 0000000..ee54765
--- /dev/null
+++ b/t/80split_name.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+use Test::More tests => 18;
+use DBIx::Class::Schema::Loader::Utils 'split_name';
+
+is_deeply [split_name('foo_bar_baz')], [qw/foo bar baz/],
+    'by underscore';
+
+is_deeply [split_name('foo__bar__baz')], [qw/foo bar baz/],
+    'by double underscore';
+
+is_deeply [split_name('Foo_Bar_Baz')], [qw/Foo Bar Baz/],
+    'by underscore with full capitalization';
+
+is_deeply [split_name('foo_Bar_Baz')], [qw/foo Bar Baz/],
+    'by underscore with lcfirst capitalization';
+
+is_deeply [split_name('fooBarBaz')], [qw/foo Bar Baz/],
+    'lcfirst camelCase identifier';
+
+is_deeply [split_name('FooBarBaz')], [qw/Foo Bar Baz/],
+    'ucfirst camelCase identifier';
+
+is_deeply [split_name('VLANValidID')], [qw/VLAN Valid ID/],
+    'CAMELCase identifier (word with all caps)';
+
+is_deeply [split_name('VlanVALIDId')], [qw/Vlan VALID Id/],
+    'CamelCASE identifier (second word with all caps)';
+
+is_deeply [split_name('foo..bar/baz')], [qw/foo bar baz/],
+    'by non-alphanum chars';
+
+# naming=v7
+
+is_deeply [split_name('foo_bar_baz', 7)], [qw/foo bar baz/],
+    'by underscore for v=7';
+
+is_deeply [split_name('foo__bar__baz', 7)], [qw/foo bar baz/],
+    'by double underscore for v=7';
+
+is_deeply [split_name('Foo_Bar_Baz', 7)], [qw/Foo Bar Baz/],
+    'by underscore with full capitalization for v=7';
+
+is_deeply [split_name('foo_Bar_Baz', 7)], [qw/foo Bar Baz/],
+    'by underscore with lcfirst capitalization for v=7';
+
+is_deeply [split_name('fooBarBaz', 7)], [qw/foo Bar Baz/],
+    'lcfirst camelCase identifier for v=7';
+
+is_deeply [split_name('FooBarBaz', 7)], [qw/Foo Bar Baz/],
+    'ucfirst camelCase identifier for v=7';
+
+is_deeply [split_name('VLANValidID', 7)], [qw/VLANValid ID/],
+    'CAMELCase identifier (word with all caps) for v=7';
+
+is_deeply [split_name('VlanVALIDId', 7)], [qw/Vlan VALIDId/],
+    'CamelCASE identifier (second word with all caps) for v=7';
+
+is_deeply [split_name('foo..bar/baz', 7)], [qw/foo bar baz/],
+    'by non-alphanum chars for v=7';