new component to make m2ms introspectables so we can hint the reflector

1 files changed, 48 insertions, 32 deletions

diff --git a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
index 21887b5..5c852b6 100644
--- a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
+++ b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
@@ -686,6 +686,11 @@ class DBIC, which {
                     );
 
     #m2m / has_many
+    my $m2m_meta;
+    if(my $coderef = $source->result_class->can('_m2m_metadata')){
+      $m2m_meta = $source->result_class->$coderef;
+    }
+
     my $constraint_is_ArrayRef =
       $from_attr->type_constraint->name eq 'ArrayRef' ||
         $from_attr->type_constraint->is_subtype_of('ArrayRef');
@@ -698,22 +703,21 @@ class DBIC, which {
         #has_many
         my $sm = $self->class_name_from_source_name($parent_class, $rel_moniker);
         #type constraint is a collection, and default builds it
-        $attr_opts{isa} = $self->class_name_for_collection_of($sm);
-        $attr_opts{default} = sub {
-          my $rs = shift->$dm_name->related_resultset($attr_name);
-          return $attr_opts{isa}->new(_source_resultset => $rs);
-        };
+        my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);
+        $attr_opts{default} = eval "sub {
+          my \$rs = shift->${dm_name}->related_resultset('${attr_name}');
+          return ${isa}->new(_source_resultset => \$rs);
+        }";
       } elsif( $rel_accessor eq 'single') {
         #belongs_to
         #type constraint is the foreign IM object, default inflates it
-        $attr_opts{isa} = $self->class_name_from_source_name($parent_class, $rel_moniker);
-        $attr_opts{default} = sub {
-          if (defined(my $o = shift->$dm_name->$reader)) {
-            return $attr_opts{isa}->inflate_result($o->result_source, { $o->get_columns });
+        my $isa = $attr_opts{isa} = $self->class_name_from_source_name($parent_class, $rel_moniker);
+        $attr_opts{default} = eval "sub {
+          if (defined(my \$o = shift->${dm_name}->${reader})) {
+            return ${isa}->inflate_result(\$o->result_source, { \$o->get_columns });
           }
           return undef;
-            #->find_related($attr_name, {},{result_class => $attr_opts{isa}});
-        };
+        }";
       }
     } elsif( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/ ) {
       #m2m magic
@@ -727,26 +731,31 @@ class DBIC, which {
           ." traversing many-many for ${mm_name}_list";
 
       my $sm = $self->class_name_from_source_name($parent_class,$far_side->source_name);
-      $attr_opts{isa} = $self->class_name_for_collection_of($sm);
+      my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);
 
       #proper collections will remove the result_class uglyness.
-      $attr_opts{default} = sub {
-        my $rs = shift->$dm_name->related_resultset($link_table)->related_resultset($mm_name);
-        return $attr_opts{isa}->new(_source_resultset => $rs);
-      };
-    #} elsif( $constraint_is_ArrayRef ){
-      #test these to see if rel is m2m
-      #my $meth = $attr_name;
-      #if( $source->can("set_${meth}") && $source->can("add_to_${meth}") &&
-      #    $source->can("${meth}_rs") && $source->can("remove_from_${meth}") ){
-
-
-      #}
+      $attr_opts{default} = eval "sub {
+        my \$rs = shift->${dm_name}->related_resultset('${link_table}')->related_resultset('${mm_name}');
+        return ${isa}->new(_source_resultset => \$rs);
+      }";
+    } elsif( $constraint_is_ArrayRef && defined $m2m_meta && exists $m2m_meta->{$attr_name} ){
+      #m2m if using introspectable m2m component
+      my $rel = $m2m_meta->{$attr_name}->{relation};
+      my $far_rel   = $m2m_meta->{$attr_name}->{foreign_relation};
+      my $far_source = $source->related_source($rel)->related_source($far_rel);
+      my $sm = $self->class_name_from_source_name($parent_class, $far_source->source_name);
+      my $isa = $attr_opts{isa} = $self->class_name_for_collection_of($sm);
+
+      my $rs_meth = $m2m_meta->{$attr_name}->{rs_method};
+      $attr_opts{default} = eval "sub {
+        return ${isa}->new(_source_resultset => shift->${dm_name}->${rs_meth});
+      }";
     } else {
       #no rel
       $attr_opts{isa} = $from_attr->_isa_metadata;
-      $attr_opts{default} = sub{ shift->$dm_name->$reader };
+      $attr_opts{default} = eval "sub{ shift->${dm_name}->${reader} }";
     }
+
     return \%attr_opts;
   };
 
@@ -860,6 +869,11 @@ class DBIC, which {
         }
     }
 
+
+    my $m2m_meta;
+    if(my $coderef = $source_class->result_class->can('_m2m_metadata')){
+      $m2m_meta = $source_class->result_class->$coderef;
+    }
     #test for relationships
     my $constraint_is_ArrayRef =
       $from_attr->type_constraint->name eq 'ArrayRef' ||
@@ -879,18 +893,20 @@ class DBIC, which {
     } elsif ( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/) {
       my $mm_name = $1;
       my $link_table = "links_to_${mm_name}_list";
-      my ($hm_source, $far_side);
-      eval { $hm_source = $source->related_source($link_table); }
-        || confess "Can't find ${link_table} has_many for ${mm_name}_list";
-      eval { $far_side = $hm_source->related_source($mm_name); }
-        || confess "Can't find ${mm_name} belongs_to on ".$hm_source->result_class
-          ." traversing many-many for ${mm_name}_list";
-
       $attr_opts{default} = sub { [] };
       $attr_opts{valid_values} = sub {
         shift->target_model->result_source->related_source($link_table)
           ->related_source($mm_name)->resultset;
       };
+    } elsif( $constraint_is_ArrayRef && defined $m2m_meta && exists $m2m_meta->{$attr_name} ){
+      #m2m if using introspectable m2m component
+      my $rel = $m2m_meta->{$attr_name}->{relation};
+      my $far_rel   = $m2m_meta->{$attr_name}->{foreign_relation};
+      $attr_opts{default} = sub { [] };
+      $attr_opts{valid_values} = sub {
+        shift->target_model->result_source->related_source($rel)
+          ->related_source($far_rel)->resultset;
+      };
     }
     #use Data::Dumper;
     #print STDERR "\n" .$attr_name ." - ". $object . "\n";