Merge 'trunk' into 'prefetch'
Peter Rabbitson [Mon, 1 Mar 2010 00:39:55 +0000 (00:39 +0000)]
r8759@Thesaurus (orig r8746):  ribasushi | 2010-02-19 00:30:37 +0100
Fix bogus test
r8760@Thesaurus (orig r8747):  ribasushi | 2010-02-19 00:34:22 +0100
Retire useless abstraction (all rdbms need this anyway)
r8761@Thesaurus (orig r8748):  ribasushi | 2010-02-19 00:35:01 +0100
Fix count of group_by over aliased function
r8765@Thesaurus (orig r8752):  ribasushi | 2010-02-19 10:11:20 +0100
 r8497@Thesaurus (orig r8484):  ribasushi | 2010-01-31 10:06:29 +0100
 Branch to unify mandatory PK handling
 r8498@Thesaurus (orig r8485):  ribasushi | 2010-01-31 10:20:36 +0100
 This is not really used for anything (same code in DBI)
 r8499@Thesaurus (orig r8486):  ribasushi | 2010-01-31 10:25:55 +0100
 Helper primary_columns wrapper to throw if a PK is not defined
 r8500@Thesaurus (orig r8487):  ribasushi | 2010-01-31 11:07:25 +0100
 Stupid errors
 r8501@Thesaurus (orig r8488):  ribasushi | 2010-01-31 12:18:57 +0100
 Saner handling of nonexistent/partial conditions
 r8762@Thesaurus (orig r8749):  ribasushi | 2010-02-19 10:07:40 +0100
 trap unresolvable conditions due to incomplete relationship specification
 r8764@Thesaurus (orig r8751):  ribasushi | 2010-02-19 10:11:09 +0100
 Changes

r8767@Thesaurus (orig r8754):  ribasushi | 2010-02-19 11:14:30 +0100
Fix for RT54697
r8769@Thesaurus (orig r8756):  caelum | 2010-02-19 12:21:53 +0100
bump Test::Pod dep
r8770@Thesaurus (orig r8757):  caelum | 2010-02-19 12:23:07 +0100
bump Test::Pod dep in Optional::Dependencies too
r8773@Thesaurus (orig r8760):  rabbit | 2010-02-19 16:41:24 +0100
Fix stupid sqlt parser regression
r8774@Thesaurus (orig r8761):  rabbit | 2010-02-19 16:42:40 +0100
Port remaining tests to the Opt::Dep reposiory
r8775@Thesaurus (orig r8762):  rabbit | 2010-02-19 16:43:36 +0100
Some test cleanups
r8780@Thesaurus (orig r8767):  rabbit | 2010-02-20 20:59:20 +0100
Test::Deep actually isn't required
r8786@Thesaurus (orig r8773):  rabbit | 2010-02-20 22:21:41 +0100
These are core for perl 5.8
r8787@Thesaurus (orig r8774):  rabbit | 2010-02-21 10:52:40 +0100
Shuffle tests a bit
r8788@Thesaurus (orig r8775):  rabbit | 2010-02-21 12:09:25 +0100
Bogus require
r8789@Thesaurus (orig r8776):  rabbit | 2010-02-21 12:09:48 +0100
Bogus unnecessary dep
r8800@Thesaurus (orig r8787):  rabbit | 2010-02-21 13:39:21 +0100
 r8748@Thesaurus (orig r8735):  goraxe | 2010-02-17 23:17:15 +0100
 branch for dbicadmin pod fixes

 r8778@Thesaurus (orig r8765):  goraxe | 2010-02-20 20:35:00 +0100
 add G:L:D sub classes to generate pod
 r8779@Thesaurus (orig r8766):  goraxe | 2010-02-20 20:56:16 +0100
 dbicadmin: use subclassed G:L:D to generate some pod
 r8782@Thesaurus (orig r8769):  goraxe | 2010-02-20 21:48:29 +0100
 adjust Makefile.pl to generate dbicadmin.pod
 r8783@Thesaurus (orig r8770):  goraxe | 2010-02-20 21:50:55 +0100
 add svn-ignore for dbicadmin.pod
 r8784@Thesaurus (orig r8771):  goraxe | 2010-02-20 22:01:41 +0100
 change Options to Arguments
 r8785@Thesaurus (orig r8772):  goraxe | 2010-02-20 22:10:29 +0100
 add DBIx::Class::Admin::{Descriptive,Usage} to podcover ignore list
 r8790@Thesaurus (orig r8777):  rabbit | 2010-02-21 12:35:38 +0100
 Cleanup the makefile regen a bit
 r8792@Thesaurus (orig r8779):  rabbit | 2010-02-21 12:53:01 +0100
 Bah humbug
 r8793@Thesaurus (orig r8780):  rabbit | 2010-02-21 12:55:18 +0100
 And another one
 r8797@Thesaurus (orig r8784):  rabbit | 2010-02-21 13:32:03 +0100
 The minimal pod seems to confuse the manpage generator, commenting out for now
 r8798@Thesaurus (orig r8785):  rabbit | 2010-02-21 13:38:03 +0100
 Add license/author to dbicadmin autogen POD
 r8799@Thesaurus (orig r8786):  rabbit | 2010-02-21 13:38:58 +0100
 Reorder makefile author actions to make output more readable

r8803@Thesaurus (orig r8790):  ribasushi | 2010-02-21 14:24:15 +0100
Fix exception text
r8804@Thesaurus (orig r8791):  ribasushi | 2010-02-21 15:14:58 +0100
Extra testdep
r8808@Thesaurus (orig r8795):  caelum | 2010-02-22 20:16:07 +0100
with_deferred_fk_checks for Oracle
r8809@Thesaurus (orig r8796):  rabbit | 2010-02-22 21:26:20 +0100
Add a hidden option to dbicadmin to self-inject autogenerated POD
r8810@Thesaurus (orig r8797):  caelum | 2010-02-22 21:48:43 +0100
improve with_deferred_fk_checks for Oracle, add tests
r8812@Thesaurus (orig r8799):  rbuels | 2010-02-22 23:09:40 +0100
added package name to DBD::Pg warning in Pg storage driver to make it explicit where the warning is coming from
r8815@Thesaurus (orig r8802):  rabbit | 2010-02-23 11:21:10 +0100
Looks like the distdir wrapping is finally taken care of
r8818@Thesaurus (orig r8805):  rabbit | 2010-02-23 14:05:14 +0100
remove POD
r8819@Thesaurus (orig r8806):  rabbit | 2010-02-23 14:05:32 +0100
More index exclusions
r8821@Thesaurus (orig r8808):  goraxe | 2010-02-23 15:00:38 +0100
remove short options from dbicadmin
r8822@Thesaurus (orig r8809):  rabbit | 2010-02-23 15:15:00 +0100
Whitespace
r8826@Thesaurus (orig r8813):  rabbit | 2010-02-24 09:28:43 +0100
 r8585@Thesaurus (orig r8572):  faxm0dem | 2010-02-06 23:01:04 +0100
 sqlt::producer::oracle is now able to handle quotes correctly. Now we need to take advantage of that as currently the oracle producer capitalises everything
 r8586@Thesaurus (orig r8573):  faxm0dem | 2010-02-06 23:03:31 +0100
 the way I thought. ribasushi suggested to override deploy(ment_statements)
 r8607@Thesaurus (orig r8594):  faxm0dem | 2010-02-09 21:53:48 +0100
 should work now
 r8714@Thesaurus (orig r8701):  faxm0dem | 2010-02-14 09:49:44 +0100
 oracle_version
 r8747@Thesaurus (orig r8734):  faxm0dem | 2010-02-17 18:54:45 +0100
 still need to uc source_name if quotes off
 r8817@Thesaurus (orig r8804):  rabbit | 2010-02-23 12:03:23 +0100
 Cleanup code (hopefully no functional changes)
 r8820@Thesaurus (orig r8807):  rabbit | 2010-02-23 14:14:19 +0100
 Proper error message
 r8823@Thesaurus (orig r8810):  faxm0dem | 2010-02-23 15:46:11 +0100
 Schema Object Naming Rules :
 [...]
 However, database names, global database names, and database link names are always case insensitive and are stored as uppercase.

 # source: http://download.oracle.com/docs/cd/B19306_01/server.102/b14200/sql_elements008.htm

 r8824@Thesaurus (orig r8811):  rabbit | 2010-02-23 16:09:36 +0100
 Changes and dep-bump

r8828@Thesaurus (orig r8815):  rabbit | 2010-02-24 09:32:53 +0100
Changelogging
r8829@Thesaurus (orig r8816):  rabbit | 2010-02-24 09:37:14 +0100
Protect dbicadmin from self-injection when not in make
r8830@Thesaurus (orig r8817):  rabbit | 2010-02-24 10:00:43 +0100
Release 0.08120
r8832@Thesaurus (orig r8819):  rabbit | 2010-02-24 10:02:36 +0100
Bump trunk version
r8833@Thesaurus (orig r8820):  goraxe | 2010-02-24 14:21:23 +0100
 do not include hidden opts in generated pod
r8834@Thesaurus (orig r8821):  rabbit | 2010-02-24 15:50:34 +0100
small tool to query cpan deps
r8835@Thesaurus (orig r8822):  rabbit | 2010-02-26 00:22:51 +0100
Typo
r8849@Thesaurus (orig r8836):  rabbit | 2010-03-01 01:32:03 +0100
Cleanup logic in RSC
r8850@Thesaurus (orig r8837):  rabbit | 2010-03-01 01:36:24 +0100
Fix incorrect placement of condition resolution failure trap
r8851@Thesaurus (orig r8838):  rabbit | 2010-03-01 01:37:53 +0100
Changes

lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSetColumn.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Storage/DBI.pm
t/90join_torture.t
t/inflate/hri.t
t/prefetch/_internals.t [new file with mode: 0644]
t/prefetch/multiple_hasmany.t
t/prefetch/multiple_hasmany_torture.t [new file with mode: 0644]

index 7937ded..02cba11 100644 (file)
@@ -535,8 +535,8 @@ sub find {
   }
 
   # Run the query
-  my $rs = $self->search ($query, $attrs);
-  if (keys %{$rs->_resolved_attrs->{collapse}}) {
+  my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
+  if ($rs->_resolved_attrs->{collapse}) {
     my $row = $rs->next;
     carp "Query returned more than one row" if $rs->next;
     return $row;
@@ -723,7 +723,7 @@ sub single {
 
   my $attrs = $self->_resolved_attrs_copy;
 
-  if (keys %{$attrs->{collapse}}) {
+  if ($attrs->{collapse}) {
     $self->throw_exception(
       'single() can not be used on resultsets prefetching has_many. Use find( \%cond ) or next() instead'
     );
@@ -976,127 +976,103 @@ sub _construct_object {
   return @new;
 }
 
-sub _collapse_result {
-  my ($self, $as_proto, $row) = @_;
-
-  my @copy = @$row;
-
-  # 'foo'         => [ undef, 'foo' ]
-  # 'foo.bar'     => [ 'foo', 'bar' ]
-  # 'foo.bar.baz' => [ 'foo.bar', 'baz' ]
-
-  my @construct_as = map { [ (/^(?:(.*)\.)?([^.]+)$/) ] } @$as_proto;
-
-  my %collapse = %{$self->{_attrs}{collapse}||{}};
-
-  my @pri_index;
-
-  # if we're doing collapsing (has_many prefetch) we need to grab records
-  # until the PK changes, so fill @pri_index. if not, we leave it empty so
-  # we know we don't have to bother.
-
-  # the reason for not using the collapse stuff directly is because if you
-  # had for e.g. two artists in a row with no cds, the collapse info for
-  # both would be NULL (undef) so you'd lose the second artist
+# two arguments: $as_proto is an arrayref of column names,
+# $row_ref is an arrayref of the data. If none of the row data
+# is defined we return undef (that's copied from the old
+# _collapse_result). Next we decide whether we need to collapse
+# the resultset (i.e. we prefetch something) or not. $collapse
+# indicates that. The do-while loop will run once if we do not need
+# to collapse the result and will run as long as _merge_result returns
+# a true value. It will return undef if the current added row does not
+# match the previous row. A bit of stashing and cursor magic is
+# required so that the cursor is not mixed up.
 
-  # store just the index so we can check the array positions from the row
-  # without having to contruct the full hash
+# "$rows" is a bit misleading. In the end, there should only be one
+# element in this arrayref. 
 
-  if (keys %collapse) {
-    my %pri = map { ($_ => 1) } $self->result_source->primary_columns;
-    foreach my $i (0 .. $#construct_as) {
-      next if defined($construct_as[$i][0]); # only self table
-      if (delete $pri{$construct_as[$i][1]}) {
-        push(@pri_index, $i);
-      }
-      last unless keys %pri; # short circuit (Johnny Five Is Alive!)
+sub _collapse_result {
+    my ( $self, $as_proto, $row_ref ) = @_;
+    my $has_def;
+    for (@$row_ref) {
+        if ( defined $_ ) {
+            $has_def++;
+            last;
+        }
     }
-  }
-
-  # no need to do an if, it'll be empty if @pri_index is empty anyway
-
-  my %pri_vals = map { ($_ => $copy[$_]) } @pri_index;
-
-  my @const_rows;
-
-  do { # no need to check anything at the front, we always want the first row
-
-    my %const;
-
-    foreach my $this_as (@construct_as) {
-      $const{$this_as->[0]||''}{$this_as->[1]} = shift(@copy);
+    return undef unless $has_def;
+
+    my $collapse = $self->_resolved_attrs->{collapse};
+    my $rows     = [];
+    my @row      = @$row_ref;
+    do {
+        my $i = 0;
+        my $row = { map { $_ => $row[ $i++ ] } @$as_proto };
+        $row = $self->result_source->_parse_row($row, $collapse);
+        unless ( scalar @$rows ) {
+            push( @$rows, $row );
+        }
+        $collapse = undef unless ( $self->_merge_result( $rows, $row ) );
+      } while (
+        $collapse
+        && do { @row = $self->cursor->next; $self->{stashed_row} = \@row if @row; }
+      );
+
+    return $rows->[0];
+
+}
+
+# _merge_result accepts an arrayref of rows objects (again, an arrayref of two elements)
+# and a row object which should be merged into the first object.
+# First we try to find out whether $row is already in $rows. If this is the case
+# we try to merge them by iteration through their relationship data. We call
+# _merge_result again on them, so they get merged.
+
+# If we don't find the $row in $rows, we append it to $rows and return undef.
+# _merge_result returns 1 otherwise (i.e. $row has been found in $rows).
+
+sub _merge_result {
+    my ( $self, $rows, $row ) = @_;
+    my ( $columns, $rels ) = @$row;
+    my $found = undef;
+    foreach my $seen (@$rows) {
+        my $match = 1;
+        foreach my $column ( keys %$columns ) {
+            if (   defined $seen->[0]->{$column} ^ defined $columns->{$column}
+                or defined $columns->{$column}
+                && $seen->[0]->{$column} ne $columns->{$column} )
+            {
+
+                $match = 0;
+                last;
+            }
+        }
+        if ($match) {
+            $found = $seen;
+            last;
+        }
     }
+    if ($found) {
+        foreach my $rel ( keys %$rels ) {
+            my $old_rows = $found->[1]->{$rel};
+            $self->_merge_result(
+                ref $found->[1]->{$rel}->[0] eq 'HASH' ? [ $found->[1]->{$rel} ]
+                : $found->[1]->{$rel},
+                ref $rels->{$rel}->[0] eq 'HASH' ? [ $rels->{$rel}->[0], $rels->{$rel}->[1] ]
+                : $rels->{$rel}->[0]
+            );
 
-    push(@const_rows, \%const);
-
-  } until ( # no pri_index => no collapse => drop straight out
-      !@pri_index
-    or
-      do { # get another row, stash it, drop out if different PK
-
-        @copy = $self->cursor->next;
-        $self->{stashed_row} = \@copy;
-
-        # last thing in do block, counts as true if anything doesn't match
-
-        # check xor defined first for NULL vs. NOT NULL then if one is
-        # defined the other must be so check string equality
-
-        grep {
-          (defined $pri_vals{$_} ^ defined $copy[$_])
-          || (defined $pri_vals{$_} && ($pri_vals{$_} ne $copy[$_]))
-        } @pri_index;
-      }
-  );
-
-  my $alias = $self->{attrs}{alias};
-  my $info = [];
-
-  my %collapse_pos;
-
-  my @const_keys;
-
-  foreach my $const (@const_rows) {
-    scalar @const_keys or do {
-      @const_keys = sort { length($a) <=> length($b) } keys %$const;
-    };
-    foreach my $key (@const_keys) {
-      if (length $key) {
-        my $target = $info;
-        my @parts = split(/\./, $key);
-        my $cur = '';
-        my $data = $const->{$key};
-        foreach my $p (@parts) {
-          $target = $target->[1]->{$p} ||= [];
-          $cur .= ".${p}";
-          if ($cur eq ".${key}" && (my @ckey = @{$collapse{$cur}||[]})) {
-            # collapsing at this point and on final part
-            my $pos = $collapse_pos{$cur};
-            CK: foreach my $ck (@ckey) {
-              if (!defined $pos->{$ck} || $pos->{$ck} ne $data->{$ck}) {
-                $collapse_pos{$cur} = $data;
-                delete @collapse_pos{ # clear all positioning for sub-entries
-                  grep { m/^\Q${cur}.\E/ } keys %collapse_pos
-                };
-                push(@$target, []);
-                last CK;
-              }
-            }
-          }
-          if (exists $collapse{$cur}) {
-            $target = $target->[-1];
-          }
         }
-        $target->[0] = $data;
-      } else {
-        $info->[0] = $const->{$key};
-      }
+
+    }
+    else {
+        push( @$rows, $row );
+        return undef;
     }
-  }
 
-  return $info;
+    return 1;
 }
 
+
 =head2 result_source
 
 =over 4
@@ -1261,7 +1237,7 @@ sub _count_subq_rs {
 
   # if we multi-prefetch we group_by primary keys only as this is what we would
   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
-  if ( keys %{$attrs->{collapse}}  ) {
+  if ( $attrs->{collapse}  ) {
     $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ]
   }
 
@@ -1331,7 +1307,7 @@ sub all {
 
   my @obj;
 
-  if (keys %{$self->_resolved_attrs->{collapse}}) {
+  if ($self->_resolved_attrs->{collapse}) {
     # 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
@@ -2866,7 +2842,6 @@ sub _resolved_attrs {
     }
   }
   else {
-
     # otherwise we intialise select & as to empty
     $attrs->{select} = [];
     $attrs->{as}     = [];
@@ -2956,9 +2931,8 @@ sub _resolved_attrs {
     }
   }
 
-  $attrs->{collapse} ||= {};
   if ( my $prefetch = delete $attrs->{prefetch} ) {
-    $prefetch = $self->_merge_attr( {}, $prefetch );
+    $attrs->{collapse} = 1;
 
     my $prefetch_ordering = [];
 
@@ -2983,8 +2957,7 @@ sub _resolved_attrs {
       }
     }
 
-    my @prefetch =
-      $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
+    my @prefetch = $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering );
 
     # we need to somehow mark which columns came from prefetch
     $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
@@ -2996,6 +2969,30 @@ sub _resolved_attrs {
     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
   }
 
+  # run through the resulting joinstructure (starting from our current slot)
+  # and unset collapse if proven unnesessary
+  if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') {
+
+    if (@{$attrs->{from}} > 1) {
+
+      # find where our table-spec starts and consider only things after us
+      my @fromlist = @{$attrs->{from}};
+      while (@fromlist) {
+        my $t = shift @fromlist;
+        $t = $t->[0] if ref $t eq 'ARRAY';  #me vs join from-spec mismatch
+        last if ($t->{-alias} && $t->{-alias} eq $alias);
+      }
+
+      if (@fromlist) {
+        $attrs->{collapse} = scalar grep { ! $_->[0]{-is_single} } (@fromlist);
+      }
+    }
+    else {
+      # no joins - no collapse
+      $attrs->{collapse} = 0;
+    }
+  }
+
   # 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
index 4017466..ae704f9 100644 (file)
@@ -86,7 +86,7 @@ sub new {
 
   # {collapse} would mean a has_many join was injected, which in turn means
   # we need to group *IF WE CAN* (only if the column in question is unique)
-  if (!$orig_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) {
+  if (!$orig_attrs->{group_by} && $orig_attrs->{collapse}) {
 
     # scan for a constraint that would contain our column only - that'd be proof
     # enough it is unique
index 4b6ec45..c611d28 100644 (file)
@@ -1388,7 +1388,7 @@ sub _resolve_condition {
 # in the supplied relationships.
 
 sub _resolve_prefetch {
-  my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
+  my ($self, $pre, $alias, $alias_map, $order, $pref_path) = @_;
   $pref_path ||= [];
 
   if (not defined $pre) {
@@ -1396,15 +1396,15 @@ sub _resolve_prefetch {
   }
   elsif( ref $pre eq 'ARRAY' ) {
     return
-      map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ) }
+      map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, [ @$pref_path ] ) }
         @$pre;
   }
   elsif( ref $pre eq 'HASH' ) {
     my @ret =
     map {
-      $self->_resolve_prefetch($_, $alias, $alias_map, $order, $collapse, [ @$pref_path ] ),
+      $self->_resolve_prefetch($_, $alias, $alias_map, $order, [ @$pref_path ] ),
       $self->related_source($_)->_resolve_prefetch(
-               $pre->{$_}, "${alias}.$_", $alias_map, $order, $collapse, [ @$pref_path, $_] )
+               $pre->{$_}, "${alias}.$_", $alias_map, $order, [ @$pref_path, $_] )
     } keys %$pre;
     return @ret;
   }
@@ -1434,29 +1434,14 @@ sub _resolve_prefetch {
         "Can't prefetch has_many ${pre} (join cond too complex)")
         unless ref($rel_info->{cond}) eq 'HASH';
       my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
-      if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
-                         keys %{$collapse}) {
-        my ($last) = ($fail =~ /([^\.]+)$/);
-        carp (
-          "Prefetching multiple has_many rels ${last} and ${pre} "
-          .(length($as_prefix)
-            ? "at the same level (${as_prefix}) "
-            : "at top level "
-          )
-          . 'will explode the number of row objects retrievable via ->next or ->all. '
-          . 'Use at your own risk.'
-        );
-      }
+
       #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
       #              values %{$rel_info->{cond}};
-      $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
-        # action at a distance. prepending the '.' allows simpler code
-        # in ResultSet->_collapse_result
       my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
                     keys %{$rel_info->{cond}};
       my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
                    ? @{$rel_info->{attrs}{order_by}}
-   
+
                 : (defined $rel_info->{attrs}{order_by}
                        ? ($rel_info->{attrs}{order_by})
                        : ()));
@@ -1468,6 +1453,46 @@ sub _resolve_prefetch {
   }
 }
 
+# Takes a hashref of $sth->fetchrow values keyed to the corresponding
+# {as} dbic aliases, and splits it into a native columns hashref
+# (as in $row->get_columns), followed by any non-native (prefetched)
+# columns, presented in a nested structure resembling an HRI dump.
+# The structure is constructed taking into account relationship metadata
+# (single vs multi).
+# The resulting arrayref resembles the arguments to ::Row::inflate_result
+# For an example look at t/prefetch/_util.t
+#
+# The will collapse flag is for backwards compatibility only - if it is
+# set, all relationship row-parts are returned as hashes, even if some
+# of these relationships are has_many's
+#
+sub _parse_row {
+    my ( $self, $row, $will_collapse ) = @_;
+
+    my ($me, $pref);
+
+    foreach my $column ( keys %$row ) {
+        if ( $column =~ /^ ([^\.]+) \. (.*) $/x ) {
+            $pref->{$1}{$2} = $row->{$column};
+        }
+        else {
+            $me->{$column} = $row->{$column};
+        }
+    }
+
+    foreach my $rel ( keys %{$pref||{}} ) {
+        my $rel_info = $self->relationship_info($rel);
+
+        $pref->{$rel} =
+          $self->related_source($rel)->_parse_row( $pref->{$rel}, $will_collapse );
+
+        $pref->{$rel} = [ $pref->{$rel} ]
+          if ( $will_collapse && $rel_info->{attrs}{accessor} eq 'multi' );
+    }
+
+    return [ $me||{}, $pref||() ];
+}
+
 =head2 related_source
 
 =over 4
index 8955748..48e6785 100644 (file)
@@ -1786,8 +1786,8 @@ sub _select_args {
   # see if we need to tear the prefetch apart otherwise delegate the limiting to the
   # storage, unless software limit was requested
   if (
-    #limited has_many
-    ( $attrs->{rows} && keys %{$attrs->{collapse}} )
+    # limited collapsing has_many
+    ( $attrs->{rows} && $attrs->{collapse} )
        ||
     # limited prefetch with RNO subqueries
     (
index 6eeda5a..90a78b2 100644 (file)
@@ -1,37 +1,64 @@
 use strict;
-use warnings;  
+use warnings;
 
 use Test::More;
+use Test::Exception;
+
 use lib qw(t/lib);
 use DBICTest;
+use DBIC::SqlMakerTest;
 my $schema = DBICTest->init_schema();
 
-plan tests => 22;
-
- {
-   my $rs = $schema->resultset( 'CD' )->search(
-     {
-       'producer.name'   => 'blah',
-       'producer_2.name' => 'foo',
-     },
-     {
-       'join' => [
-         { cd_to_producer => 'producer' },
-         { cd_to_producer => 'producer' },
-       ],
-       'prefetch' => [
-         'artist',
-         { cd_to_producer => 'producer' },
-       ],
-     }
-   );
-  
-   eval {
-     my @rows = $rs->all();
-   };
-   is( $@, '' );
- }
-
+lives_ok (sub {
+  my $rs = $schema->resultset( 'CD' )->search(
+    {
+      'producer.name'   => 'blah',
+      'producer_2.name' => 'foo',
+    },
+    {
+      'join' => [
+        { cd_to_producer => 'producer' },
+        { cd_to_producer => 'producer' },
+      ],
+      'prefetch' => [
+        'artist',
+        { cd_to_producer => { producer => 'producer_to_cd' } },
+      ],
+    }
+  );
+
+  my @executed = $rs->all();
+
+  is_same_sql_bind (
+    $rs->as_query,
+    '(
+      SELECT  me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+              artist.artistid, artist.name, artist.rank, artist.charfield,
+              cd_to_producer.cd, cd_to_producer.producer, cd_to_producer.attribute,
+              producer.producerid, producer.name,
+              producer_to_cd.cd, producer_to_cd.producer, producer_to_cd.attribute
+        FROM cd me
+        LEFT JOIN cd_to_producer cd_to_producer
+          ON cd_to_producer.cd = me.cdid
+        LEFT JOIN producer producer
+          ON producer.producerid = cd_to_producer.producer
+        LEFT JOIN cd_to_producer producer_to_cd
+          ON producer_to_cd.producer = producer.producerid
+        LEFT JOIN cd_to_producer cd_to_producer_2
+          ON cd_to_producer_2.cd = me.cdid
+        LEFT JOIN producer producer_2
+          ON producer_2.producerid = cd_to_producer_2.producer
+        JOIN artist artist ON artist.artistid = me.artist
+      WHERE ( ( producer.name = ? AND producer_2.name = ? ) )
+      ORDER BY cd_to_producer.cd, producer_to_cd.producer
+    )',
+    [
+      [ 'producer.name' => 'blah' ],
+      [ 'producer_2.name' => 'foo' ],
+    ],
+  );
+
+}, 'Complex join parsed/executed properly');
 
 my @rs1a_results = $schema->resultset("Artist")->search_related('cds', {title => 'Forkful of bees'}, {order_by => 'title'});
 is($rs1a_results[0]->title, 'Forkful of bees', "bare field conditions okay after search related");
@@ -125,4 +152,4 @@ my $second_search_rs = $rs->search({ 'cds_2.cdid' => '2' }, { join =>
 is(scalar(@{$second_search_rs->{attrs}->{join}}), 3, 'both joins kept');
 ok($second_search_rs->next, 'query on double joined rel runs okay');
 
-1;
+done_testing;
index eb74da1..dfc69ba 100644 (file)
@@ -48,7 +48,7 @@ sub check_cols_of {
             my @dbic_reltable = $dbic_obj->$col;
             my @hashref_reltable = @{$datahashref->{$col}};
 
-            is (scalar @dbic_reltable, scalar @hashref_reltable, 'number of related entries');
+            is (scalar @hashref_reltable, scalar @dbic_reltable, 'number of related entries');
 
             # for my $index (0..scalar @hashref_reltable) {
             for my $index (0..scalar @dbic_reltable) {
diff --git a/t/prefetch/_internals.t b/t/prefetch/_internals.t
new file mode 100644 (file)
index 0000000..8ccea90
--- /dev/null
@@ -0,0 +1,102 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema(no_deploy => 1);
+
+
+my $irow = $schema->source ('Artwork')->_parse_row (
+  {
+    'cd_id' => '1',
+
+    'artwork_to_artist.artist_id' => '2',
+    'artwork_to_artist.artwork_cd_id' => '1',
+
+    'cd.artist' => '1',
+    'cd.cdid' => '1',
+    'cd.title' => 'Spoonful of bees',
+
+    'cd.artist.artistid' => '1',
+    'cd.artist.name' => 'Caterwauler McCrae',
+  },
+  'will collapse'
+);
+
+is_deeply (
+  $irow,
+  [
+    {
+      'cd_id' => '1'
+    },
+    {
+      'artwork_to_artist' => [
+        [
+          {
+            'artist_id' => '2',
+            'artwork_cd_id' => '1'
+          }
+        ]
+      ],
+
+      'cd' => [
+        {
+          'artist' => '1',
+          'cdid' => '1',
+          'title' => 'Spoonful of bees',
+        },
+        {
+          'artist' => [
+            {
+              'artistid' => '1',
+              'name' => 'Caterwauler McCrae',
+            }
+          ]
+        }
+      ]
+    }
+  ],
+  '_parse_row works as expected with expected collapse',
+);
+
+$irow = $schema->source ('Artist')->_parse_row (
+  {
+    'name' => 'Caterwauler McCrae',
+    'cds.tracks.cd' => '3',
+    'cds.tracks.title' => 'Fowlin',
+    'cds.tracks.cd_single.title' => 'Awesome single',
+  }
+);
+is_deeply (
+  $irow,
+  [
+    {
+      'name' => 'Caterwauler McCrae'
+    },
+    {
+      'cds' => [
+        {},
+        {
+          'tracks' => [
+            {
+              'cd' => '3',
+              'title' => 'Fowlin'
+            },
+            {
+              'cd_single' => [
+                {
+                  title => 'Awesome single',
+                },
+              ],
+            },
+          ]
+        }
+      ]
+    }
+  ],
+  '_parse_row works over missing joins without collapse',
+);
+
+done_testing;
index 311ac3f..9c7bf38 100644 (file)
 use strict;
-use warnings;  
+use warnings;
 
 use Test::More;
 use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
-use IO::File;
 
 my $schema = DBICTest->init_schema();
 my $sdebug = $schema->storage->debug;
 
-# once the following TODO is complete, remove the 2 warning tests immediately
-# after the TODO block
-# (the TODO block itself contains tests ensuring that the warns are removed)
-TODO: {
-    local $TODO = 'Prefetch of multiple has_many rels at the same level (currently warn to protect the clueless git)';
+#( 1 -> M + M )
+my $cd_rs = $schema->resultset('CD')->search( { 'me.title' => 'Forkful of bees' } );
+my $pr_cd_rs = $cd_rs->search( {}, { prefetch => [qw/tracks tags/], } );
 
-    #( 1 -> M + M )
-    my $cd_rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' });
-    my $pr_cd_rs = $cd_rs->search ({}, {
-        prefetch => [qw/tracks tags/],
-    });
+my $tracks_rs    = $cd_rs->first->tracks;
+my $tracks_count = $tracks_rs->count;
 
-    my $tracks_rs = $cd_rs->first->tracks;
-    my $tracks_count = $tracks_rs->count;
+my ( $pr_tracks_rs, $pr_tracks_count );
 
-    my ($pr_tracks_rs, $pr_tracks_count);
+my $queries = 0;
+$schema->storage->debugcb( sub { $queries++ } );
+$schema->storage->debug(1);
 
-    my $queries = 0;
-    $schema->storage->debugcb(sub { $queries++ });
-    $schema->storage->debug(1);
-
-    my $o_mm_warn;
-    {
-        local $SIG{__WARN__} = sub { $o_mm_warn = shift };
-        $pr_tracks_rs = $pr_cd_rs->first->tracks;
-    };
-    $pr_tracks_count = $pr_tracks_rs->count;
-
-    ok(! $o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)');
-
-    is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
-    $schema->storage->debugcb (undef);
-    $schema->storage->debug ($sdebug);
-
-    is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)');
-    is ($pr_tracks_rs->all, $tracks_rs->all, 'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
-
-    #( M -> 1 -> M + M )
-    my $note_rs = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' });
-    my $pr_note_rs = $note_rs->search ({}, {
-        prefetch => {
-            cd => [qw/tracks tags/]
-        },
-    });
-
-    my $tags_rs = $note_rs->first->cd->tags;
-    my $tags_count = $tags_rs->count;
-
-    my ($pr_tags_rs, $pr_tags_count);
-
-    $queries = 0;
-    $schema->storage->debugcb(sub { $queries++ });
-    $schema->storage->debug(1);
-
-    my $m_o_mm_warn;
-    {
-        local $SIG{__WARN__} = sub { $m_o_mm_warn = shift };
-        $pr_tags_rs = $pr_note_rs->first->cd->tags;
-    };
-    $pr_tags_count = $pr_tags_rs->count;
-
-    ok(! $m_o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)');
-
-    is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
-    $schema->storage->debugcb (undef);
-    $schema->storage->debug ($sdebug);
-
-    is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)');
-    is($pr_tags_rs->all, $tags_rs->all, 'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
-}
-
-# remove this closure once the TODO above is working
+my $o_mm_warn;
 {
-    my $warn_re = qr/will explode the number of row objects retrievable via/;
-
-    my (@w, @dummy);
-    local $SIG{__WARN__} = sub { $_[0] =~ $warn_re ? push @w, @_ : warn @_ };
-
-    my $rs = $schema->resultset('CD')->search ({ 'me.title' => 'Forkful of bees' }, { prefetch => [qw/tracks tags/] });
-    @w = ();
-    @dummy = $rs->first;
-    is (@w, 1, 'warning on attempt prefetching several same level has_manys (1 -> M + M)');
-
-    my $rs2 = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' }, { prefetch => { cd => [qw/tags tracks/] } });
-    @w = ();
-    @dummy = $rs2->first;
-    is (@w, 1, 'warning on attempt prefetching several same level has_manys (M -> 1 -> M + M)');
-}
+    local $SIG{__WARN__} = sub { $o_mm_warn = shift };
+    $pr_tracks_rs = $pr_cd_rs->first->tracks;
+};
+$pr_tracks_count = $pr_tracks_rs->count;
+
+ok( !$o_mm_warn,
+'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)'
+);
+
+is( $queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query' );
+$schema->storage->debugcb(undef);
+$schema->storage->debug($sdebug);
+
+is( $pr_tracks_count, $tracks_count,
+'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)'
+);
+is( $pr_tracks_rs->all, $tracks_rs->all,
+'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)'
+);
+
+#( M -> 1 -> M + M )
+my $note_rs =
+  $schema->resultset('LinerNotes')->search( { notes => 'Buy Whiskey!' } );
+my $pr_note_rs =
+  $note_rs->search( {}, { prefetch => { cd => [qw/tracks tags/] }, } );
+
+my $tags_rs    = $note_rs->first->cd->tags;
+my $tags_count = $tags_rs->count;
+
+my ( $pr_tags_rs, $pr_tags_count );
+
+$queries = 0;
+$schema->storage->debugcb( sub { $queries++ } );
+$schema->storage->debug(1);
+
+my $m_o_mm_warn;
+{
+    local $SIG{__WARN__} = sub { $m_o_mm_warn = shift };
+    $pr_tags_rs = $pr_note_rs->first->cd->tags;
+};
+$pr_tags_count = $pr_tags_rs->count;
+
+ok( !$m_o_mm_warn,
+'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)'
+);
+
+is( $queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query' );
+$schema->storage->debugcb(undef);
+$schema->storage->debug($sdebug);
+
+is( $pr_tags_count, $tags_count,
+'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)'
+);
+is( $pr_tags_rs->all, $tags_rs->all,
+'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)'
+);
 
 done_testing;
diff --git a/t/prefetch/multiple_hasmany_torture.t b/t/prefetch/multiple_hasmany_torture.t
new file mode 100644 (file)
index 0000000..973df8b
--- /dev/null
@@ -0,0 +1,303 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $mo_rs = $schema->resultset('Artist')->search(
+    { 'me.artistid' => 4 },
+    {
+        prefetch     => [
+            {
+                cds => [
+                    { tracks         => { cd_single => 'tracks' } },
+                    { cd_to_producer => 'producer' }
+                ]
+            },
+            { artwork_to_artist => 'artwork' }
+        ],
+
+        result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+    }
+);
+
+
+$schema->resultset('Artist')->create(
+    {
+        name => 'mo',
+        rank => '1337',
+        cds  => [
+            {
+                title  => 'Song of a Foo',
+                year   => '1999',
+                tracks => [
+                    {
+                        title    => 'Foo Me Baby One More Time',
+                    },
+                    {
+                        title    => 'Foo Me Baby One More Time II',
+                    },
+                    {
+                        title    => 'Foo Me Baby One More Time III',
+                    },
+                    {
+                        title    => 'Foo Me Baby One More Time IV',
+                        cd_single =>
+                          { artist => 1, title => 'MO! Single', year => 2021, tracks => [
+                            { title => 'singled out' }, { title => 'still alone' },
+                          ] },
+                    }
+                ],
+                cd_to_producer => [
+                    { producer => { name => 'riba' } },
+                    { producer => { name => 'sushi' } },
+                ]
+            },
+            {
+                title  => 'Song of a Foo II',
+                year   => '2002',
+                tracks => [
+                    {
+                        title    => 'Quit Playing Games With My Heart',
+                    },
+                    {
+                        title    => 'Bar Foo',
+                    },
+                    {
+                        title    => 'Foo Bar',
+                        cd_single =>
+                          { artist => 2, title => 'MO! Single', year => 2020, tracks => [
+                            { title => 'singled out' }, { title => 'still alone' },
+                          ] },
+                    }
+                ],
+                cd_to_producer => [
+                  { producer => { name => 'riba' } },
+                  { producer => { name => 'sushi' } },
+                ],
+            }
+        ],
+        artwork_to_artist =>
+          [ { artwork => { cd_id => 1 } }, { artwork => { cd_id => 2 } } ]
+    }
+);
+
+my $mo = $mo_rs->next;
+
+is( @{$mo->{cds}}, 2, 'two CDs' );
+
+is_deeply(
+    $mo,
+    {
+        'cds' => [
+            {
+                'single_track' => undef,
+                'tracks'       => [
+                    {
+                        'small_dt'  => undef,
+                        'cd'        => '6',
+                        'position'  => '1',
+                        'trackid'   => '19',
+                        'title'     => 'Foo Me Baby One More Time',
+                        'cd_single' => undef,
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef
+                    },
+                    {
+                        'small_dt'        => undef,
+                        'cd'              => '6',
+                        'position'        => '2',
+                        'trackid'         => '20',
+                        'title'           => 'Foo Me Baby One More Time II',
+                        'cd_single'       => undef,
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef
+                    },
+                    {
+                        'small_dt'        => undef,
+                        'cd'              => '6',
+                        'position'        => '3',
+                        'trackid'         => '21',
+                        'title'           => 'Foo Me Baby One More Time III',
+                        'cd_single'       => undef,
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef
+                    },
+                    {
+                        'small_dt'        => undef,
+                        'cd'              => '6',
+                        'position'        => '4',
+                        'trackid'         => '22',
+                        'title'           => 'Foo Me Baby One More Time IV',
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef,
+                        'cd_single' => {
+                            'single_track' => '22',
+                            'artist'       => '1',
+                            'cdid'         => '7',
+                            'title'        => 'MO! Single',
+                            'genreid'      => undef,
+                            'year'         => '2021',
+                            'tracks'       => [
+                                {
+                                    'small_dt' => undef,
+                                    'cd' => '7',
+                                    'position' => '1',
+                                    'title' => 'singled out',
+                                    'trackid' => '23',
+                                    'last_updated_at' => undef,
+                                    'last_updated_on' => undef
+                                },
+                                {
+                                    'small_dt' => undef,
+                                    'cd' => '7',
+                                    'position' => '2',
+                                    'title' => 'still alone',
+                                    'trackid' => '24',
+                                    'last_updated_at' => undef,
+                                    'last_updated_on' => undef
+                                },
+                            ],
+                        },
+                    }
+                ],
+                'artist'         => '4',
+                'cdid'           => '6',
+                'cd_to_producer' => [
+                    {
+                        'attribute' => undef,
+                        'cd'        => '6',
+                        'producer'  => {
+                            'name'       => 'riba',
+                            'producerid' => '4'
+                        }
+                    },
+                    {
+                        'attribute' => undef,
+                        'cd'        => '6',
+                        'producer'  => {
+                            'name'       => 'sushi',
+                            'producerid' => '5'
+                        }
+                    }
+                ],
+                'title'   => 'Song of a Foo',
+                'genreid' => undef,
+                'year'    => '1999'
+            },
+            {
+                'single_track' => undef,
+                'tracks'       => [
+                    # FIXME
+                    # although the positional ordering is correct, SQLite seems to return
+                    # the rows randomly if an ORDER BY is not supplied. Of course ordering
+                    # by right side of prefetch joins is not yet possible, thus we just hope
+                    # that the order is stable
+                    {
+                        'small_dt'        => undef,
+                        'cd'              => '8',
+                        'position'        => '2',
+                        'trackid'         => '26',
+                        'title'           => 'Bar Foo',
+                        'cd_single'       => undef,
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef
+                    },
+                    {
+                        'small_dt'  => undef,
+                        'cd'        => '8',
+                        'position'  => '1',
+                        'trackid'   => '25',
+                        'title'     => 'Quit Playing Games With My Heart',
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef,
+                        'cd_single'       => undef,
+                    },
+                    {
+                        'small_dt'        => undef,
+                        'cd'              => '8',
+                        'position'        => '3',
+                        'trackid'         => '27',
+                        'title'           => 'Foo Bar',
+                        'last_updated_on' => undef,
+                        'last_updated_at' => undef,
+                        'cd_single' => {
+                            'single_track' => '27',
+                            'artist'       => '2',
+                            'cdid'         => '9',
+                            'title'        => 'MO! Single',
+                            'genreid'      => undef,
+                            'year'         => '2020',
+                            'tracks'       => [
+                                {
+                                    'small_dt' => undef,
+                                    'cd' => '9',
+                                    'position' => '1',
+                                    'title' => 'singled out',
+                                    'trackid' => '28',
+                                    'last_updated_at' => undef,
+                                    'last_updated_on' => undef
+                                },
+                                {
+                                    'small_dt' => undef,
+                                    'cd' => '9',
+                                    'position' => '2',
+                                    'title' => 'still alone',
+                                    'trackid' => '29',
+                                    'last_updated_at' => undef,
+                                    'last_updated_on' => undef
+                                },
+                            ],
+
+                          },
+                      },
+                ],
+                'artist'         => '4',
+                'cdid'           => '8',
+                'cd_to_producer' => [
+                    {
+                        'attribute' => undef,
+                        'cd'        => '8',
+                        'producer'  => {
+                            'name'       => 'riba',
+                            'producerid' => '4'
+                        }
+                    },
+                    {
+                        'attribute' => undef,
+                        'cd'        => '8',
+                        'producer'  => {
+                            'name'       => 'sushi',
+                            'producerid' => '5'
+                        }
+                    }
+                ],
+                'title'   => 'Song of a Foo II',
+                'genreid' => undef,
+                'year'    => '2002'
+            }
+        ],
+        'artistid'          => '4',
+        'charfield'         => undef,
+        'name'              => 'mo',
+        'artwork_to_artist' => [
+            {
+                'artwork'       => { 'cd_id' => '1' },
+                'artist_id'     => '4',
+                'artwork_cd_id' => '1'
+            },
+            {
+                'artwork'       => { 'cd_id' => '2' },
+                'artist_id'     => '4',
+                'artwork_cd_id' => '2'
+            }
+        ],
+        'rank' => '1337'
+    }
+);
+
+done_testing;