Add support for +select and +as attributes to ResultSet
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index aa76a6d..84162f9 100644 (file)
@@ -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;
@@ -136,11 +137,51 @@ call it as C<search(undef, \%attrs)>.
 
 sub search {
   my $self = shift;
-    
-  my $attrs = { %{$self->{attrs}} };
-  my $having = delete $attrs->{having};
-  $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+  my $rs = $self->search_rs( @_ );
+  return (wantarray ? $rs->all : $rs);
+}
+
+=head2 search_rs
+
+=over 4
+
+=item Arguments: $cond, \%attrs?
+
+=item Return Value: $resultset
+
+=back
+
+This method does the same exact thing as search() except it will 
+always return a resultset, even in list context.
 
+=cut
+
+sub search_rs {
+  my $self = shift;
+
+  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
@@ -150,32 +191,32 @@ sub search {
                         : {@_}))
                 : 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;
-    if( @{$rows} ) {
+    if ($rows) {
       $rs->set_cache($rows);
     }
   }
   
-  return (wantarray ? $rs->all : $rs);
+  return $rs;
 }
 
 =head2 search_literal
@@ -196,7 +237,6 @@ resultset query.
 
 =cut
 
-# TODO: needs fixing
 sub search_literal {
   my ($self, $cond, @vals) = @_;
   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
@@ -262,10 +302,14 @@ sub find {
     $hash = {};
     @{$hash}{@cols} = @_;
   }
+  elsif (@_) {
+    # For backwards compatibility
+    $hash = {@_};
+  }
   else {
     $self->throw_exception(
       "Arguments to find must be a hashref or match the number of columns in the "
-        . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key"
+        . (exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key")
     );
   }
 
@@ -297,10 +341,12 @@ sub find {
   # Run the query
   if (keys %$attrs) {
     my $rs = $self->search($query, $attrs);
-    return $rs->{attrs}->{prefetch} ? $rs->next : $rs->single;
+    $rs->_resolve;
+    return keys %{$rs->{_attrs}->{collapse}} ? $rs->next : $rs->single;
   }
   else {
-    return ($self->{attrs}->{prefetch})
+    $self->_resolve;  
+    return (keys %{$self->{_attrs}->{collapse}})
       ? $self->search($query)->next
       : $self->single($query);
   }
@@ -384,6 +430,10 @@ sub cursor {
 Inflates the first result without creating a cursor if the resultset has
 any records in it; if not returns nothing. Used by L</find> as an optimisation.
 
+Can optionally take an additional condition *only* - this is a fast-code-path
+method; if you need to add extra joins or similar call ->search and then
+->single without a condition on the $rs returned from that.
+
 =cut
 
 sub single {
@@ -516,9 +566,9 @@ first record from the resultset.
 
 sub next {
   my ($self) = @_;
-  if (@{$self->{all_cache} || []}) {
+  if (my $cache = $self->get_cache) {
     $self->{all_cache_position} ||= 0;
-    return $self->{all_cache}->[$self->{all_cache_position}++];
+    return $cache->[$self->{all_cache_position}++];
   }
   if ($self->{attrs}{cache}) {
     $self->{all_cache_position} = 1;
@@ -532,7 +582,6 @@ sub next {
   return $self->_construct_object(@row);
 }
 
-# XXX - this is essentially just the old new(). rewrite / tidy up?
 sub _resolve {
   my $self = shift;
 
@@ -541,9 +590,12 @@ 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);
+  $self->{attrs}->{record_filter} = $record_filter if ($record_filter);
+
   my $alias = $attrs->{alias};
  
   $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols};
@@ -560,7 +612,6 @@ sub _resolve {
       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} ||= {};
@@ -576,11 +627,22 @@ sub _resolve {
 
       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} ||= [];
+
+ if(my $seladds = delete($attrs->{'+select'})) {
+   my @seladds = (ref($seladds) eq 'ARRAY' ? @$seladds : ($seladds));
+   $attrs->{select} = [
+     @{ $attrs->{select} },
+     map { (m/\./ || ref($_)) ? $_ : "${alias}.$_" } $seladds
+   ];
+ }
+ if(my $asadds = delete($attrs->{'+as'})) {
+   my @asadds = (ref($asadds) eq 'ARRAY' ? @$asadds : ($asadds));
+   $attrs->{as} = [ @{ $attrs->{as} }, @asadds ];
+ }
   
   my $collapse = $attrs->{collapse} || {};
   if (my $prefetch = delete $attrs->{prefetch}) {
@@ -603,16 +665,68 @@ sub _resolve {
       push(@{$attrs->{order_by}}, @pre_order);
   }
   $attrs->{collapse} = $collapse;
-  $attrs->{record_filter} = $record_filter if ($record_filter);
   $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 $info = $self->_collapse_result(\@as, \@row);
-  my $new = $self->result_class->inflate_result($self->result_source, @$info, $self->{_parent_rs});
+  my $new = $self->result_class->inflate_result($self->result_source, @$info);
   $new = $self->{_attrs}{record_filter}->($new)
     if exists $self->{_attrs}{record_filter};
   return $new;
@@ -682,7 +796,8 @@ sub _collapse_result {
       $row = $self->{stashed_row} = \@raw;
       $tree = $self->_collapse_result($as, $row, $c_prefix);
     }
-    @$target = @final;
+    @$target = (@final ? @final : [ {}, {} ]); 
+      # single empty result to indicate an empty prefetched has_many
   }
   return $info;
 }
@@ -728,7 +843,7 @@ clause.
 sub count {
   my $self = shift;
   return $self->search(@_)->count if @_ and defined $_[0];
-  return scalar @{ $self->get_cache } if @{ $self->get_cache };
+  return scalar @{ $self->get_cache } if $self->get_cache;
 
   my $count = $self->_count;
   return 0 unless $count;
@@ -760,7 +875,6 @@ sub _count { # Separated out so pager can get the full count
     }
 
     $select = { count => { distinct => \@distinct } };
-    #use Data::Dumper; die Dumper $select;
   }
 
   $attrs->{select} = $select;
@@ -768,7 +882,6 @@ 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 ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
   return $count;
 }
@@ -807,14 +920,14 @@ is returned in list context.
 
 sub all {
   my ($self) = @_;
-  return @{ $self->get_cache } if @{ $self->get_cache };
+  return @{ $self->get_cache } if $self->get_cache;
 
   my @obj;
 
-  # XXX used to be 'if (keys %{$self->{collapse}})' 
-  # XXX replaced by this as it seemed to do roughly the same thing 
-  # XXX could be bad as never really understood exactly what collapse did
-  if ($self->{attrs}->{prefetch}) {
+  # 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
@@ -906,7 +1019,7 @@ sub _cond_for_update_delete {
       $cond->{-and} = [];
 
       my @cond = @{$self->{cond}{-and}};
-      for (my $i = 0; $i < @cond - 1; $i++) {
+      for (my $i = 0; $i <= @cond - 1; $i++) {
         my $entry = $cond[$i];
 
         my %hash;
@@ -918,7 +1031,7 @@ sub _cond_for_update_delete {
         }
         else {
           $entry =~ /([^.]+)$/;
-          $hash{$entry} = $cond[++$i];
+          $hash{$1} = $cond[++$i];
         }
 
         push @{$cond->{-and}}, \%hash;
@@ -1262,8 +1375,7 @@ sub update_or_create {
 
   my $row = $self->find($hash, $attrs);
   if (defined $row) {
-    $row->set_columns($hash);
-    $row->update;
+    $row->update($hash);
     return $row;
   }
 
@@ -1285,7 +1397,7 @@ Gets the contents of the cache for the resultset, if the cache is set.
 =cut
 
 sub get_cache {
-  shift->{all_cache} || [];
+  shift->{all_cache};
 }
 
 =head2 set_cache
@@ -1308,13 +1420,7 @@ than re-querying the database even if the cache attr is not set.
 sub set_cache {
   my ( $self, $data ) = @_;
   $self->throw_exception("set_cache requires an arrayref")
-    if ref $data ne 'ARRAY';
-  my $result_class = $self->result_class;
-  foreach( @$data ) {
-    $self->throw_exception(
-      "cannot cache object of type '$_', expected '$result_class'"
-    ) if ref $_ ne $result_class;
-  }
+      if defined($data) && (ref $data ne 'ARRAY');
   $self->{all_cache} = $data;
 }
 
@@ -1333,7 +1439,7 @@ Clears the cache for the resultset.
 =cut
 
 sub clear_cache {
-  shift->set_cache([]);
+  shift->set_cache(undef);
 }
 
 =head2 related_resultset
@@ -1464,6 +1570,23 @@ When you use function/stored procedure names and do not supply an C<as>
 attribute, the column names returned are storage-dependent. E.g. MySQL would
 return a column named C<count(employeeid)> in the above example.
 
+=head2 +select
+
+=over 4
+
+Indicates additional columns to be selected from storage.  Works the same as
+L<select> but adds columns to the selection.
+
+=back
+
+=head2 +as
+
+=over 4
+
+Indicates additional column names for those added via L<+select>.
+
+=back
+
 =head2 as
 
 =over 4
@@ -1500,6 +1623,10 @@ use C<get_column> instead:
 You can create your own accessors if required - see
 L<DBIx::Class::Manual::Cookbook> for details.
 
+Please note: This will NOT insert an C<AS employee_count> into the SQL statement
+produced, it is used for internal access only. Thus attempting to use the accessor
+in an C<order_by> clause or similar will fail misrably.
+
 =head2 join
 
 =over 4
@@ -1594,6 +1721,83 @@ C<prefetch> can be used with the following relationship types: C<belongs_to>,
 C<has_one> (or if you're using C<add_relationship>, any relationship declared
 with an accessor type of 'single' or 'filter').
 
+=head2 page
+
+=over 4
+
+=item Value: $page
+
+=back
+
+Makes the resultset paged and specifies the page to retrieve. Effectively
+identical to creating a non-pages resultset and then calling ->page($page)
+on it.
+
+=head2 rows
+
+=over 4
+
+=item Value: $rows
+
+=back
+
+Specifes the maximum number of rows for direct retrieval or the number of
+rows per page if the page attribute or method is used.
+
+=head2 group_by
+
+=over 4
+
+=item Value: \@columns
+
+=back
+
+A arrayref of columns to group by. Can include columns of joined tables.
+
+  group_by => [qw/ column1 column2 ... /]
+
+=head2 having
+
+=over 4
+
+=item Value: $condition
+
+=back
+
+HAVING is a select statement attribute that is applied between GROUP BY and
+ORDER BY. It is applied to the after the grouping calculations have been
+done. 
+
+  having => { 'count(employee)' => { '>=', 100 } }
+
+=head2 distinct
+
+=over 4
+
+=item Value: (0 | 1)
+
+=back
+
+Set to 1 to group by all columns.
+
+=head2 cache
+
+Set to 1 to cache search results. This prevents extra SQL queries if you
+revisit rows in your ResultSet:
+
+  my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
+  
+  while( my $artist = $resultset->next ) {
+    ... do stuff ...
+  }
+
+  $rs->first; # without cache, this would issue a query
+
+By default, searches are not cached.
+
+For more examples of using these attributes, see
+L<DBIx::Class::Manual::Cookbook>.
+
 =head2 from
 
 =over 4
@@ -1607,21 +1811,35 @@ statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
 clauses.
 
 NOTE: Use this on your own risk.  This allows you to shoot off your foot!
+
 C<join> will usually do what you need and it is strongly recommended that you
 avoid using C<from> unless you cannot achieve the desired result using C<join>.
+And we really do mean "cannot", not just tried and failed. Attempting to use
+this because you're having problems with C<join> is like trying to use x86
+ASM because you've got a syntax error in your C. Trust us on this.
+
+Now, if you're still really, really sure you need to use this (and if you're
+not 100% sure, ask the mailing list first), here's an explanation of how this
+works.
 
-In simple terms, C<from> works as follows:
+The syntax is as follows -
 
+  [
+    { <alias1> => <table1> },
     [
-        { <alias> => <table>, -join_type => 'inner|left|right' }
-        [] # nested JOIN (optional)
-        { <table.column> => <foreign_table.foreign_key> }
-    ]
+      { <alias2> => <table2>, -join_type => 'inner|left|right' },
+      [], # nested JOIN (optional)
+      { <table1.column1> => <table2.column2>, ... (more conditions) },
+    ],
+    # More of the above [ ] may follow for additional joins
+  ]
 
-    JOIN
-        <alias> <table>
-        [JOIN ...]
-    ON <table.column> = <foreign_table.foreign_key>
+  <table1> <alias1>
+  JOIN
+    <table2> <alias2>
+    [JOIN ...]
+  ON <table1.column1> = <table2.column2>
+  <more joins may follow>
 
 An easy way to follow the examples below is to remember the following:
 
@@ -1687,83 +1905,6 @@ with a father in the person table, we could explicitly use C<INNER JOIN>:
     # SELECT child.* FROM person child
     # INNER JOIN person father ON child.father_id = father.id
 
-=head2 page
-
-=over 4
-
-=item Value: $page
-
-=back
-
-Makes the resultset paged and specifies the page to retrieve. Effectively
-identical to creating a non-pages resultset and then calling ->page($page)
-on it.
-
-=head2 rows
-
-=over 4
-
-=item Value: $rows
-
-=back
-
-Specifes the maximum number of rows for direct retrieval or the number of
-rows per page if the page attribute or method is used.
-
-=head2 group_by
-
-=over 4
-
-=item Value: \@columns
-
-=back
-
-A arrayref of columns to group by. Can include columns of joined tables.
-
-  group_by => [qw/ column1 column2 ... /]
-
-=head2 having
-
-=over 4
-
-=item Value: $condition
-
-=back
-
-HAVING is a select statement attribute that is applied between GROUP BY and
-ORDER BY. It is applied to the after the grouping calculations have been
-done. 
-
-  having => { 'count(employee)' => { '>=', 100 } }
-
-=head2 distinct
-
-=over 4
-
-=item Value: (0 | 1)
-
-=back
-
-Set to 1 to group by all columns.
-
-=head2 cache
-
-Set to 1 to cache search results. This prevents extra SQL queries if you
-revisit rows in your ResultSet:
-
-  my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
-  
-  while( my $artist = $resultset->next ) {
-    ... do stuff ...
-  }
-
-  $rs->first; # without cache, this would issue a query
-
-By default, searches are not cached.
-
-For more examples of using these attributes, see
-L<DBIx::Class::Manual::Cookbook>.
-
 =cut
 
 1;