Allow coderef maps to call back into the hashref mapping code

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / RelBuilder.pm

diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index 85d0110..94820f9 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -18,7 +18,7 @@ use String::ToIdentifier::EN::Unicode ();
 use Class::Unload ();
 use Class::Inspector ();
 
-our $VERSION = '0.07036_04';
+our $VERSION = '0.07037';
 
 # Glossary:
 #
@@ -959,9 +959,13 @@ sub _rel_name_map {
         remote_columns => $remote_cols,
     };
 
-    my $new_name = $relname;
+    $self->_run_user_map($self->rel_name_map, $info);
+}
+
+sub _run_user_map {
+    my ($self, $map, $info) = @_;
 
-    my $map = $self->rel_name_map;
+    my $new_name = $info->{name};
     my $mapped = 0;
 
     if ('HASH' eq ref($map)) {
@@ -979,7 +983,14 @@ sub _rel_name_map {
         }
     }
     elsif ('CODE' eq ref($map)) {
-        my $name = $map->($info);
+        my $cb = sub {
+            my ($cb_map) = @_;
+            croak "reentered rel_name_map must be a hashref"
+                unless 'HASH' eq ref($cb_map);
+            my ($cb_name, $cb_mapped) = $self->_run_user_map($cb_map, $info);
+            return $cb_mapped && $cb_name;
+        };
+        my $name = $map->($info, $cb);
         if ($name) {
             $new_name = $name;
             $mapped   = 1;