checks if the complex conditions are overriden in set_from_related
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm
index 821f5cb..4f41baa 100644 (file)
@@ -18,7 +18,7 @@ use base qw/DBIx::Class/;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
   _columns _primaries _unique_constraints name resultset_attributes
-  schema from _relationships column_info_from_storage source_info
+  from _relationships column_info_from_storage source_info
   source_name sqlt_deploy_callback/);
 
 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
@@ -367,7 +367,7 @@ sub column_info {
   if ( ! $self->_columns->{$column}{data_type}
        and ! $self->{_columns_info_loaded}
        and $self->column_info_from_storage
-       and $self->schema and my $stor = $self->storage )
+       and my $stor = try { $self->storage } )
   {
     $self->{_columns_info_loaded}++;
 
@@ -445,9 +445,7 @@ sub columns_info {
       and
     $self->column_info_from_storage
       and
-    $self->schema
-      and
-    my $stor = $self->storage
+    my $stor = try { $self->storage }
   ) {
     $self->{_columns_info_loaded}++;
 
@@ -635,12 +633,11 @@ will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
 sub sequence {
   my ($self,$seq) = @_;
 
-  my $rsrc = $self->result_source;
-  my @pks = $rsrc->primary_columns
+  my @pks = $self->primary_columns
     or next;
 
   $_->{sequence} = $seq
-    for values %{ $rsrc->columns_info (\@pks) };
+    for values %{ $self->columns_info (\@pks) };
 }
 
 
@@ -1016,11 +1013,11 @@ sub resultset {
     'call it on the schema instead.'
   ) if scalar @_;
 
-  return $self->resultset_class->new(
+  $self->resultset_class->new(
     $self,
     {
+      try { %{$self->schema->default_resultset_attributes} },
       %{$self->{resultset_attributes}},
-      %{$self->schema->default_resultset_attributes}
     },
   );
 }
@@ -1067,7 +1064,7 @@ clause contents.
 
 =over 4
 
-=item Arguments: None
+=item Arguments: $schema
 
 =item Return value: A schema object
 
@@ -1075,8 +1072,29 @@ clause contents.
 
   my $schema = $source->schema();
 
-Returns the L<DBIx::Class::Schema> object that this result source
-belongs to.
+Sets and/or returns the L<DBIx::Class::Schema> object to which this
+result source instance has been attached to.
+
+=cut
+
+sub schema {
+  if (@_ > 1) {
+    $_[0]->{schema} = $_[1];
+  }
+  else {
+    $_[0]->{schema} || do {
+      my $name = $_[0]->{source_name} || '_unnamed_';
+      my $err = 'Unable to perform storage-dependent operations with a detached result source '
+              . "(source '$name' is not associated with a schema).";
+
+      $err .= ' You need to use $schema->thaw() or manually set'
+            . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
+        if $_[0]->{_detached_thaw};
+
+      DBIx::Class::Exception->throw($err);
+    };
+  }
+}
 
 =head2 storage
 
@@ -1327,11 +1345,14 @@ sub reverse_relationship_info {
   my @otherrels = $othertable->relationships();
   my $otherrelationship;
   foreach my $otherrel (@otherrels) {
-    my $otherrel_info = $othertable->relationship_info($otherrel);
+    # this may be a partial schema with the related source not being
+    # available at all
+    my $back = try { $othertable->related_source($otherrel) } or next;
 
-    my $back = $othertable->related_source($otherrel);
+    # did we get back to ourselves?
     next unless $back->source_name eq $self->source_name;
 
+    my $otherrel_info = $othertable->relationship_info($otherrel);
     my @othertestconds;
 
     if (ref $otherrel_info->{cond} eq 'HASH') {
@@ -1458,7 +1479,7 @@ sub _resolve_join {
 
     my $rel_src = $self->related_source($join);
     return [ { $as => $rel_src->from,
-               -source_handle => $rel_src->handle,
+               -rsrc => $rel_src,
                -join_type => $parent_force_left
                   ? 'left'
                   : $rel_info->{attrs}{join_type}
@@ -1472,7 +1493,7 @@ sub _resolve_join {
                -alias => $as,
                -relation_chain_depth => $seen->{-relation_chain_depth} || 0,
              },
-             $self->_resolve_condition($rel_info->{cond}, $as, $alias) ];
+             $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) ];
   }
 }
 
@@ -1530,8 +1551,32 @@ sub resolve_condition {
 our $UNRESOLVABLE_CONDITION = \'1 = 0';
 
 sub _resolve_condition {
-  my ($self, $cond, $as, $for) = @_;
-  if (ref $cond eq 'HASH') {
+  my ($self, $cond, $as, $for, $rel) = @_;
+  if (ref $cond eq 'CODE') {
+
+    # heuristic for the actual relname
+    if (! defined $rel) {
+      if (!ref $as) {
+        $rel = $as;
+      }
+      elsif (!ref $for) {
+        $rel = $for;
+      }
+    }
+
+    if (! defined $rel) {
+      $self->throw_exception ('Unable to determine relationship name for condition resolution');
+    }
+
+    return $cond->({
+      self_alias => ref $for ? $as : $for,
+      foreign_alias => ref $for ? $self->related_source($rel)->resultset->current_source_alias : $as,
+      self_resultsource => $self,
+      foreign_relname => $rel,
+      self_rowobj => ref $for ? $for : undef
+    });
+
+  } elsif (ref $cond eq 'HASH') {
     my %ret;
     foreach my $k (keys %{$cond}) {
       my $v = $cond->{$k};
@@ -1575,7 +1620,7 @@ sub _resolve_condition {
   } elsif (ref $cond eq 'ARRAY') {
     return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
   } else {
-   die("Can't handle condition $cond yet :(");
+    $self->throw_exception ("Can't handle condition $cond yet :(");
   }
 }
 
@@ -1632,6 +1677,7 @@ sub _resolve_prefetch {
         "Can't prefetch has_many ${pre} (join cond too complex)")
         unless ref($rel_info->{cond}) eq 'HASH';
       my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
+
       if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
                          keys %{$collapse}) {
         my ($last) = ($fail =~ /([^\.]+)$/);
@@ -1645,6 +1691,7 @@ sub _resolve_prefetch {
           . 'Use at your own risk.'
         );
       }
+
       #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
       #              values %{$rel_info->{cond}};
       $collapse->{".${as_prefix}${pre}"} = [ $rel_source->_pri_cols ];
@@ -1732,16 +1779,31 @@ sub related_class {
 
 =head2 handle
 
-Obtain a new handle to this source. Returns an instance of a
-L<DBIx::Class::ResultSourceHandle>.
+=over 4
+
+=item Arguments: None
+
+=item Return value: $source_handle
+
+=back
+
+Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
+for this source. Used as a serializable pointer to this resultsource, as it is not
+easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
+relationship definitions.
 
 =cut
 
 sub handle {
-    return DBIx::Class::ResultSourceHandle->new({
-        schema         => $_[0]->schema,
-        source_moniker => $_[0]->source_name
-    });
+  return DBIx::Class::ResultSourceHandle->new({
+    source_moniker => $_[0]->source_name,
+
+    # so that a detached thaw can be re-frozen
+    $_[0]->{_detached_thaw}
+      ? ( _detached_source  => $_[0]          )
+      : ( schema            => $_[0]->schema  )
+    ,
+  });
 }
 
 {
@@ -1782,18 +1844,13 @@ sub handle {
   }
 }
 
-sub STORABLE_freeze {
-  my ($self, $cloning) = @_;
-  nfreeze($self->handle);
-}
+sub STORABLE_freeze { nfreeze($_[0]->handle) }
 
 sub STORABLE_thaw {
   my ($self, $cloning, $ice) = @_;
   %$self = %{ (thaw $ice)->resolve };
 }
 
-
-
 =head2 throw_exception
 
 See L<DBIx::Class::Schema/"throw_exception">.
@@ -1803,12 +1860,10 @@ See L<DBIx::Class::Schema/"throw_exception">.
 sub throw_exception {
   my $self = shift;
 
-  if (defined $self->schema) {
-    $self->schema->throw_exception(@_);
-  }
-  else {
-    DBIx::Class::Exception->throw(@_);
-  }
+  $self->{schema}
+    ? $self->{schema}->throw_exception(@_)
+    : DBIx::Class::Exception->throw(@_)
+  ;
 }
 
 =head2 source_info