From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 7 Jul 2010 23:19:07 +0000 (-0400)
Subject: better rel postfix stripping for v8 mode
X-Git-Tag: 0.07011~25
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=ccf9b8a69b4aedbaee445d2240bfbf6e9b061016

better rel postfix stripping for v8 mode

Change the _id stripping in ::RelBuilder to strip other things as well,
like Id, ref, cd, code, _num.

This is only activated for the experimental { naming => 'v8' } mode.
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index b42584b..7c249f8 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -168,7 +168,7 @@ overwriting a dump made with an earlier version.
 
 The option also takes a hashref:
 
-    naming => { relationships => 'v7', monikers => 'v7' }
+    naming => { relationships => 'v8', monikers => 'v8' }
 
 The keys are:
 
@@ -245,7 +245,11 @@ L</naming> explictly until C<0.08> comes out.
 
 L</monikers> are created using L<String::ToIdentifier::EN::Unicode> or
 L<String::ToIdentifier::EN> if L</force_ascii> is set; this is only significant
-for table names with non C<\w> characters such as C<.>.
+for table names with non-C<\w> characters such as C<.>.
+
+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>.
 
 =item preserve
 
@@ -1398,20 +1402,18 @@ sub _relbuilder {
     return if $self->{skip_relationships};
 
     return $self->{relbuilder} ||= do {
-
-        no warnings 'uninitialized';
         my $relbuilder_suff =
             {qw{
                 v4  ::Compat::v0_040
                 v5  ::Compat::v0_05
                 v6  ::Compat::v0_06
+                v7  ::Compat::v0_07
             }}
-            ->{ $self->naming->{relationships}};
+            ->{$self->naming->{relationships}||$CURRENT_V} || '';
 
         my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
         $self->ensure_class_loaded($relbuilder_class);
-        $relbuilder_class->new( $self );
-
+        $relbuilder_class->new($self);
     };
 }
 
diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index 9b75e80..f4d65b6 100644
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -268,6 +268,14 @@ sub _relationship_attrs {
     return \%composite;
 }
 
+sub _strip_id_postfix {
+    my ($self, $name) = @_;
+
+    $name =~ s/_?(?:id|ref|cd|code|num)\z//i;
+
+    return $name;
+}
+
 sub _array_eq {
     my ($self, $a, $b) = @_;
 
@@ -319,8 +327,7 @@ sub _remote_relname {
     # name, to make filter accessors work, but strip trailing _id
     if(scalar keys %{$cond} == 1) {
         my ($col) = values %{$cond};
-        $col = $self->_normalize_name($col);
-        $col =~ s/_id$//;
+        $col = $self->_strip_id_postfix($self->_normalize_name($col));
         ($remote_relname) = $self->_inflect_singular($col);
     }
     else {
@@ -715,8 +722,7 @@ sub _relnames_and_method {
             my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
             $remote_relname .= $colnames if keys %$cond > 1;
 
-            $local_relname = $self->_normalize_name($local_table . $colnames);
-            $local_relname =~ s/_id$//;
+            $local_relname = $self->_strip_id_postfix($self->_normalize_name($local_table . $colnames));
 
             $local_relname_uninflected = $local_relname;
             ($local_relname) = $self->_inflect_plural($local_relname);
diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_06.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_06.pm
index 6016436..89f3452 100644
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_06.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_06.pm
@@ -2,7 +2,7 @@ package DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_06;
 
 use strict;
 use warnings;
-use base 'DBIx::Class::Schema::Loader::RelBuilder';
+use base 'DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_07';
 use mro 'c3';
 
 our $VERSION = '0.07010';
@@ -18,7 +18,7 @@ sub _normalize_name {
 =head1 NAME
 
 DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_06 - RelBuilder for
-compatibility with DBIx::Class::Schema::Loader version 0.06001
+compatibility with DBIx::Class::Schema::Loader version 0.06000
 
 =head1 DESCRIPTION
 
diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_07.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_07.pm
new file mode 100644
index 0000000..f154355
--- /dev/null
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_07.pm
@@ -0,0 +1,42 @@
+package DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_07;
+
+use strict;
+use warnings;
+use base 'DBIx::Class::Schema::Loader::RelBuilder';
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_07 - RelBuilder for
+compatibility with DBIx::Class::Schema::Loader version 0.07000
+
+=head1 DESCRIPTION
+
+See L<DBIx::Class::Schema::Loader::Base/naming> and
+L<DBIx::Class::Schema::Loader::RelBuilder>.
+
+=cut
+
+our $VERSION = '0.07010';
+
+sub _strip_id_postfix {
+    my ($self, $name) = @_;
+
+    $name =~ s/_id\z//;
+
+    return $name;
+}
+
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
+# vim:et sts=4 sw=4 tw=0: