Merge 'resultset-new-refactor' into 'DBIx-Class-current'
Matt S Trout [Wed, 24 May 2006 02:23:49 +0000 (02:23 +0000)]
1  2 
lib/DBIx/Class/ResultSet.pm

@@@ -8,6 -8,7 +8,7 @@@ use overloa
          fallback => 1;
  use Data::Page;
  use Storable;
+ use Data::Dumper;
  use Scalar::Util qw/weaken/;
  
  use DBIx::Class::ResultSetColumn;
@@@ -86,68 -87,6 +87,6 @@@ sub new 
    
    my ($source, $attrs) = @_;
    weaken $source;
-   $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
-   #use Data::Dumper; warn Dumper($attrs);
-   my $alias = ($attrs->{alias} ||= 'me');
-   
-   $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
-   delete $attrs->{as} if $attrs->{columns};
-   $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select};
-   $attrs->{select} = [
-     map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}}
-   ] if $attrs->{columns};
-   $attrs->{as} ||= [
-     map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
-   ];
-   if (my $include = delete $attrs->{include_columns}) {
-     push(@{$attrs->{select}}, @$include);
-     push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
-   }
-   #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
-   $attrs->{from} ||= [ { $alias => $source->from } ];
-   $attrs->{seen_join} ||= {};
-   my %seen;
-   if (my $join = delete $attrs->{join}) {
-     foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
-       if (ref $j eq 'HASH') {
-         $seen{$_} = 1 foreach keys %$j;
-       } else {
-         $seen{$j} = 1;
-       }
-     }
-     push(@{$attrs->{from}}, $source->resolve_join(
-       $join, $attrs->{alias}, $attrs->{seen_join})
-     );
-   }
-   
-   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
-   $attrs->{order_by} = [ $attrs->{order_by} ] if
-     $attrs->{order_by} and !ref($attrs->{order_by});
-   $attrs->{order_by} ||= [];
-   my $collapse = $attrs->{collapse} || {};
-   if (my $prefetch = delete $attrs->{prefetch}) {
-     my @pre_order;
-     foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
-       if ( ref $p eq 'HASH' ) {
-         foreach my $key (keys %$p) {
-           push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-             unless $seen{$key};
-         }
-       } else {
-         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
-             unless $seen{$p};
-       }
-       my @prefetch = $source->resolve_prefetch(
-            $p, $attrs->{alias}, {}, \@pre_order, $collapse);
-       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
-       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
-     }
-     push(@{$attrs->{order_by}}, @pre_order);
-   }
-   $attrs->{collapse} = $collapse;
- #  use Data::Dumper; warn Dumper($collapse) if keys %{$collapse};
  
    if ($attrs->{page}) {
      $attrs->{rows} ||= 10;
      $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1));
    }
  
+   $attrs->{alias} ||= 'me';
    bless {
      result_source => $source,
      result_class => $attrs->{result_class} || $source->result_class,
      cond => $attrs->{where},
-     from => $attrs->{from},
-     collapse => $collapse,
+ #    from => $attrs->{from},
+ #    collapse => $collapse,
      count => undef,
      page => delete $attrs->{page},
      pager => undef,
@@@ -218,10 -159,29 +159,29 @@@ always return a resultset, even in lis
  sub search_rs {
    my $self = shift;
  
-   my $attrs = { %{$self->{attrs}} };
-   my $having = delete $attrs->{having};
-   $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+   my $our_attrs = { %{$self->{attrs}} };
+   my $having = delete $our_attrs->{having};
+   my $attrs = {};
+   $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
+   
+   # merge new attrs into old
+   foreach my $key (qw/join prefetch/) {
+     next unless (exists $attrs->{$key});
+     if (exists $our_attrs->{$key}) {
+       $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
+     } else {
+       $our_attrs->{$key} = $attrs->{$key};
+     }
+     delete $attrs->{$key};
+   }
+   if (exists $our_attrs->{prefetch}) {
+       $our_attrs->{join} = $self->_merge_attr($our_attrs->{join}, $our_attrs->{prefetch}, 1);
+   }
  
+   my $new_attrs = { %{$our_attrs}, %{$attrs} };
+   # merge new where and having into old
    my $where = (@_
                  ? ((@_ == 1 || ref $_[0] eq "HASH")
                      ? shift
                          : {@_}))
                  : undef());
    if (defined $where) {
-     $attrs->{where} = (defined $attrs->{where}
+     $new_attrs->{where} = (defined $new_attrs->{where}
                ? { '-and' =>
                    [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                       $where, $attrs->{where} ] }
+                       $where, $new_attrs->{where} ] }
                : $where);
    }
  
    if (defined $having) {
-     $attrs->{having} = (defined $attrs->{having}
+     $new_attrs->{having} = (defined $new_attrs->{having}
                ? { '-and' =>
                    [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
-                       $having, $attrs->{having} ] }
+                       $having, $new_attrs->{having} ] }
                : $having);
    }
  
-   my $rs = (ref $self)->new($self->result_source, $attrs);
+   my $rs = (ref $self)->new($self->result_source, $new_attrs);
+   $rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
  
    unless (@_) { # no search, effectively just a clone
      my $rows = $self->get_cache;
@@@ -367,7 -328,7 +328,8 @@@ sub find 
  
      # Add the ResultSet's alias
      foreach my $key (grep { ! m/\./ } keys %$unique_query) {
--      $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
++      my $alias = $self->{attrs}->{alias};
++      $unique_query->{"$alias.$key"} = delete $unique_query->{$key};
      }
  
      push @unique_queries, $unique_query if %$unique_query;
    # Run the query
    if (keys %$attrs) {
      my $rs = $self->search($query, $attrs);
-     return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+     $rs->_resolve;
+     return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
    }
    else {
-     return keys %{$self->{collapse}}
+     $self->_resolve;  
+     return (keys %{$self->{_attrs}->{collapse}})
        ? $self->search($query)->next
        : $self->single($query);
    }
@@@ -443,9 -406,11 +407,11 @@@ L<DBIx::Class::Cursor> for more informa
  
  sub cursor {
    my ($self) = @_;
-   my $attrs = { %{$self->{attrs}} };
+   $self->_resolve;
+   my $attrs = { %{$self->{_attrs}} };
    return $self->{cursor}
-     ||= $self->result_source->storage->select($self->{from}, $attrs->{select},
+     ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
            $attrs->{where},$attrs);
  }
  
@@@ -472,7 -437,8 +438,8 @@@ method; if you need to add extra joins 
  
  sub single {
    my ($self, $where) = @_;
-   my $attrs = { %{$self->{attrs}} };
+   $self->_resolve;
+   my $attrs = { %{$self->{_attrs}} };
    if ($where) {
      if (defined $attrs->{where}) {
        $attrs->{where} = {
        $attrs->{where} = $where;
      }
    }
    my @data = $self->result_source->storage->select_single(
-           $self->{from}, $attrs->{select},
+           $attrs->{from}, $attrs->{select},
            $attrs->{where},$attrs);
    return (@data ? $self->_construct_object(@data) : ());
  }
@@@ -610,27 -577,152 +578,152 @@@ sub next 
                 @{delete $self->{stashed_row}} :
                 $self->cursor->next
    );
- #  warn Dumper(\@row); use Data::Dumper;
    return unless (@row);
    return $self->_construct_object(@row);
  }
  
+ sub _resolve {
+   my $self = shift;
+   return if(exists $self->{_attrs}); #return if _resolve has already been called
+   my $attrs = $self->{attrs};  
+   my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
+   # 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);
+   $self->{attrs}->{record_filter} = $record_filter if ($record_filter);
+   my $alias = $attrs->{alias};
+  
+   $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
+   delete $attrs->{as} if $attrs->{columns};
+   $attrs->{columns} ||= [ $self->{result_source}->columns ] unless $attrs->{select};
+   my $select_alias = ($self->{_parent_rs}) ? $self->{attrs}->{_live_join} : $alias;
+   $attrs->{select} = [
+                     map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}}
+                     ] if $attrs->{columns};
+   $attrs->{as} ||= [
+                   map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}}
+                   ];
+   if (my $include = delete $attrs->{include_columns}) {
+       push(@{$attrs->{select}}, @$include);
+       push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
+   }
+   $attrs->{from} ||= [ { $alias => $source->from } ];
+   $attrs->{seen_join} ||= {};
+   my %seen;
+   if (my $join = delete $attrs->{join}) {
+       foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) {
+         if (ref $j eq 'HASH') {
+             $seen{$_} = 1 foreach keys %$j;
+         } else {
+             $seen{$j} = 1;
+         }
+       }
+       push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
+   }
+   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
+   $attrs->{order_by} = [ $attrs->{order_by} ] if
+       $attrs->{order_by} and !ref($attrs->{order_by});
+   $attrs->{order_by} ||= [];
+   
+   my $collapse = $attrs->{collapse} || {};
+   if (my $prefetch = delete $attrs->{prefetch}) {
+       my @pre_order;
+       foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
+         if ( ref $p eq 'HASH' ) {
+             foreach my $key (keys %$p) {
+                 push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+                     unless $seen{$key};
+             }
+         } else {
+             push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
+                 unless $seen{$p};
+         }
+         my @prefetch = $source->resolve_prefetch(
+                                                  $p, $attrs->{alias}, {}, \@pre_order, $collapse);
+         push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
+         push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
+       }
+       push(@{$attrs->{order_by}}, @pre_order);
+   }
+   $attrs->{collapse} = $collapse;
+   $self->{_attrs} = $attrs;
+ }
+ sub _merge_attr {
+   my ($self, $a, $b, $is_prefetch) = @_;
+     
+   return $b unless $a;
+   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}, $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 $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_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 {
    my ($self, @row) = @_;
-   my @as = @{ $self->{attrs}{as} };
-   
+   my @as = @{ $self->{_attrs}{as} };
    my $info = $self->_collapse_result(\@as, \@row);
-   
    my $new = $self->result_class->inflate_result($self->result_source, @$info);
-   
-   $new = $self->{attrs}{record_filter}->($new)
-     if exists $self->{attrs}{record_filter};
+   $new = $self->{_attrs}{record_filter}->($new)
+     if exists $self->{_attrs}{record_filter};
    return $new;
  }
  
  sub _collapse_result {
    my ($self, $as, $row, $prefix) = @_;
  
+   my $live_join = $self->{attrs}->{_live_join} ||="";
    my %const;
  
    my @copy = @$row;
  
    my $info = [ {}, {} ];
    foreach my $key (keys %const) {
-     if (length $key) {
+     if (length $key && $key ne $live_join) {
        my $target = $info;
        my @parts = split(/\./, $key);
        foreach my $p (@parts) {
    if (defined $prefix) {
      @collapse = map {
          m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
-     } keys %{$self->{collapse}}
+     } keys %{$self->{_attrs}->{collapse}}
    } else {
-     @collapse = keys %{$self->{collapse}};
+     @collapse = keys %{$self->{_attrs}->{collapse}};
    };
  
    if (@collapse) {
        $target = $target->[1]->{$p} ||= [];
      }
      my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c);
-     my @co_key = @{$self->{collapse}{$c_prefix}};
+     my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}};
      my %co_check = map { ($_, $target->[0]->{$_}); } @co_key;
      my $tree = $self->_collapse_result($as, $row, $c_prefix);
      my (@final, @raw);
        $row = $self->{stashed_row} = \@raw;
        $tree = $self->_collapse_result($as, $row, $c_prefix);
      }
-     @$target = (@final ? @final : [ {}, {} ]);
+     @$target = (@final ? @final : [ {}, {} ]); 
        # single empty result to indicate an empty prefetched has_many
    }
    return $info;
  }
  
@@@ -753,7 -844,9 +845,9 @@@ sub count 
  sub _count { # Separated out so pager can get the full count
    my $self = shift;
    my $select = { count => '*' };
-   my $attrs = { %{ $self->{attrs} } };
+   
+   $self->_resolve;
+   my $attrs = { %{ $self->{_attrs} } };
    if (my $group_by = delete $attrs->{group_by}) {
      delete $attrs->{having};
      my @distinct = (ref $group_by ?  @$group_by : ($group_by));
      }
  
      $select = { count => { distinct => \@distinct } };
-     #use Data::Dumper; die Dumper $select;
    }
  
    $attrs->{select} = $select;
  
    # 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 ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
    return $count;
  }
@@@ -820,12 -911,14 +912,14 @@@ sub all 
  
    my @obj;
  
-   if (keys %{$self->{collapse}}) {
+   # TODO: don't call resolve here
+   $self->_resolve;
+   if (keys %{$self->{_attrs}->{collapse}}) {
+ #  if ($self->{attrs}->{prefetch}) {
        # Using $self->cursor->all is really just an optimisation.
        # If we're collapsing has_many prefetches it probably makes
        # very little difference, and this is cleaner than hacking
        # _construct_object to survive the approach
-     $self->cursor->reset;
      my @row = $self->cursor->next;
      while (@row) {
        push(@obj, $self->_construct_object(@row));
@@@ -857,6 -950,8 +951,8 @@@ Resets the resultset's cursor, so you c
  
  sub reset {
    my ($self) = @_;
+   delete $self->{_attrs} if (exists $self->{_attrs});
    $self->{all_cache_position} = 0;
    $self->cursor->reset;
    return $self;
@@@ -1312,7 -1407,7 +1408,7 @@@ than re-querying the database even if t
  sub set_cache {
    my ( $self, $data ) = @_;
    $self->throw_exception("set_cache requires an arrayref")
-     if defined($data) && (ref $data ne 'ARRAY');
+       if defined($data) && (ref $data ne 'ARRAY');
    $self->{all_cache} = $data;
  }
  
@@@ -1352,28 -1447,28 +1448,28 @@@ Returns a related resultset for the sup
  
  sub related_resultset {
    my ( $self, $rel ) = @_;
    $self->{related_resultsets} ||= {};
    return $self->{related_resultsets}{$rel} ||= do {
-       #warn "fetching related resultset for rel '$rel'";
+       #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name};
        my $rel_obj = $self->result_source->relationship_info($rel);
        $self->throw_exception(
          "search_related: result source '" . $self->result_source->name .
          "' has no such relationship ${rel}")
          unless $rel_obj; #die Dumper $self->{attrs};
  
-       my $rs = $self->search(undef, { join => $rel });
-       my $alias = defined $rs->{attrs}{seen_join}{$rel}
-                     && $rs->{attrs}{seen_join}{$rel} > 1
-                   ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
-                   : $rel;
-       $self->result_source->schema->resultset($rel_obj->{class}
+       my $rs = $self->result_source->schema->resultset($rel_obj->{class}
             )->search( undef,
-              { %{$rs->{attrs}},
-                alias => $alias,
+              { %{$self->{attrs}},
                 select => undef,
-                as => undef }
+                as => undef,
+              join => $rel,
+              _live_join => $rel }
             );
+       # keep reference of the original resultset
+       $rs->{_parent_rs} = $self->result_source;
+       return $rs;
    };
  }