From: Luke Saunders <luke.saunders@gmail.com>
Date: Mon, 22 May 2006 13:12:18 +0000 (+0000)
Subject: join merging working properly. some torture tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1e9e7f5873199d2b7afbc5eb72a7ed8857acb4d1;p=dbsrgits%2FDBIx-Class-Historic.git

join merging working properly. some torture tests
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index c3a7bbe..f71caee 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -8,6 +8,7 @@ use overload
         fallback => 1;
 use Data::Page;
 use Storable;
+use Data::Dumper;
 use Scalar::Util qw/weaken/;
 
 use DBIx::Class::ResultSetColumn;
@@ -173,6 +174,12 @@ sub search_rs {
     }
     delete $attrs->{$key};
   }
+#  use Data::Dumper; warn "merge old to new: " . Dumper($our_attrs);
+  if (exists $our_attrs->{prefetch}) {
+      $our_attrs->{join} = $self->_merge_attr($our_attrs->{join}, $our_attrs->{prefetch}, 1);
+  }
+#  use Data::Dumper; warn "merge prefetch: " . Dumper($our_attrs); 
+
   my $new_attrs = { %{$our_attrs}, %{$attrs} };
 
   # merge new where and having into old
@@ -333,7 +340,6 @@ sub find {
   my $query = @unique_queries ? \@unique_queries : undef;
 
   # Run the query
-
   if (keys %$attrs) {
     my $rs = $self->search($query, $attrs);
     $rs->_resolve;
@@ -573,7 +579,6 @@ sub next {
   return $self->_construct_object(@row);
 }
 
-# XXX - this is essentially just the old new(). rewrite / tidy up?
 sub _resolve {
   my $self = shift;
 
@@ -582,7 +587,7 @@ sub _resolve {
   my $attrs = $self->{attrs};  
   my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
 
-  # XXX - this is a hack to prevent dclone dieing because of the code ref, get's put back in $attrs afterwards
+  # XXX - lose storable dclone
   my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter});
   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
   $attrs->{record_filter} = $record_filter if ($record_filter);
@@ -649,40 +654,56 @@ sub _resolve {
 }
 
 sub _merge_attr {
-  my ($self, $a, $b) = @_;
+  my ($self, $a, $b, $is_prefetch) = @_;
     
+  return $b unless $a;
   if (ref $b eq 'HASH' && ref $a eq 'HASH') {
-    return $self->_merge_hash($a, $b);
+		foreach my $key (keys %{$b}) {
+			if (exists $a->{$key}) {
+	      $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}, $is_prefetch);
+			} else {
+	      $a->{$key} = delete $b->{$key};
+			}
+		}
+		return $a;
   } else {
-    $a = [$a] unless (ref $a eq 'ARRAY');
-    $b = [$b] unless (ref $b eq 'ARRAY');
-    my @new_array = (@{$a}, @{$b});
-    foreach my $a_element (@new_array) {
-      my $i = 0;
-      foreach my $b_element (@new_array) {
-	if ((ref $a_element eq 'HASH') && (ref $b_element eq 'HASH') && ($a_element ne $b_element)) {
-	    $a_element = $self->_merge_hash($a_element, $b_element);
-	    $new_array[$i] = undef;
-	}
-	$i++;
-      }
-    }
-    @new_array = grep($_, @new_array);
-    return \@new_array;
-  }  
+		$a = [$a] unless (ref $a eq 'ARRAY');
+		$b = [$b] unless (ref $b eq 'ARRAY');
+
+		my $hash = {};
+		my $array = [];      
+		foreach ($a, $b) {
+			foreach my $element (@{$_}) {
+	      if (ref $element eq 'HASH') {
+					$hash = $self->_merge_attr($hash, $element, $is_prefetch);
+	      } elsif (ref $element eq 'ARRAY') {
+					$array = [@{$array}, @{$element}];
+	      } else {	
+					if (($b == $_) && $is_prefetch) {
+						$self->_merge_array($array, $element, $is_prefetch);
+					} else {
+						push(@{$array}, $element);
+					}
+	      }
+			}
+		}
+
+		if ((keys %{$hash}) && (scalar(@{$array} > 0))) {
+			return [$hash, @{$array}];
+		} else {	
+			return (keys %{$hash}) ? $hash : $array;
+		}
+  }
 }
 
-sub _merge_hash {
-  my ($self, $a, $b) = @_;
-
-  foreach my $key (keys %{$b}) {
-    if (exists $a->{$key}) {
-      $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key});
-    } else {
-      $a->{$key} = delete $b->{$key};
-    }
-  }
-  return $a;
+sub _merge_array {
+	my ($self, $a, $b) = @_;
+ 
+	$b = [$b] unless (ref $b eq 'ARRAY');
+	# add elements from @{$b} to @{$a} which aren't already in @{$a}
+	foreach my $b_element (@{$b}) {
+		push(@{$a}, $b_element) unless grep {$b_element eq $_} @{$a};
+	}
 }
 
 sub _construct_object {
diff --git a/t/basicrels/30join_torture.t b/t/basicrels/30join_torture.t
new file mode 100644
index 0000000..6bc0ca5
--- /dev/null
+++ b/t/basicrels/30join_torture.t
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/30join_torture.tl";
+run_tests(DBICTest->schema);
diff --git a/t/helperrels/30join_torture.t b/t/helperrels/30join_torture.t
new file mode 100644
index 0000000..1e85aeb
--- /dev/null
+++ b/t/helperrels/30join_torture.t
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/30join_torture.tl";
+run_tests(DBICTest->schema);
diff --git a/t/run/30join_torture.tl b/t/run/30join_torture.tl
new file mode 100644
index 0000000..2555a31
--- /dev/null
+++ b/t/run/30join_torture.tl
@@ -0,0 +1,15 @@
+sub run_tests {
+my $schema = shift;
+
+plan tests => 2;
+
+my $rs1 = $schema->resultset("Artist")->search({ 'tags.tag' => 'Blue' }, { join => {'cds' => 'tracks'}, prefetch => {'cds' => 'tags'} });
+my @artists = $rs1->all;
+cmp_ok(@artists, '==', 1, "Two artists returned");
+
+my $rs2 = $rs1->search({ artistid => '1' }, { join => {'cds' => {'cd_to_producer' => 'producer'} } });
+my $rs3 = $rs2->search_related('cds')->search({'cds.title' => 'Forkful of bees'});
+cmp_ok($rs3->count, '==', 3, "Three artists returned");
+
+}
+1;