From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 18 Jun 2009 13:54:38 +0000 (+0000)
Subject: This seems to be the prefetch+limit fix - ugly as hell but appears to work
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51a296b402cacffe9d7ef3e6c9f890986b3b6c45;p=dbsrgits%2FDBIx-Class-Historic.git

This seems to be the prefetch+limit fix - ugly as hell but appears to work
---

diff --git a/Changes b/Changes
index e31367a..1d64794 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for DBIx::Class
 
+        - Fixed the prefetch with limit bug
+
 0.08107 2009-06-14 08:21:00 (UTC)
         - Fix serialization regression introduced in 0.08103 (affects
           Cursor::Cached)
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 8ad1f7d..2160cf0 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -2598,8 +2598,7 @@ sub _resolved_attrs {
   $attrs->{_virtual_order_by} = [ $self->result_source->primary_columns ];
 
 
-  my $collapse = $attrs->{collapse} || {};
-
+  $attrs->{collapse} ||= {};
   if ( my $prefetch = delete $attrs->{prefetch} ) {
     $prefetch = $self->_merge_attr( {}, $prefetch );
 
@@ -2608,20 +2607,20 @@ sub _resolved_attrs {
     my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join});
 
     my @prefetch =
-      $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $collapse );
+      $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
 
     push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
     push( @{ $attrs->{as} },     map { $_->[1] } @prefetch );
 
     push( @{ $attrs->{order_by} }, @$prefetch_ordering );
+    $attrs->{_collapse_order_by} = \@$prefetch_ordering;
   }
 
+
   if (delete $attrs->{distinct}) {
     $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
   }
 
-  $attrs->{collapse} = $collapse;
-
   # if both page and offset are specified, produce a combined offset
   # even though it doesn't make much sense, this is what pre 081xx has
   # been doing
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9edae6e..47c4e56 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1226,21 +1226,13 @@ sub _select_args_to_query {
 }
 
 sub _select_args {
-  my ($self, $ident, $select, $condition, $attrs) = @_;
+  my ($self, $ident, $select, $where, $attrs) = @_;
 
   my $sql_maker = $self->sql_maker;
-  $sql_maker->{for} = delete $attrs->{for};
-
-  my $order = { map
-    { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : ()  }
-    (qw/order_by group_by having _virtual_order_by/ )
-  };
-
-
-  my $bind_attrs = {};
-
   my $alias2source = $self->_resolve_ident_sources ($ident);
 
+  # calculate bind_attrs before possible $ident mangling
+  my $bind_attrs = {};
   for my $alias (keys %$alias2source) {
     my $bindtypes = $self->source_bind_attributes ($alias2source->{$alias}) || {};
     for my $col (keys %$bindtypes) {
@@ -1253,15 +1245,7 @@ sub _select_args {
     }
   }
 
-  # This would be the point to deflate anything found in $condition
-  # (and leave $attrs->{bind} intact). Problem is - inflators historically
-  # expect a row object. And all we have is a resultsource (it is trivial
-  # to extract deflator coderefs via $alias2source above).
-  #
-  # I don't see a way forward other than changing the way deflators are
-  # invoked, and that's just bad...
-
-  my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $condition, $order);
+  my @limit;
   if ($attrs->{software_limit} ||
       $sql_maker->_default_limit_syntax eq "GenericSubQ") {
         $attrs->{software_limit} = 1;
@@ -1271,9 +1255,148 @@ sub _select_args {
 
     # MySQL actually recommends this approach.  I cringe.
     $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
-    push @args, $attrs->{rows}, $attrs->{offset};
+
+    if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
+      ($ident, $select, $where, $attrs)
+        = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
+    }
+    else {
+      push @limit, $attrs->{rows}, $attrs->{offset};
+    }
+  }
+
+###
+  # This would be the point to deflate anything found in $where
+  # (and leave $attrs->{bind} intact). Problem is - inflators historically
+  # expect a row object. And all we have is a resultsource (it is trivial
+  # to extract deflator coderefs via $alias2source above).
+  #
+  # I don't see a way forward other than changing the way deflators are
+  # invoked, and that's just bad...
+###
+
+  my $order = { map
+    { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : ()  }
+    (qw/order_by group_by having _virtual_order_by/ )
+  };
+
+
+  $sql_maker->{for} = delete $attrs->{for};
+
+  return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
+}
+
+sub _adjust_select_args_for_limited_prefetch {
+  my ($self, $from, $select, $where, $attrs) = @_;
+
+  if ($attrs->{group_by} and @{$attrs->{group_by}}) {
+    $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a group_by attribute');
+  }
+
+  $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
+    if (ref $from ne 'ARRAY');
+
+  # separate attributes
+  my $sub_attrs = { %$attrs };
+  delete $attrs->{$_} for qw/where bind rows offset/;
+  delete $sub_attrs->{$_} for qw/for collapse select order_by/;
+
+
+  my $alias = $attrs->{alias};
+
+  # create subquery select list
+  my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
+
+  # bring over all non-collapse-induced order_by into the inner query (if any)
+  # the outer one will have to keep them all
+  if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
+    $sub_attrs->{order_by} = [
+      @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
+    ];
+  }
+
+
+  # mangle the from, separating it into an outer and inner part
+  my $self_ident = shift @$from;
+  my %join_map = map { $_->[0]{-alias} => $_->[0]{-join_path} } (@$from);
+
+  my (%inner_joins, %outer_joins);
+
+  # decide which parts of the join will remain
+  #
+  # resolve the prefetch-needed joins here as well, as the $attr->{prefetch}
+  # is 1) resolved away 2) unreliable as it may be a result of search_related
+  # and whatnot
+  #
+  # since we do not have introspectable SQLA, we fall back to ugly
+  # scanning of raw SQL for WHERE, and for pieces of ORDER BY
+  # in order to determine what goes into %inner_joins
+  # It may not be very efficient, but it's a reasonable stop-gap
+  {
+    # produce stuff unquoted, so it's easier to scan
+    my $sql_maker = $self->sql_maker;
+    local $sql_maker->{quote_char};
+
+    my @order_by = (map
+      { ref $_ ? $_->[0] : $_ }
+      $sql_maker->_order_by_chunks ($sub_attrs->{order_by})
+    );
+
+    my $where_sql = $sql_maker->where ($where);
+
+    # sort needed joins
+    for my $alias (keys %join_map) {
+
+      for my $piece ($where_sql, @order_by ) {
+        if ($piece =~ /\b$alias\./) {
+          $inner_joins{$alias} = 1;
+          $inner_joins{$_} = 1 for @{$join_map{$alias}};
+        }
+      }
+
+      for my $sel (@$select) {
+        if ($sel =~ /^$alias\./) {
+          $outer_joins{$alias}++;
+          $outer_joins{$_} = 1 for @{$join_map{$alias}};
+        }
+      }
+    }
+  }
+
+  my $inner_from = [ $self_ident ];
+  if (keys %inner_joins) {
+    for my $j (@$from) {
+      push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+    }
+
+    # if a multi-type join was needed in the subquery ("multi" is indicated by
+    # presence in collapse) - add a group_by to simulate the collapse in the subq
+    for my $alias (keys %inner_joins) {
+
+      # the dot comes from some weirdness in collapse
+      # remove after the rewrite
+      if ($attrs->{collapse}{".$alias"}) {
+        $sub_attrs->{group_by} = $sub_select;
+        last;
+      }
+    }
+  }
+
+  my $subq = $self->_select_args_to_query (
+    $inner_from,
+    $sub_select,
+    $where,
+    $sub_attrs
+  );
+
+  my $outer_from = [ { me => $subq } ];
+  if (keys %outer_joins) {
+    for my $j (@$from) {
+      push @$outer_from, $j if $outer_joins{$j->[0]{-alias}};
+    }
   }
-  return @args;
+
+  return ($outer_from, $select, {}, $attrs);  # where ended up in the subquery, thus {}
 }
 
 sub _resolve_ident_sources {
diff --git a/t/prefetch/rows_bug.t b/t/prefetch/rows_bug.t
index 21bb6a2..be3fff1 100644
--- a/t/prefetch/rows_bug.t
+++ b/t/prefetch/rows_bug.t
@@ -7,20 +7,26 @@ use Test::More;
 use lib qw(t/lib);
 use DBICTest;
 
-plan skip_all => 'fix pending';
-#plan tests => 4;
+plan tests => 4;
 
 my $schema = DBICTest->init_schema();
+
+
 my $no_prefetch = $schema->resultset('Artist')->search(
   undef,
   { rows => 3 }
 );
 
 my $use_prefetch = $schema->resultset('Artist')->search(
-  undef,
+  [   # search deliberately contrived
+    { 'artwork.cd_id' => undef },
+    { 'tracks.title' => { '!=' => 'blah-blah-1234568' }}
+  ],
   {
     prefetch => 'cds',
-    rows     => 3
+    join => { cds => [qw/artwork tracks/] },
+    rows     => 3,
+    order_by => { -desc => 'name' },
   }
 );
 
@@ -31,8 +37,6 @@ is(
   "Amount of returned rows is right"
 );
 
-
-
 my $artist_many_cds = $schema->resultset('Artist')->search ( {}, {
   join => 'cds',
   group_by => 'me.artistid',