From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 28 Sep 2008 16:07:23 +0000 (+0000)
Subject: new_related works again
X-Git-Tag: v0.08240~345
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68f3b0dd9e91421b02c818ca42543b79bc197dfd;p=dbsrgits%2FDBIx-Class.git

new_related works again
---

diff --git a/Changes b/Changes
index 339f0fd..7aede42 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for DBIx::Class
 
+        - Fix storage to copy scalar conds before regexping to avoid
+          trying to modify a constant in odd edge cases
+        - Related resultsets on uninserted objects are now empty
         - Fixed up related resultsets and multi-create
         - Fixed superfluous connection in ODBC::_rebless
         - Fixed undef PK for first insert in ODBC::Microsoft_SQL_Server
diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 9ad86d6..dd84ef4 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -186,9 +186,17 @@ sub related_resultset {
       if (@_ > 1 && (@_ % 2 == 1));
     my $query = ((@_ > 1) ? {@_} : shift);
 
-    my $cond = $self->result_source->resolve_condition(
+    my $source = $self->result_source;
+    my $cond = $source->resolve_condition(
       $rel_obj->{cond}, $rel, $self
     );
+    if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
+      my $reverse = $source->reverse_relationship_info($rel);
+      foreach my $rev_rel (keys %$reverse) {
+        $attrs->{related_objects}{$rev_rel} = $self;
+        Scalar::Util::weaken($attrs->{related_object}{$rev_rel});
+      }
+    }
     if (ref $cond eq 'ARRAY') {
       $cond = [ map {
         if (ref $_ eq 'HASH') {
@@ -202,7 +210,7 @@ sub related_resultset {
           $_;
         }
       } @$cond ];
-    } else {
+    } elsif (ref $cond eq 'HASH') {
       foreach my $key (grep { ! /\./ } keys %$cond) {
         $cond->{"me.$key"} = delete $cond->{$key};
       }
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index f60bd81..11f275c 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1519,28 +1519,36 @@ sub new_result {
   my ($self, $values) = @_;
   $self->throw_exception( "new_result needs a hash" )
     unless (ref $values eq 'HASH');
-  $self->throw_exception(
-    "Implicit construct invalid, condition was not resolveable on parent "
-    ."object"
-  ) if (defined $self->{cond}
-        && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION);
-  $self->throw_exception(
-    "Can't abstract implicit construct, condition not a hash"
-  ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
 
+  my %new;
   my $alias = $self->{attrs}{alias};
-  my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {};
 
-  # precendence must be given to passed values over values inherited from the cond, 
-  # so the order here is important.
-  my %new;
-  my %implied =  %{$self->_remove_alias($collapsed_cond, $alias)};
-  while( my($col,$value) = each %implied ){
-    if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
-      $new{$col} = $value->{'='};
-      next;
+  if (
+    defined $self->{cond}
+    && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
+  ) {
+    %new = %{$self->{attrs}{related_objects}};
+  } else {
+    $self->throw_exception(
+      "Can't abstract implicit construct, condition not a hash"
+    ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
+  
+    my $collapsed_cond = (
+      $self->{cond}
+        ? $self->_collapse_cond($self->{cond})
+        : {}
+    );
+  
+    # precendence must be given to passed values over values inherited from
+    # the cond, so the order here is important.
+    my %implied =  %{$self->_remove_alias($collapsed_cond, $alias)};
+    while( my($col,$value) = each %implied ){
+      if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
+        $new{$col} = $value->{'='};
+        next;
+      }
+      $new{$col} = $value if $self->_is_deterministic_value($value);
     }
-    $new{$col} = $value if $self->_is_deterministic_value($value);
   }
 
   %new = (
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 3ac1d3c..84c8df9 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -845,7 +845,7 @@ sub resolve_condition {
           if ($for->in_storage) {
             $self->throw_exception("Column ${v} not loaded on ${for} trying to reolve relationship");
           }
-          return [ $UNRESOLVABLE_CONDITION ];
+          return $UNRESOLVABLE_CONDITION;
         }
         $ret{$k} = $for->get_column($v);
         #$ret{$k} = $for->get_column($v) if $for->has_column_loaded($v);
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 806cef8..4d52630 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1243,7 +1243,11 @@ sub _select {
   my $order = $attrs->{order_by};
 
   if (ref $condition eq 'SCALAR') {
-    $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
+    my $unwrap = ${$condition};
+    if ($unwrap =~ s/ORDER BY (.*)$//i) {
+      $order = $1;
+      $condition = \$unwrap;
+    }
   }
 
   my $for = delete $attrs->{for};