rejig resultset construction for related_resultset
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 17586e4..b421944 100644 (file)
@@ -91,8 +91,6 @@ sub new {
 
   if ($attrs->{page}) {
     $attrs->{rows} ||= 10;
-    $attrs->{offset} ||= 0;
-    $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
   }
 
   $attrs->{alias} ||= 'me';
@@ -835,8 +833,6 @@ sub _collapse_result {
 
   my @const_keys;
 
-  use Data::Dumper;
-
   foreach my $const (@const_rows) {
     scalar @const_keys or do {
       @const_keys = sort { length($a) <=> length($b) } keys %$const;
@@ -937,9 +933,12 @@ sub count {
   my $count = $self->_count;
   return 0 unless $count;
 
-  $count -= $self->{attrs}{offset} if $self->{attrs}{offset};
+  # need to take offset from resolved attrs
+
+  $count -= $self->{_attrs}{offset} if $self->{_attrs}{offset};
   $count = $self->{attrs}{rows} if
     $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
+  $count = 0 if ($count < 0);
   return $count;
 }
 
@@ -972,7 +971,7 @@ sub _count { # Separated out so pager can get the full count
   # offset, order by and page are not needed to count. record_filter is cdbi
   delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
 
-  my $tmp_rs = (ref $self)->new($self->_source_handle, $attrs);
+  my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
   my ($count) = $tmp_rs->cursor->next;
   return $count;
 }
@@ -1244,7 +1243,7 @@ sub delete_all {
 
 =over 4
 
-=item Arguments: $source_name, \@data;
+=item Arguments: \@data;
 
 =back
 
@@ -1280,11 +1279,11 @@ Example:  Assuming an Artist Class that has many CDs Classes relating:
   ## Array Context Example
   my ($ArtistOne, $ArtistTwo, $ArtistThree) = $Artist_rs->populate([
     { name => "Artist One"},
-       { name => "Artist Two"},
-       { name => "Artist Three", cds=> [
-         { title => "First CD", year => 2007},
-         { title => "Second CD", year => 2008},
-       ]}
+    { name => "Artist Two"},
+    { name => "Artist Three", cds=> [
+    { title => "First CD", year => 2007},
+    { title => "Second CD", year => 2008},
+  ]}
   ]);
   
   print $ArtistOne->name; ## response is 'Artist One'
@@ -1304,13 +1303,36 @@ sub populate {
   } else {
     my ($first, @rest) = @$data;
 
-    my @names = grep { !ref $first->{$_} } keys %$first;
+    my @names = grep {!ref $first->{$_}} keys %$first;
+    my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
+    my @pks = $self->result_source->primary_columns;  
 
-    my @values = map {
-      [ map {
-         defined $_ ? $_ : $self->throw_exception("Undefined value for column!")
-      } @$_{@names} ]
-    } @$data;
+    ## do the belongs_to relationships  
+    foreach my $index (0..$#$data) {
+      if( grep { !defined $data->[$index]->{$_} } @pks ) {
+        my @ret = $self->populate($data);
+        return;
+      }
+    
+      foreach my $rel (@rels) {
+        next unless $data->[$index]->{$rel} && ref $data->[$index]->{$rel} eq "HASH";
+        my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel});
+        my ($reverse) = keys %{$self->result_source->reverse_relationship_info($rel)};
+        my $related = $result->result_source->resolve_condition(
+          $result->result_source->relationship_info($reverse)->{cond},
+          $self,        
+          $result,        
+        );
+
+        delete $data->[$index]->{$rel};
+        $data->[$index] = {%{$data->[$index]}, %$related};
+      
+        push @names, keys %$related if $index == 0;
+      }
+    }
+
+    ## do bulk insert on current row
+    my @values = map { [ @$_{@names} ] } @$data;
 
     $self->result_source->storage->insert_bulk(
       $self->result_source, 
@@ -1318,17 +1340,17 @@ sub populate {
       \@values,
     );
 
-    my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
-    my @pks = $self->result_source->primary_columns;
-
+    ## do the has_many relationships
     foreach my $item (@$data) {
 
       foreach my $rel (@rels) {
-        next unless $item->{$rel};
+        next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
 
-        my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) || next;
+        my $parent = $self->find(map {{$_=>$item->{$_}} } @pks) 
+     || $self->throw_exception('Cannot find the relating object.');
+     
         my $child = $parent->$rel;
-               
+    
         my $related = $child->result_source->resolve_condition(
           $parent->result_source->relationship_info($rel)->{cond},
           $child,
@@ -1387,7 +1409,7 @@ attribute set on the resultset (10 by default).
 
 sub page {
   my ($self, $page) = @_;
-  return (ref $self)->new($self->_source_handle, { %{$self->{attrs}}, page => $page });
+  return (ref $self)->new($self->result_source, { %{$self->{attrs}}, page => $page });
 }
 
 =head2 new_result
@@ -1715,7 +1737,7 @@ sub related_resultset {
     my $rel_obj = $self->result_source->relationship_info($rel);
 
     $self->throw_exception(
-      "search_related: result source '" . $self->_source_handle->source_moniker .
+      "search_related: result source '" . $self->result_source->source_name .
         "' has no such relationship $rel")
       unless $rel_obj;
     
@@ -1726,7 +1748,7 @@ sub related_resultset {
 
     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
     my %attrs = %{$self->{attrs}||{}};
-    delete $attrs{result_class};
+    delete @attrs{qw(result_class alias)};
 
     my $new_cache;
 
@@ -1737,21 +1759,32 @@ sub related_resultset {
       }
     }
 
-    my $new = $self->_source_handle
-                   ->schema
-                   ->resultset($rel_obj->{class})
-                   ->search_rs(
-                       undef, {
-                         %attrs,
-                         join => undef,
-                         prefetch => undef,
-                         select => undef,
-                         as => undef,
-                         alias => $alias,
-                         where => $self->{cond},
-                         seen_join => $seen,
-                         from => $from,
-                     });
+    my $rel_source = $self->result_source->related_source($rel);
+
+    my $new = do {
+
+      # The reason we do this now instead of passing the alias to the
+      # search_rs below is that if you wrap/overload resultset on the
+      # source you need to know what alias it's -going- to have for things
+      # to work sanely (e.g. RestrictWithObject wants to be able to add
+      # extra query restrictions, and these may need to be $alias.)
+
+      my $attrs = $rel_source->resultset_attributes;
+      local $attrs->{alias} = $alias;
+
+      $rel_source->resultset
+                 ->search_rs(
+                     undef, {
+                       %attrs,
+                       join => undef,
+                       prefetch => undef,
+                       select => undef,
+                       as => undef,
+                       where => $self->{cond},
+                       seen_join => $seen,
+                       from => $from,
+                   });
+    };
     $new->set_cache($new_cache) if $new_cache;
     $new;
   };
@@ -1770,9 +1803,14 @@ sub _resolve_from {
   my $join = ($attrs->{join}
                ? [ $attrs->{join}, $extra_join ]
                : $extra_join);
+
+  # we need to take the prefetch the attrs into account before we 
+  # ->resolve_join as otherwise they get lost - captainL
+  my $merged = $self->_merge_attr( $join, $attrs->{prefetch} );
+
   $from = [
     @$from,
-    ($join ? $source->resolve_join($join, $attrs->{alias}, $seen) : ()),
+    ($join ? $source->resolve_join($merged, $attrs->{alias}, $seen) : ()),
   ];
 
   return ($from,$seen);
@@ -1833,6 +1871,7 @@ sub _resolved_attrs {
       $join = $self->_merge_attr(
         $join, $attrs->{prefetch}
       );
+      
     }
 
     $attrs->{from} =   # have to copy here to avoid corrupting the original
@@ -1840,6 +1879,7 @@ sub _resolved_attrs {
         @{$attrs->{from}}, 
         $source->resolve_join($join, $alias, { %{$attrs->{seen_join}||{}} })
       ];
+
   }
 
   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
@@ -1868,51 +1908,116 @@ sub _resolved_attrs {
   }
   $attrs->{collapse} = $collapse;
 
+  if ($attrs->{page}) {
+    $attrs->{offset} ||= 0;
+    $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
+  }
+
   return $self->{_attrs} = $attrs;
 }
 
+sub _rollout_attr {
+  my ($self, $attr) = @_;
+  
+  if (ref $attr eq 'HASH') {
+    return $self->_rollout_hash($attr);
+  } elsif (ref $attr eq 'ARRAY') {
+    return $self->_rollout_array($attr);
+  } else {
+    return [$attr];
+  }
+}
+
+sub _rollout_array {
+  my ($self, $attr) = @_;
+
+  my @rolled_array;
+  foreach my $element (@{$attr}) {
+    if (ref $element eq 'HASH') {
+      push( @rolled_array, @{ $self->_rollout_hash( $element ) } );
+    } elsif (ref $element eq 'ARRAY') {
+      #  XXX - should probably recurse here
+      push( @rolled_array, @{$self->_rollout_array($element)} );
+    } else {
+      push( @rolled_array, $element );
+    }
+  }
+  return \@rolled_array;
+}
+
+sub _rollout_hash {
+  my ($self, $attr) = @_;
+
+  my @rolled_array;
+  foreach my $key (keys %{$attr}) {
+    push( @rolled_array, { $key => $attr->{$key} } );
+  }
+  return \@rolled_array;
+}
+
+sub _calculate_score {
+  my ($self, $a, $b) = @_;
+
+  if (ref $b eq 'HASH') {
+    my ($b_key) = keys %{$b};
+    if (ref $a eq 'HASH') {
+      my ($a_key) = keys %{$a};
+      if ($a_key eq $b_key) {
+        return (1 + $self->_calculate_score( $a->{$a_key}, $b->{$b_key} ));
+      } else {
+        return 0;
+      }
+    } else {
+      return ($a eq $b_key) ? 1 : 0;
+    }       
+  } else {
+    if (ref $a eq 'HASH') {
+      my ($a_key) = keys %{$a};
+      return ($b eq $a_key) ? 1 : 0;
+    } else {
+      return ($b eq $a) ? 1 : 0;
+    }
+  }
+}
+
 sub _merge_attr {
   my ($self, $a, $b) = @_;
+
   return $b unless defined($a);
   return $a unless defined($b);
   
-  if (ref $b eq 'HASH' && ref $a eq 'HASH') {
-    foreach my $key (keys %{$b}) {
-      if (exists $a->{$key}) {
-        $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key});
-      } else {
-        $a->{$key} = $b->{$key};
+  $a = $self->_rollout_attr($a);
+  $b = $self->_rollout_attr($b);
+
+  my $seen_keys;
+  foreach my $b_element ( @{$b} ) {
+    # find best candidate from $a to merge $b_element into
+    my $best_candidate = { position => undef, score => 0 }; my $position = 0;
+    foreach my $a_element ( @{$a} ) {
+      my $score = $self->_calculate_score( $a_element, $b_element );
+      if ($score > $best_candidate->{score}) {
+        $best_candidate->{position} = $position;
+        $best_candidate->{score} = $score;
       }
+      $position++;
     }
-    return $a;
-  } else {
-    $a = [$a] unless ref $a eq 'ARRAY';
-    $b = [$b] unless ref $b eq 'ARRAY';
-
-    my $hash = {};
-    my @array;
-    foreach my $x ($a, $b) {
-      foreach my $element (@{$x}) {
-        if (ref $element eq 'HASH') {
-          $hash = $self->_merge_attr($hash, $element);
-        } elsif (ref $element eq 'ARRAY') {
-          push(@array, @{$element});
-        } else {
-          push(@array, $element) unless $b == $x
-            && grep { $_ eq $element } @array;
-        }
+    my ($b_key) = ( ref $b_element eq 'HASH' ) ? keys %{$b_element} : ($b_element);
+    if ($best_candidate->{score} == 0 || exists $seen_keys->{$b_key}) {
+      push( @{$a}, $b_element );
+    } else {
+      $seen_keys->{$b_key} = 1; # don't merge the same key twice
+      my $a_best = $a->[$best_candidate->{position}];
+      # merge a_best and b_element together and replace original with merged
+      if (ref $a_best ne 'HASH') {
+        $a->[$best_candidate->{position}] = $b_element;
+      } elsif (ref $b_element eq 'HASH') {
+        my ($key) = keys %{$a_best};
+        $a->[$best_candidate->{position}] = { $key => $self->_merge_attr($a_best->{$key}, $b_element->{$key}) };
       }
     }
-    
-    @array = grep { !exists $hash->{$_} } @array;
-
-    return keys %{$hash}
-      ? ( scalar(@array)
-            ? [$hash, @array]
-            : $hash
-        )
-      : \@array;
   }
+
+  return $a;
 }
 
 sub result_source {