[Bast-commits] r4854 - in DBIx-Class/0.08/trunk: . lib/DBIx/Class lib/DBIx/Class/Relationship lib/DBIx/Class/Storage

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2008-09-28 17:07:23 +0100 (Sun, 28 Sep 2008)
New Revision: 4854

Modified:
   DBIx-Class/0.08/trunk/Changes
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
Log:
new_related works again

Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes	2008-09-28 15:15:42 UTC (rev 4853)
+++ DBIx-Class/0.08/trunk/Changes	2008-09-28 16:07:23 UTC (rev 4854)
@@ -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

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm	2008-09-28 15:15:42 UTC (rev 4853)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/Base.pm	2008-09-28 16:07:23 UTC (rev 4854)
@@ -186,9 +186,17 @@
       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 @@
           $_;
         }
       } @$cond ];
-    } else {
+    } elsif (ref $cond eq 'HASH') {
       foreach my $key (grep { ! /\./ } keys %$cond) {
         $cond->{"me.$key"} = delete $cond->{$key};
       }

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm	2008-09-28 15:15:42 UTC (rev 4853)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSet.pm	2008-09-28 16:07:23 UTC (rev 4854)
@@ -1519,28 +1519,36 @@
   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 = (

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm	2008-09-28 15:15:42 UTC (rev 4853)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultSource.pm	2008-09-28 16:07:23 UTC (rev 4854)
@@ -845,7 +845,7 @@
           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);

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2008-09-28 15:15:42 UTC (rev 4853)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2008-09-28 16:07:23 UTC (rev 4854)
@@ -1243,7 +1243,11 @@
   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};