Re-fix relcond resolver: revert 5592d633 (in turn partial revert of 03f6d1f7)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
index 0a5e94b..cc865b4 100644 (file)
@@ -9,6 +9,7 @@ use DBIx::Class::ResultSet;
 use DBIx::Class::ResultSourceHandle;
 
 use DBIx::Class::Carp;
+use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
 use Devel::GlobalDestruction;
 use Try::Tiny;
 use List::Util 'first';
@@ -201,7 +202,7 @@ schema, see L<DBIx::Class::Schema/deploy>.
 
    { is_nullable => 1 }
 
-Set this to a true value for a columns that is allowed to contain NULL
+Set this to a true value for a column that is allowed to contain NULL
 values, default is false. This is currently only used to create tables
 from your schema, see L<DBIx::Class::Schema/deploy>.
 
@@ -627,7 +628,7 @@ sub primary_columns {
 # a helper method that will automatically die with a descriptive message if
 # no pk is defined on the source in question. For internal use to save
 # on if @pks... boilerplate
-sub _pri_cols {
+sub _pri_cols_or_die {
   my $self = shift;
   my @pcols = $self->primary_columns
     or $self->throw_exception (sprintf(
@@ -638,6 +639,20 @@ sub _pri_cols {
   return @pcols;
 }
 
+# same as above but mandating single-column PK (used by relationship condition
+# inference)
+sub _single_pri_col_or_die {
+  my $self = shift;
+  my ($pri, @too_many) = $self->_pri_cols_or_die;
+
+  $self->throw_exception( sprintf(
+    "Operation requires a single-column primary key declared on '%s'",
+    $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
+  )) if @too_many;
+  return $pri;
+}
+
+
 =head2 sequence
 
 Manually define the correct sequence for your table, to avoid the overhead
@@ -1348,7 +1363,7 @@ sub add_relationship {
 
 =back
 
-  my @relnames = $source->relationships();
+  my @rel_names = $source->relationships();
 
 Returns all relationship names for this source.
 
@@ -1654,152 +1669,364 @@ sub _pk_depends_on {
   return 1;
 }
 
-sub resolve_condition {
-  carp 'resolve_condition is a private method, stop calling it';
-  my $self = shift;
-  $self->_resolve_condition (@_);
+sub _resolve_condition {
+#  carp_unique sprintf
+#    '_resolve_condition is a private method, and moreover is about to go '
+#  . 'away. Please contact the development team at %s if you believe you '
+#  . 'have a genuine use for this method, in order to discuss alternatives.',
+#    DBIx::Class::_ENV_::HELP_URL,
+#  ;
+
+#######################
+### API Design? What's that...? (a backwards compatible shim, kill me now)
+
+  my ($self, $cond, @res_args, $rel_name);
+
+  # we *SIMPLY DON'T KNOW YET* which arg is which, yay
+  ($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_;
+
+  # assume that an undef is an object-like unset (set_from_related(undef))
+  my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args);
+
+  # turn objlike into proper objects for saner code further down
+  for (0,1) {
+    next unless $is_objlike[$_];
+
+    if ( defined blessed $res_args[$_] ) {
+
+      # but wait - there is more!!! WHAT THE FUCK?!?!?!?!
+      if ($res_args[$_]->isa('DBIx::Class::ResultSet')) {
+        carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__');
+        $is_objlike[$_] = 0;
+        $res_args[$_] = '__gremlins__';
+      }
+    }
+    else {
+      $res_args[$_] ||= {};
+
+      # hate everywhere - have to pass in as a plain hash
+      # pretending to be an object at least for now
+      $self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]")
+        unless ref $res_args[$_] eq 'HASH';
+    }
+  }
+
+  $self->throw_exception('No practical way to resolve a relationship between two structures')
+    if $is_objlike[0] and $is_objlike[1];
+
+  my $args = {
+    condition => $cond,
+
+    # where-is-waldo block guesses relname, then further down we override it if available
+    (
+      $is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me',         self_resultobj    => $res_args[1] )
+    : $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me',         foreign_alias => $res_args[1], foreign_resultobj => $res_args[0] )
+    :                  ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0]                                    )
+    ),
+
+    ( $rel_name ? ( rel_name => $rel_name ) : () ),
+  };
+#######################
+
+  # now it's fucking easy isn't it?!
+  my $rc = $self->_resolve_relationship_condition( $args );
+
+  my @res = (
+    ( $rc->{join_free_condition} || $rc->{condition} ),
+    ! $rc->{join_free_condition},
+  );
+
+  # _resolve_relationship_condition always returns qualified cols even in the
+  # case of join_free_condition, but nothing downstream expects this
+  if (ref $res[0] eq 'HASH' and ($is_objlike[0] or $is_objlike[1]) ) {
+    $res[0] = { map
+      { ($_ =~ /\.(.+)/) => $res[0]{$_} }
+      keys %{$res[0]}
+    };
+  }
+
+  # and more legacy
+  return wantarray ? @res : $res[0];
 }
 
-our $UNRESOLVABLE_CONDITION = \ '1 = 0';
+# Keep this indefinitely. There is evidence of both CPAN and
+# darkpan using it, and there isn't much harm in an extra var
+# anyway.
+our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION;
+# YES I KNOW THIS IS EVIL
+# it is there to save darkpan from themselves, since internally
+# we are moving to a constant
+Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1);
+
+# Resolves the passed condition to a concrete query fragment and extra
+# metadata
+#
+## self-explanatory API, modeled on the custom cond coderef:
+# rel_name
+# foreign_alias
+# foreign_resultobj
+# self_alias
+# self_resultobj
+# require_join_free_condition
+# infer_values_based_on (optional, mandatory hashref argument)
+# condition (optional, derived from $self->rel_info(rel_name))
+#
+## returns a hash
+# condition
+# join_free_condition (maybe undef)
+# inferred_values (maybe undef, always complete or empty)
+#
+sub _resolve_relationship_condition {
+  my $self = shift;
+
+  my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ };
 
-# Resolves the passed condition to a concrete query fragment and a flag
-# indicating whether this is a cross-table condition. Also an optional
-# list of non-trivial values (normally conditions) returned as a part
-# of a joinfree condition hash
-sub _resolve_condition {
-  my ($self, $cond, $as, $for, $rel_name) = @_;
+  for ( qw( rel_name self_alias foreign_alias ) ) {
+    $self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string")
+      if !defined $args->{$_} or length ref $args->{$_};
+  }
+
+  my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'";
+
+  my $rel_info = $self->relationship_info($args->{rel_name});
+  #  or $self->throw_exception( "No such $exception_rel_id" );
+
+  $self->throw_exception("No practical way to resolve $exception_rel_id between two objects")
+    if defined $args->{self_resultobj} and defined $args->{foreign_resultobj};
+
+  $self->throw_exception( "Argument to infer_values_based_on must be a hash" )
+    if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH';
 
-  my $obj_rel = defined blessed $for;
+  $args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
 
-  if (ref $cond eq 'CODE') {
-    my $relalias = $obj_rel ? 'me' : $as;
+  $args->{condition} ||= $rel_info->{cond};
 
-    my ($crosstable_cond, $joinfree_cond) = $cond->({
-      self_alias => $obj_rel ? $as : $for,
-      foreign_alias => $relalias,
+  if (exists $args->{self_resultobj}) {
+    if (defined blessed $args->{self_resultobj}) {
+#      $self->throw_exception( "Object '$args->{self_resultobj}' must be of class '@{[ $self->result_class ]}'" )
+#        unless $args->{self_resultobj}->isa($self->result_class);
+    }
+    else {
+      $args->{self_resultobj} = DBIx::Class::Core->new({
+        -result_source => $self,
+        %{ $args->{self_resultobj}||{} }
+      });
+    }
+  }
+
+  if (exists $args->{foreign_resultobj}) {
+    if (defined blessed $args->{foreign_resultobj}) {
+#      $self->throw_exception( "Object '$args->{foreign_resultobj}' must be of class '$rel_info->{class}'" )
+#        unless $args->{foreign_resultobj}->isa($rel_info->{class});
+    }
+    else {
+      $args->{foreign_resultobj} = DBIx::Class::Core->new({
+        -result_source => $self->related_source($args->{rel_name}),
+        %{ $args->{foreign_resultobj}||{} }
+      });
+    }
+  }
+
+  my $ret;
+
+  if (ref $args->{condition} eq 'CODE') {
+
+    my $cref_args = {
+      rel_name => $args->{rel_name},
       self_resultsource => $self,
-      foreign_relname => $rel_name || ($obj_rel ? $as : $for),
-      self_rowobj => $obj_rel ? $for : undef
-    });
+      self_alias => $args->{self_alias},
+      foreign_alias => $args->{foreign_alias},
+      ( map
+        { (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () }
+        qw( self_resultobj foreign_resultobj )
+      ),
+    };
 
-    my $cond_cols;
-    if ($joinfree_cond) {
+    # legacy - never remove these!!!
+    $cref_args->{foreign_relname} = $cref_args->{rel_name};
+
+    $cref_args->{self_rowobj} = $cref_args->{self_resultobj}
+      if exists $cref_args->{self_resultobj};
+
+    ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
+
+    # FIXME sanity check
+    carp_unique('A custom condition coderef can return at most 2 conditions: extra return values discarded')
+      if @extra;
+
+    if (my $jfc = $ret->{join_free_condition}) {
 
-      # FIXME sanity check until things stabilize, remove at some point
       $self->throw_exception (
-        "A join-free condition returned for relationship '$rel_name' without a row-object to chain from"
-      ) unless $obj_rel;
-
-      # FIXME another sanity check
-      if (
-        ref $joinfree_cond ne 'HASH'
-          or
-        first { $_ !~ /^\Q$relalias.\E.+/ } keys %$joinfree_cond
-      ) {
-        $self->throw_exception (
-          "The join-free condition returned for relationship '$rel_name' must be a hash "
-         .'reference with all keys being valid columns on the related result source'
-        );
-      }
+        "The join-free condition returned for $exception_rel_id must be a hash reference"
+      ) unless ref $jfc eq 'HASH';
 
-      # normalize
-      for (values %$joinfree_cond) {
-        $_ = $_->{'='} if (
-          ref $_ eq 'HASH'
-            and
-          keys %$_ == 1
-            and
-          exists $_->{'='}
-        );
+      my ($joinfree_alias, $joinfree_source);
+      if (defined $args->{self_resultobj}) {
+        $joinfree_alias = $args->{foreign_alias};
+        $joinfree_source = $self->related_source($args->{rel_name});
+      }
+      elsif (defined $args->{foreign_resultobj}) {
+        $joinfree_alias = $args->{self_alias};
+        $joinfree_source = $self;
       }
 
-      # see which parts of the joinfree cond are conditionals
-      my $relcol_list = { map { $_ => 1 } $self->related_source($rel_name)->columns };
+      # FIXME sanity check until things stabilize, remove at some point
+      $self->throw_exception (
+        "A join-free condition returned for $exception_rel_id without a result object to chain from"
+      ) unless $joinfree_alias;
 
-      for my $c (keys %$joinfree_cond) {
-        my ($colname) = $c =~ /^ (?: \Q$relalias.\E )? (.+)/x;
+      my $fq_col_list = { map
+        { ( "$joinfree_alias.$_" => 1 ) }
+        $joinfree_source->columns
+      };
 
-        unless ($relcol_list->{$colname}) {
-          push @$cond_cols, $colname;
-          next;
-        }
+      $fq_col_list->{$_} or $self->throw_exception (
+        "The join-free condition returned for $exception_rel_id may only "
+      . 'contain keys that are fully qualified column names of the corresponding source'
+      ) for keys %$jfc;
+
+    }
+  }
+  elsif (ref $args->{condition} eq 'HASH') {
+
+    # the condition is static - use parallel arrays
+    # for a "pivot" depending on which side of the
+    # rel did we get as an object
+    my (@f_cols, @l_cols);
+    for my $fc (keys %{$args->{condition}}) {
+      my $lc = $args->{condition}{$fc};
+
+      # FIXME STRICTMODE should probably check these are valid columns
+      $fc =~ s/^foreign\.// ||
+        $self->throw_exception("Invalid rel cond key '$fc'");
+
+      $lc =~ s/^self\.// ||
+        $self->throw_exception("Invalid rel cond val '$lc'");
+
+      push @f_cols, $fc;
+      push @l_cols, $lc;
+    }
+
+    # construct the crosstable condition
+    $ret->{condition} = { map
+      {( "$args->{foreign_alias}.$f_cols[$_]" => { -ident => "$args->{self_alias}.$l_cols[$_]" } )}
+      (0..$#f_cols)
+    };
+
+    if (exists $args->{self_resultobj} or exists $args->{foreign_resultobj}) {
+
+      my ($obj, $obj_alias, $plain_alias, $obj_cols, $plain_cols) = defined $args->{self_resultobj}
+        ? ( @{$args}{qw( self_resultobj self_alias foreign_alias )}, \@l_cols, \@f_cols )
+        : ( @{$args}{qw( foreign_resultobj foreign_alias self_alias )}, \@f_cols, \@l_cols )
+      ;
+
+      for my $i (0..$#$obj_cols) {
 
         if (
-          ref $joinfree_cond->{$c}
+          defined $args->{self_resultobj}
             and
-          ref $joinfree_cond->{$c} ne 'SCALAR'
-            and
-          ref $joinfree_cond->{$c} ne 'REF'
+          ! $obj->has_column_loaded($obj_cols->[$i])
         ) {
-          push @$cond_cols, $colname;
-          next;
+
+          $self->throw_exception(sprintf
+            "Unable to resolve relationship '%s' from object '%s': column '%s' not "
+          . 'loaded from storage (or not passed to new() prior to insert()). You '
+          . 'probably need to call ->discard_changes to get the server-side defaults '
+          . 'from the database.',
+            $args->{rel_name},
+            $obj,
+            $obj_cols->[$i],
+          ) if $obj->in_storage;
+
+          # FIXME - temporarly force-override
+          delete $args->{require_join_free_condition};
+          $ret->{join_free_condition} = UNRESOLVABLE_CONDITION;
+          last;
+        }
+        else {
+          $ret->{join_free_condition}{"$plain_alias.$plain_cols->[$i]"} = $obj->get_column($obj_cols->[$i]);
         }
       }
-
-      return wantarray ? ($joinfree_cond, 0, $cond_cols) : $joinfree_cond;
+    }
+  }
+  elsif (ref $args->{condition} eq 'ARRAY') {
+    if (@{$args->{condition}} == 0) {
+      $ret = {
+        condition => UNRESOLVABLE_CONDITION,
+        join_free_condition => UNRESOLVABLE_CONDITION,
+      };
+    }
+    elsif (@{$args->{condition}} == 1) {
+      $ret = $self->_resolve_relationship_condition({
+        %$args,
+        condition => $args->{condition}[0],
+      });
     }
     else {
-      return wantarray ? ($crosstable_cond, 1) : $crosstable_cond;
+      # we are discarding inferred values here... likely incorrect...
+      # then again - the entire thing is an OR, so we *can't* use them anyway
+      for my $subcond ( map
+        { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
+        @{$args->{condition}}
+      ) {
+        $self->throw_exception('Either all or none of the OR-condition members can resolve to a join-free condition')
+          if $ret->{join_free_condition} and ! $subcond->{join_free_condition};
+
+        $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
+      }
     }
   }
-  elsif (ref $cond eq 'HASH') {
-    my %ret;
-    foreach my $k (keys %{$cond}) {
-      my $v = $cond->{$k};
-      # XXX should probably check these are valid columns
-      $k =~ s/^foreign\.// ||
-        $self->throw_exception("Invalid rel cond key ${k}");
-      $v =~ s/^self\.// ||
-        $self->throw_exception("Invalid rel cond val ${v}");
-      if (ref $for) { # Object
-        #warn "$self $k $for $v";
-        unless ($for->has_column_loaded($v)) {
-          if ($for->in_storage) {
-            $self->throw_exception(sprintf
-              "Unable to resolve relationship '%s' from object %s: column '%s' not "
-            . 'loaded from storage (or not passed to new() prior to insert()). You '
-            . 'probably need to call ->discard_changes to get the server-side defaults '
-            . 'from the database.',
-              $as,
-              $for,
-              $v,
-            );
-          }
-          return $UNRESOLVABLE_CONDITION;
+  else {
+    $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
+  }
+
+  $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
+    $args->{require_join_free_condition}
+      and
+    ( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
+  );
+
+  # we got something back - sanity check and infer values if we can
+  my @nonvalues;
+  if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
+
+    my $jfc_eqs = $self->schema->storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
+
+    if (keys %$jfc_eqs) {
+
+      for (keys %$jfc) {
+        # $jfc is fully qualified by definition
+        my ($col) = $_ =~ /\.(.+)/;
+
+        if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) {
+          $ret->{inferred_values}{$col} = $jfc_eqs->{$_};
+        }
+        elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) {
+          push @nonvalues, $col;
         }
-        $ret{$k} = $for->get_column($v);
-        #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
-        #warn %ret;
-      } elsif (!defined $for) { # undef, i.e. "no object"
-        $ret{$k} = undef;
-      } elsif (ref $as eq 'HASH') { # reverse hashref
-        $ret{$v} = $as->{$k};
-      } elsif (ref $as) { # reverse object
-        $ret{$v} = $as->get_column($k);
-      } elsif (!defined $as) { # undef, i.e. "no reverse object"
-        $ret{$v} = undef;
-      } else {
-        $ret{"${as}.${k}"} = { -ident => "${for}.${v}" };
       }
-    }
 
-    return wantarray
-      ? ( \%ret, ($obj_rel || !defined $as || ref $as) ? 0 : 1 )
-      : \%ret
-    ;
-  }
-  elsif (ref $cond eq 'ARRAY') {
-    my (@ret, $crosstable);
-    for (@$cond) {
-      my ($cond, $crosstab) = $self->_resolve_condition($_, $as, $for, $rel_name);
-      push @ret, $cond;
-      $crosstable ||= $crosstab;
+      # all or nothing
+      delete $ret->{inferred_values} if @nonvalues;
     }
-    return wantarray ? (\@ret, $crosstable) : \@ret;
   }
-  else {
-    $self->throw_exception ("Can't handle condition $cond for relationship '$rel_name' yet :(");
+
+  # did the user explicitly ask
+  if ($args->{infer_values_based_on}) {
+
+    $self->throw_exception(sprintf (
+      "Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s",
+      map { "'$_'" } @nonvalues
+    )) if @nonvalues;
+
+
+    $ret->{inferred_values} ||= {};
+
+    $ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_}
+      for keys %{$args->{infer_values_based_on}};
   }
+
+  $ret
 }
 
 =head2 related_source