rewrite IM predicates

3 files changed, 13 insertions, 7 deletions

diff --git a/lib/Reaction/InterfaceModel/Action.pm b/lib/Reaction/InterfaceModel/Action.pm
index 52b94f8..55cdfbe 100644
--- a/lib/Reaction/InterfaceModel/Action.pm
+++ b/lib/Reaction/InterfaceModel/Action.pm
@@ -23,7 +23,7 @@ class Action which {
     my %params;
     foreach my $attr ($self->parameter_attributes) {
       my $reader = $attr->get_read_method;
-      my $predicate = $attr->predicate;
+      my $predicate = $attr->get_predicate_method;
       next if defined($predicate) && !$self->$predicate;
       $params{$attr->name} = $self->$reader;
     }
@@ -33,7 +33,7 @@ class Action which {
   implements can_apply => as {
     my ($self) = @_;
     foreach my $attr ($self->parameter_attributes) {
-      my $predicate = $attr->predicate;
+      my $predicate = $attr->get_predicate_method;
       if ($self->attribute_is_required($attr)) {
         return 0 unless $self->$predicate;
       }
@@ -61,7 +61,7 @@ class Action which {
   implements error_for_attribute => as {
     my ($self, $attr) = @_;
     my $reader = $attr->get_read_method;
-    my $predicate = $attr->predicate;
+    my $predicate = $attr->get_predicate_method;
     if ($self->attribute_is_required($attr)) {
       unless ($self->$predicate) {
         return $attr->name." is required";
diff --git a/lib/Reaction/InterfaceModel/Action/User/Login.pm b/lib/Reaction/InterfaceModel/Action/User/Login.pm
index 0bc3d97..46dddea 100644
--- a/lib/Reaction/InterfaceModel/Action/User/Login.pm
+++ b/lib/Reaction/InterfaceModel/Action/User/Login.pm
@@ -13,7 +13,7 @@ class Login, is Action, which {
     my $super = shift;
     my ($self, $attr) = @_;
     my $result = $super->(@_);
-    my $predicate = $attr->predicate;
+    my $predicate = $attr->get_predicate_method;
     if (defined $result && $self->$predicate) {
       return 'Invalid username or password';
     }
diff --git a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
index 120ddb1..2c34cdf 100644
--- a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
+++ b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm
@@ -676,7 +676,10 @@ class DBIC, which {
     #default options. lazy build but no outsider method
     my %attr_opts = ( is => 'ro', lazy => 1, required => 1,
                       clearer   => "_clear_${attr_name}",
-                      predicate => "has_${attr_name}",
+                      predicate => {
+                          "has_${attr_name}" =>
+                              sub { defined(shift->$dm_name->$attr_name) }
+                      },
                       domain_model   => $dm_name,
                       orig_attr_name => $attr_name,
                     );
@@ -706,8 +709,11 @@ class DBIC, which {
         #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 {
-          shift->$dm_name
-            ->find_related($attr_name, {},{result_class => $attr_opts{isa}});
+          if (defined(my $o = shift->$dm_name->$attr_name)) {
+            return $attr_opts{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$/ ) {