Merge 'trunk' into 'DBIx-Class-current'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 920ee00..532e8b2 100644 (file)
@@ -3,7 +3,7 @@ package DBIx::Class::ResultSet;
 use strict;
 use warnings;
 use overload
-        '0+'     => 'count',
+        '0+'     => \&count,
         'bool'   => sub { 1; },
         fallback => 1;
 use Data::Page;
@@ -32,6 +32,7 @@ In the examples below, the following table classes are used:
 
   package MyApp::Schema::Artist;
   use base qw/DBIx::Class/;
+  __PACKAGE__->load_components(qw/Core/);
   __PACKAGE__->table('artist');
   __PACKAGE__->add_columns(qw/artistid name/);
   __PACKAGE__->set_primary_key('artistid');
@@ -40,7 +41,8 @@ In the examples below, the following table classes are used:
 
   package MyApp::Schema::CD;
   use base qw/DBIx::Class/;
-  __PACKAGE__->table('artist');
+  __PACKAGE__->load_components(qw/Core/);
+  __PACKAGE__->table('cd');
   __PACKAGE__->add_columns(qw/cdid artist title year/);
   __PACKAGE__->set_primary_key('cdid');
   __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
@@ -53,7 +55,7 @@ In the examples below, the following table classes are used:
 =head3 Arguments: ($source, \%$attrs)
 
 The resultset constructor. Takes a source object (usually a
-L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATRRIBUTES>
+L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATTRIBUTES>
 below).  Does not perform any queries -- these are executed as needed by the
 other methods.
 
@@ -100,6 +102,10 @@ sub new {
   }
   $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
 
+  $attrs->{order_by} = [ $attrs->{order_by} ]
+    if $attrs->{order_by} && !ref($attrs->{order_by});
+  $attrs->{order_by} ||= [];
+
   if (my $prefetch = delete $attrs->{prefetch}) {
     foreach my $p (ref $prefetch eq 'ARRAY'
               ? (@{$prefetch}) : ($prefetch)) {
@@ -113,7 +119,8 @@ sub new {
         push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias}))
             unless $seen{$p};
       }
-      my @prefetch = $source->resolve_prefetch($p, $attrs->{alias});
+      my @prefetch = $source->resolve_prefetch(
+           $p, $attrs->{alias}, {}, $attrs->{order_by});
       #die Dumper \@cols;
       push(@{$attrs->{select}}, map { $_->[0] } @prefetch);
       push(@{$attrs->{as}}, map { $_->[1] } @prefetch);
@@ -153,16 +160,23 @@ call it as C<search({}, \%attrs);>.
 sub search {
   my $self = shift;
 
-  #use Data::Dumper;warn Dumper(@_);
   my $rs;
   if( @_ ) {
     
     my $attrs = { %{$self->{attrs}} };
+    my $having = delete $attrs->{having};
     if (@_ > 1 && ref $_[$#_] eq 'HASH') {
      $attrs = { %$attrs, %{ pop(@_) } };
     }
 
-    my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
+    my $where = (@_
+                  ? ((@_ == 1 || ref $_[0] eq "HASH")
+                      ? shift
+                      : ((@_ % 2)
+                          ? $self->throw_exception(
+                              "Odd number of arguments to search")
+                          : {@_}))
+                  : undef());
     if (defined $where) {
       $where = (defined $attrs->{where}
                 ? { '-and' =>
@@ -172,6 +186,15 @@ sub search {
       $attrs->{where} = $where;
     }
 
+    if (defined $having) {
+      $having = (defined $attrs->{having}
+                ? { '-and' =>
+                    [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+                        $having, $attrs->{having} ] }
+                : $having);
+      $attrs->{having} = $having;
+    }
+
     $rs = (ref $self)->new($self->result_source, $attrs);
   }
   else {
@@ -190,7 +213,7 @@ Pass a literal chunk of SQL to be added to the conditional part of the
 resultset.
 
 =cut
-                                                         
+
 sub search_literal {
   my ($self, $cond, @vals) = @_;
   my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
@@ -209,7 +232,7 @@ Finds a row based on its primary key or unique constraint. For example:
 Also takes an optional C<key> attribute, to search by a specific key or unique
 constraint. For example:
 
-  my $cd = $schema->resultset('CD')->find_or_create(
+  my $cd = $schema->resultset('CD')->find(
     {
       artist => 'Massive Attack',
       title  => 'Mezzanine',
@@ -365,14 +388,18 @@ Can be used to efficiently iterate over records in the resultset:
 
 sub next {
   my ($self) = @_;
-  my $cache = $self->get_cache;
-  if( @$cache ) {
+  my $cache;
+  if( @{$cache = $self->{all_cache} || []}) {
     $self->{all_cache_position} ||= 0;
     my $obj = $cache->[$self->{all_cache_position}];
     $self->{all_cache_position}++;
     return $obj;
   }
-  my @row = $self->cursor->next;
+  if ($self->{attrs}{cache}) {
+    $self->{all_cache_position} = 0;
+    return ($self->all)[0];
+  }
+  my @row = delete $self->{stashed_row} || $self->cursor->next;
 #  warn Dumper(\@row); use Data::Dumper;
   return unless (@row);
   return $self->_construct_object(@row);
@@ -382,6 +409,7 @@ sub _construct_object {
   my ($self, @row) = @_;
   my @row_orig = @row; # copy @row for key comparison later, because @row will change
   my @as = @{ $self->{attrs}{as} };
+#use Data::Dumper; warn Dumper \@as;
   #warn "@cols -> @row";
   my $info = [ {}, {} ];
   foreach my $as (@as) {
@@ -392,57 +420,9 @@ sub _construct_object {
     foreach my $p (@parts) {
       $target = $target->[1]->{$p} ||= [];
       
-      # if cache is enabled, fetch inflated objs for prefetch
-      if( $rs->{attrs}->{cache} ) {
-        my $rel_info = $rs->result_source->relationship_info($p);
-        my $cond = $rel_info->{cond};
-        my $parent_rs = $rs;
-        $rs = $rs->related_resultset($p);
-        $rs->{attrs}->{cache} = 1;
-        my @objs = ();
-          
-        # populate related resultset's cache if empty
-        if( !@{ $rs->get_cache } ) {
-          $rs->all;
-        }
-
-        # get ordinals for pk columns in $row, so values can be compared
-        my $map = {};
-        keys %$cond;
-        my $re = qr/^\w+\./;
-        while( my( $rel_key, $pk ) = ( each %$cond ) ) {
-          $rel_key =~ s/$re//;
-          $pk =~ s/$re//;
-          $map->{$rel_key} = $pk;
-        } #die Dumper $map;
-          
-        keys %$map;
-        while( my( $rel_key, $pk ) = each( %$map ) ) {
-          my $i = 0;
-          foreach my $col ( $parent_rs->result_source->columns ) {
-            if( $col eq $pk ) {
-              $map->{$rel_key} = $i;
-            }
-            $i++;
-          }
-        } #die Dumper $map;
-
-        $rs->reset(); # reset cursor/cache position 
-          
-        # get matching objects for inflation
-        OBJ: while( my $rel_obj = $rs->next ) {
-          keys %$map;
-          KEYS: while( my( $rel_key, $ordinal ) = each %$map ) {
-            # use get_column to avoid auto inflation (want scalar value)
-            if( $rel_obj->get_column($rel_key) ne $row_orig[$ordinal] ) {
-              next OBJ;
-            }
-            push @objs, $rel_obj;
-          }
-        }
-        $target->[0] = \@objs;
-      }
+      $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache};
     }
+    
     $target->[0]->{$col} = shift @row
       if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite
   }
@@ -451,6 +431,7 @@ sub _construct_object {
               $self->result_source, @$info);
   $new = $self->{attrs}{record_filter}->($new)
     if exists $self->{attrs}{record_filter};
   return $new;
 }
 
@@ -483,13 +464,15 @@ sub count {
       if @{ $self->get_cache };
     my $group_by;
     my $select = { 'count' => '*' };
-    if( $group_by = delete $self->{attrs}{group_by} ) {
+    my $attrs = { %{ $self->{attrs} } };
+    if( $group_by = delete $attrs->{group_by} ) {
+      delete $attrs->{having};
       my @distinct = (ref $group_by ?  @$group_by : ($group_by));
       # todo: try CONCAT for multi-column pk
       my @pk = $self->result_source->primary_columns;
       if( scalar(@pk) == 1 ) {
         my $pk = shift(@pk);
-        my $alias = $self->{attrs}{alias};
+        my $alias = $attrs->{alias};
         my $re = qr/^($alias\.)?$pk$/;
         foreach my $column ( @distinct) {
           if( $column =~ $re ) {
@@ -503,14 +486,12 @@ sub count {
       #use Data::Dumper; die Dumper $select;
     }
 
-    my $attrs = { %{ $self->{attrs} },
-                  select => $select,
-                  as => [ 'count' ] };
+    $attrs->{select} = $select;
+    $attrs->{as} = [ '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/;
         
     ($self->{count}) = (ref $self)->new($self->result_source, $attrs)->cursor->next;
-    $self->{attrs}{group_by} = $group_by;
   }
   return 0 unless $self->{count};
   my $count = $self->{count};
@@ -543,7 +524,7 @@ sub all {
     my @obj = map { $self->_construct_object(@$_); }
             $self->cursor->all;
     $self->set_cache( \@obj );
-    return @{ $self->get_cache };
+    return @obj;
   }
   return map { $self->_construct_object(@$_); }
            $self->cursor->all;
@@ -729,8 +710,8 @@ sub create {
 
   $class->find_or_create({ key => $val, ... });
 
-Searches for a record matching the search condition; if it doesn't find one,    
-creates one and returns that instead.                                       
+Searches for a record matching the search condition; if it doesn't find one,
+creates one and returns that instead.
 
   my $cd = $schema->resultset('CD')->find_or_create({
     cdid   => 5,
@@ -891,13 +872,12 @@ sub related_resultset {
       "search_related: result source '" . $self->result_source->name .
       "' has no such relationship ${rel}")
       unless $rel_obj; #die Dumper $self->{attrs};
-    my $rs;
-    if( $self->{attrs}->{cache} ) {
-      $rs = $self->search(undef);
-    }
-    else {
-      $rs = $self->search(undef, { join => $rel });
-    }
+    my $rs = $self->search(undef, { join => $rel });
+    #if( $self->{attrs}->{cache} ) {
+    #  $rs = $self->search(undef);
+    #}
+    #else {
+    #}
     #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
     #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
     my $alias = (defined $rs->{attrs}{seen_join}{$rel}
@@ -1149,7 +1129,7 @@ then search against all mothers of those children:
                       ]
                   ],
                   { 'mother.person_id' => 'child.mother_id' }
-              ],                
+              ],
           ]
       },
   );