X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=4ab33896673a68dc0d07e1c83823770a69a85f12;hb=9574e7cc118caddd8bcd628881bde8e7763b3322;hp=e8c020a3b293599d7859d191e438317af2101ae4;hpb=b6bd8ed0e0d4e21f8fbf4500926241b64803b0a8;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index e8c020a..4ab3389 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -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');
@@ -48,7 +50,9 @@ In the examples below, the following table classes are used:
 
 =head1 METHODS
 
-=head2 new($source, \%$attrs)
+=head2 new
+
+=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>
@@ -152,24 +156,40 @@ 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 $attrs = { %{$self->{attrs}} };
-  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
-    $attrs = { %$attrs, %{ pop(@_) } };
-  }
-
-  my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
-  if (defined $where) {
-    $where = (defined $attrs->{where}
+    my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
+    if (defined $where) {
+      $where = (defined $attrs->{where}
                 ? { '-and' =>
                     [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
                         $where, $attrs->{where} ] }
                 : $where);
-    $attrs->{where} = $where;
-  }
+      $attrs->{where} = $where;
+    }
 
-  my $rs = (ref $self)->new($self->result_source, $attrs);
+    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 {
+    $rs = $self;
+    $rs->reset();
+  }
   return (wantarray ? $rs->all : $rs);
 }
 
@@ -190,7 +210,9 @@ sub search_literal {
   return $self->search(\$cond, $attrs);
 }
 
-=head2 find(@colvalues), find(\%cols, \%attrs?)
+=head2 find
+
+=head3 Arguments: (@colvalues) | (\%cols, \%attrs?)
 
 Finds a row based on its primary key or unique constraint. For example:
 
@@ -255,22 +277,7 @@ records.
 =cut
 
 sub search_related {
-  my ($self, $rel, @rest) = @_;
-  my $rel_obj = $self->result_source->relationship_info($rel);
-  $self->throw_exception(
-    "No such relationship ${rel} in search_related")
-      unless $rel_obj;
-  my $rs = $self->search(undef, { join => $rel });
-  my $alias = ($rs->{attrs}{seen_join}{$rel} > 1
-                ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
-                : $rel);
-  return $self->result_source->schema->resultset($rel_obj->{class}
-           )->search( undef,
-             { %{$rs->{attrs}},
-               alias => $alias,
-               select => undef(),
-               as => undef() }
-           )->search(@rest);
+  return shift->related_resultset(shift)->search(@_);
 }
 
 =head2 cursor
@@ -337,7 +344,9 @@ sub search_like {
   return $class->search($query, { %$attrs });
 }
 
-=head2 slice($first, $last)
+=head2 slice
+
+=head3 Arguments: ($first, $last)
 
 Returns a subset of elements from the resultset.
 
@@ -368,6 +377,13 @@ Can be used to efficiently iterate over records in the resultset:
 
 sub next {
   my ($self) = @_;
+  my $cache = $self->get_cache;
+  if( @$cache ) {
+    $self->{all_cache_position} ||= 0;
+    my $obj = $cache->[$self->{all_cache_position}];
+    $self->{all_cache_position}++;
+    return $obj;
+  }
   my @row = $self->cursor->next;
 #  warn Dumper(\@row); use Data::Dumper;
   return unless (@row);
@@ -376,27 +392,81 @@ sub next {
 
 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) {
+    my $rs = $self;
     my $target = $info;
     my @parts = split(/\./, $as);
     my $col = pop(@parts);
     foreach my $p (@parts) {
       $target = $target->[1]->{$p} ||= [];
+      
+      $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache};
     }
-    $target->[0]->{$col} = shift @row;
+    
+    $target->[0]->{$col} = shift @row
+      if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite
   }
   #use Data::Dumper; warn Dumper(\@as, $info);
   my $new = $self->result_source->result_class->inflate_result(
               $self->result_source, @$info);
   $new = $self->{attrs}{record_filter}->($new)
     if exists $self->{attrs}{record_filter};
+ 
+  if( $self->{attrs}->{cache} ) {
+    while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
+      $rs->all;
+      #warn "$rel:", @{$rs->get_cache};
+    }
+    $self->build_rr( $self, $new );
+  }
+ 
   return $new;
 }
+  
+sub build_rr {
+  # build related resultsets for supplied object
+  my ( $self, $context, $obj ) = @_;
+  
+  my $re = qr/^\w+\./;
+  while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {  
+    #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
+    my @objs = ();
+    my $map = {};
+    my $cond = $context->result_source->relationship_info($rel)->{cond};
+    keys %$cond;
+    while( my( $rel_key, $pk ) = each(%$cond) ) {
+      $rel_key =~ s/$re//;
+      $pk =~ s/$re//;
+      $map->{$rel_key} = $pk;
+    }
+    
+    $rs->reset();
+    while( my $rel_obj = $rs->next ) {
+      while( my( $rel_key, $pk ) = each(%$map) ) {
+        if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
+          push @objs, $rel_obj;
+        }
+      }
+    }
+
+    my $rel_rs = $obj->related_resultset($rel);
+    $rel_rs->{attrs}->{cache} = 1;
+    $rel_rs->set_cache( \@objs );
+    
+    while( my $rel_obj = $rel_rs->next ) {
+      $self->build_rr( $rs, $rel_obj );
+    }
+    
+  }
+  
+}
 
-=head2 result_source 
+=head2 result_source
 
 Returns a reference to the result source for this recordset.
 
@@ -421,15 +491,19 @@ sub count {
   my $self = shift;
   return $self->search(@_)->count if @_ && defined $_[0];
   unless (defined $self->{count}) {
+    return scalar @{ $self->get_cache }
+      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 ) {
@@ -443,14 +517,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};
@@ -477,6 +549,14 @@ is returned in list context.
 
 sub all {
   my ($self) = @_;
+  return @{ $self->get_cache }
+    if @{ $self->get_cache };
+  if( $self->{attrs}->{cache} ) {
+    my @obj = map { $self->_construct_object(@$_); }
+            $self->cursor->all;
+    $self->set_cache( \@obj );
+    return @{ $self->get_cache };
+  }
   return map { $self->_construct_object(@$_); }
            $self->cursor->all;
 }
@@ -489,6 +569,7 @@ Resets the resultset's cursor, so you can iterate through the elements again.
 
 sub reset {
   my ($self) = @_;
+  $self->{all_cache_position} = 0;
   $self->cursor->reset;
   return $self;
 }
@@ -503,7 +584,9 @@ sub first {
   return $_[0]->reset->next;
 }
 
-=head2 update(\%values)
+=head2 update
+
+=head3 Arguments: (\%values)
 
 Sets the specified columns in the resultset to the supplied values.
 
@@ -516,7 +599,9 @@ sub update {
            $self->result_source->from, $values, $self->{cond});
 }
 
-=head2 update_all(\%values)
+=head2 update_all
+
+=head3 Arguments: (\%values)
 
 Fetches all objects and updates them one at a time.  Note that C<update_all>
 will run cascade triggers while L</update> will not.
@@ -595,7 +680,9 @@ sub pager {
     $self->{count}, $attrs->{rows}, $self->{page});
 }
 
-=head2 page($page_num)
+=head2 page
+
+=head3 Arguments: ($page_num)
 
 Returns a new resultset for the specified page.
 
@@ -608,7 +695,9 @@ sub page {
   return (ref $self)->new($self->result_source, $attrs);
 }
 
-=head2 new_result(\%vals)
+=head2 new_result
+
+=head3 Arguments: (\%vals)
 
 Creates a result in the resultset's result class.
 
@@ -630,7 +719,9 @@ sub new_result {
   $obj;
 }
 
-=head2 create(\%vals)
+=head2 create
+
+=head3 Arguments: (\%vals)
 
 Inserts a record into the resultset and returns the object.
 
@@ -644,7 +735,9 @@ sub create {
   return $self->new_result($attrs)->insert;
 }
 
-=head2 find_or_create(\%vals, \%attrs?)
+=head2 find_or_create
+
+=head3 Arguments: (\%vals, \%attrs?)
 
   $class->find_or_create({ key => $val, ... });
 
@@ -751,6 +844,90 @@ sub update_or_create {
   return $row;
 }
 
+=head2 get_cache
+
+Gets the contents of the cache for the resultset.
+
+=cut
+
+sub get_cache {
+  my $self = shift;
+  return $self->{all_cache} || [];
+}
+
+=head2 set_cache
+
+Sets the contents of the cache for the resultset. Expects an arrayref of objects of the same class as those produced by the resultset.
+
+=cut
+
+sub set_cache {
+  my ( $self, $data ) = @_;
+  $self->throw_exception("set_cache requires an arrayref")
+    if ref $data ne 'ARRAY';
+  my $result_class = $self->result_source->result_class;
+  foreach( @$data ) {
+    $self->throw_exception("cannot cache object of type '$_', expected '$result_class'")
+      if ref $_ ne $result_class;
+  }
+  $self->{all_cache} = $data;
+}
+
+=head2 clear_cache
+
+Clears the cache for the resultset.
+
+=cut
+
+sub clear_cache {
+  my $self = shift;
+  $self->set_cache([]);
+}
+
+=head2 related_resultset
+
+Returns a related resultset for the supplied relationship name.
+
+  $rs = $rs->related_resultset('foo');
+
+=cut
+
+sub related_resultset {
+  my ( $self, $rel, @rest ) = @_;
+  $self->{related_resultsets} ||= {};
+  my $resultsets = $self->{related_resultsets};
+  if( !exists $resultsets->{$rel} ) {
+    #warn "fetching related resultset for rel '$rel'";
+    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;
+    if( $self->{attrs}->{cache} ) {
+      $rs = $self->search(undef);
+    }
+    else {
+      $rs = $self->search(undef, { join => $rel });
+    }
+    #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}
+                  && $rs->{attrs}{seen_join}{$rel} > 1
+                ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+                : $rel);
+    $resultsets->{$rel} =
+      $self->result_source->schema->resultset($rel_obj->{class}
+           )->search( undef,
+             { %{$rs->{attrs}},
+               alias => $alias,
+               select => undef(),
+               as => undef() }
+           )->search(@rest);
+  }
+  return $resultsets->{$rel};
+}
+
 =head2 throw_exception
 
 See Schema's throw_exception
@@ -772,13 +949,17 @@ overview of them:
 Which column(s) to order the results by. This is currently passed through
 directly to SQL, so you can give e.g. C<foo DESC> for a descending order.
 
-=head2 cols (arrayref)
+=head2 cols
+
+=head3 Arguments: (arrayref)
 
 Shortcut to request a particular set of columns to be retrieved.  Adds
 C<me.> onto the start of any column without a C<.> in it and sets C<select>
 from that, then auto-populates C<as> from C<select> as normal.
 
-=head2 include_columns (arrayref)
+=head2 include_columns
+
+=head3 Arguments: (arrayref)
 
 Shortcut to include additional columns in the returned results - for example
 
@@ -786,7 +967,9 @@ Shortcut to include additional columns in the returned results - for example
 
 would add a 'name' column to the information passed to object inflation
 
-=head2 select (arrayref)
+=head2 select
+
+=head3 Arguments: (arrayref)
 
 Indicates which columns should be selected from the storage. You can use
 column names, or in the case of RDBMS back ends, function or stored procedure
@@ -807,7 +990,9 @@ 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(column_to_count)> in the above example.
 
-=head2 as (arrayref)
+=head2 as
+
+=head3 Arguments: (arrayref)
 
 Indicates column names for object inflation. This is used in conjunction with
 C<select>, usually when C<select> contains one or more function or stored
@@ -885,7 +1070,9 @@ with title Bar.
 If you want to fetch related objects from other tables as well, see C<prefetch>
 below.
 
-=head2 prefetch arrayref/hashref
+=head2 prefetch
+
+=head3 Arguments: arrayref/hashref
 
 Contains one or more relationships that should be fetched along with the main 
 query (when they are accessed afterwards they will have already been
@@ -920,7 +1107,9 @@ 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 from (arrayref)
+=head2 from
+
+=head3 Arguments: (arrayref)
 
 The C<from> attribute gives you manual control over the C<FROM> clause of SQL
 statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
@@ -1020,7 +1209,9 @@ For a paged resultset, how many rows per page:
 
 Can also be used to simulate an SQL C<LIMIT>.
 
-=head2 group_by (arrayref)
+=head2 group_by
+
+=head3 Arguments: (arrayref)
 
 A arrayref of columns to group by. Can include columns of joined tables.