Merge 'trunk' into 'prefetch'
Peter Rabbitson [Sun, 14 Feb 2010 10:46:07 +0000 (10:46 +0000)]
r8598@Thesaurus (orig r8585):  ribasushi | 2010-02-08 12:48:31 +0100
Release 0.08118
r8600@Thesaurus (orig r8587):  ribasushi | 2010-02-08 12:52:33 +0100
Bump trunk version
r8606@Thesaurus (orig r8593):  ribasushi | 2010-02-08 16:16:44 +0100
cheaper lookup
r8609@Thesaurus (orig r8596):  ribasushi | 2010-02-10 12:40:37 +0100
Consolidate last_insert_id handling with a fallback-attempt on DBI::last_insert_id
r8614@Thesaurus (orig r8601):  caelum | 2010-02-10 21:29:51 +0100
workaround for Moose bug affecting Replicated storage
r8615@Thesaurus (orig r8602):  caelum | 2010-02-10 21:40:07 +0100
revert Moose bug workaround, bump Moose dep for Replicated to 0.98
r8616@Thesaurus (orig r8603):  caelum | 2010-02-10 22:48:34 +0100
add a couple proxy methods to Replicated so it can run
r8628@Thesaurus (orig r8615):  caelum | 2010-02-11 11:35:01 +0100
 r21090@hlagh (orig r7836):  caelum | 2009-11-02 06:40:52 -0500
 new branch to fix unhandled methods in Storage::DBI::Replicated
 r21091@hlagh (orig r7837):  caelum | 2009-11-02 06:42:00 -0500
 add test to display unhandled methods
 r21092@hlagh (orig r7838):  caelum | 2009-11-02 06:55:34 -0500
 minor fix to last committed test
 r21093@hlagh (orig r7839):  caelum | 2009-11-02 09:26:00 -0500
 minor test code cleanup
 r23125@hlagh (orig r8607):  caelum | 2010-02-10 19:25:51 -0500
 add unimplemented Storage::DBI methods to ::DBI::Replicated
 r23130@hlagh (orig r8612):  ribasushi | 2010-02-11 05:12:48 -0500
 Podtesting exclusion

r8630@Thesaurus (orig r8617):  frew | 2010-02-11 11:45:54 +0100
Changes (from a while ago)
r8631@Thesaurus (orig r8618):  caelum | 2010-02-11 11:46:58 +0100
savepoints for SQLAnywhere
r8640@Thesaurus (orig r8627):  ribasushi | 2010-02-11 12:33:19 +0100
 r8424@Thesaurus (orig r8411):  ribasushi | 2010-01-22 11:19:40 +0100
 Chaining POC test

r8641@Thesaurus (orig r8628):  ribasushi | 2010-02-11 12:34:19 +0100
 r8426@Thesaurus (orig r8413):  ribasushi | 2010-01-22 11:35:15 +0100
 Moev failing regression test away from trunk

r8642@Thesaurus (orig r8629):  ribasushi | 2010-02-11 12:34:56 +0100

r8643@Thesaurus (orig r8630):  ribasushi | 2010-02-11 12:35:03 +0100
 r8507@Thesaurus (orig r8494):  frew | 2010-02-01 04:33:08 +0100
 small refactor to put select/as/+select/+as etc merging in it's own function

r8644@Thesaurus (orig r8631):  ribasushi | 2010-02-11 12:35:11 +0100
 r8514@Thesaurus (orig r8501):  frew | 2010-02-02 05:12:29 +0100
 revert actual changes from yesterday as per ribasushis advice

r8645@Thesaurus (orig r8632):  ribasushi | 2010-02-11 12:35:16 +0100
 r8522@Thesaurus (orig r8509):  frew | 2010-02-02 19:39:33 +0100
 delete +stuff if stuff exists

r8646@Thesaurus (orig r8633):  ribasushi | 2010-02-11 12:35:23 +0100
 r8534@Thesaurus (orig r8521):  frew | 2010-02-03 06:14:44 +0100
 change deletion/overriding to fix t/76

r8647@Thesaurus (orig r8634):  ribasushi | 2010-02-11 12:35:30 +0100
 r8535@Thesaurus (orig r8522):  frew | 2010-02-03 06:57:15 +0100
 some basic readability factorings (aka, fewer nested ternaries and long maps)

r8648@Thesaurus (orig r8635):  ribasushi | 2010-02-11 12:36:01 +0100
 r8558@Thesaurus (orig r8545):  frew | 2010-02-04 20:32:54 +0100
 fix incorrect test in t/76select.t and posit an incorrect solution

r8649@Thesaurus (orig r8636):  ribasushi | 2010-02-11 12:38:47 +0100

r8650@Thesaurus (orig r8637):  ribasushi | 2010-02-11 12:38:57 +0100
 r8578@Thesaurus (orig r8565):  ribasushi | 2010-02-05 19:11:09 +0100
 Should not be needed

r8651@Thesaurus (orig r8638):  ribasushi | 2010-02-11 12:39:03 +0100
 r8579@Thesaurus (orig r8566):  ribasushi | 2010-02-05 19:13:24 +0100
 SQLA now fixed

r8652@Thesaurus (orig r8639):  ribasushi | 2010-02-11 12:39:10 +0100
 r8624@Thesaurus (orig r8611):  ribasushi | 2010-02-11 10:31:08 +0100
 MOAR testing

r8653@Thesaurus (orig r8640):  ribasushi | 2010-02-11 12:39:17 +0100
 r8626@Thesaurus (orig r8613):  frew | 2010-02-11 11:16:30 +0100
 fix bad test

r8654@Thesaurus (orig r8641):  ribasushi | 2010-02-11 12:39:23 +0100
 r8627@Thesaurus (orig r8614):  frew | 2010-02-11 11:21:52 +0100
 fix t/76, break rsc tests

r8655@Thesaurus (orig r8642):  ribasushi | 2010-02-11 12:39:30 +0100
 r8632@Thesaurus (orig r8619):  frew | 2010-02-11 11:53:50 +0100
 fix incorrect test

r8656@Thesaurus (orig r8643):  ribasushi | 2010-02-11 12:39:35 +0100
 r8633@Thesaurus (orig r8620):  frew | 2010-02-11 11:54:49 +0100
 make t/76s and t/88 pass by deleting from the correct attr hash

r8657@Thesaurus (orig r8644):  ribasushi | 2010-02-11 12:39:40 +0100
 r8634@Thesaurus (orig r8621):  frew | 2010-02-11 11:55:41 +0100
 fix a test due to ordering issues

r8658@Thesaurus (orig r8645):  ribasushi | 2010-02-11 12:39:45 +0100
 r8635@Thesaurus (orig r8622):  frew | 2010-02-11 11:58:23 +0100
 this is why you run tests before you commit them.

r8659@Thesaurus (orig r8646):  ribasushi | 2010-02-11 12:39:51 +0100
 r8636@Thesaurus (orig r8623):  frew | 2010-02-11 12:00:59 +0100
 fix another ordering issue

r8660@Thesaurus (orig r8647):  ribasushi | 2010-02-11 12:39:57 +0100
 r8637@Thesaurus (orig r8624):  frew | 2010-02-11 12:11:31 +0100
 fix for search/select_chains

r8661@Thesaurus (orig r8648):  ribasushi | 2010-02-11 12:40:03 +0100

r8662@Thesaurus (orig r8649):  caelum | 2010-02-11 12:40:07 +0100
test nanosecond precision for SQLAnywhere
r8663@Thesaurus (orig r8650):  ribasushi | 2010-02-11 12:40:09 +0100
 r8639@Thesaurus (orig r8626):  ribasushi | 2010-02-11 12:33:03 +0100
 Changes and small ommission

r8666@Thesaurus (orig r8653):  ribasushi | 2010-02-11 18:16:45 +0100
Changes
r8674@Thesaurus (orig r8661):  ribasushi | 2010-02-12 09:12:45 +0100
Fix moose dep
r8680@Thesaurus (orig r8667):  dew | 2010-02-12 18:05:11 +0100
Add is_ordered to DBIC::ResultSet
r8688@Thesaurus (orig r8675):  ribasushi | 2010-02-13 09:36:29 +0100
 r8667@Thesaurus (orig r8654):  ribasushi | 2010-02-11 18:17:35 +0100
 Try a dep-handling idea
 r8675@Thesaurus (orig r8662):  ribasushi | 2010-02-12 12:46:11 +0100
 Move optional deps out of the Makefile
 r8676@Thesaurus (orig r8663):  ribasushi | 2010-02-12 13:40:53 +0100
 Support methods to verify group dependencies
 r8677@Thesaurus (orig r8664):  ribasushi | 2010-02-12 13:45:18 +0100
 Move sqlt dephandling to Optional::Deps
 r8679@Thesaurus (orig r8666):  ribasushi | 2010-02-12 14:03:17 +0100
 Move replicated to Opt::Deps
 r8684@Thesaurus (orig r8671):  ribasushi | 2010-02-13 02:47:52 +0100
 Auto-POD for Optional Deps
 r8685@Thesaurus (orig r8672):  ribasushi | 2010-02-13 02:53:20 +0100
 Privatize the full list method
 r8686@Thesaurus (orig r8673):  ribasushi | 2010-02-13 02:59:51 +0100
 Scary warning
 r8687@Thesaurus (orig r8674):  ribasushi | 2010-02-13 09:35:01 +0100
 Changes

r8691@Thesaurus (orig r8678):  ribasushi | 2010-02-13 10:07:15 +0100
Autogen comment for Dependencies.pod
r8692@Thesaurus (orig r8679):  ribasushi | 2010-02-13 10:11:24 +0100
Ask for newer M::I
r8698@Thesaurus (orig r8685):  ribasushi | 2010-02-13 11:11:10 +0100
Add author/license to pod
r8699@Thesaurus (orig r8686):  arcanez | 2010-02-13 13:43:22 +0100
fix typo per nuba on irc
r8705@Thesaurus (orig r8692):  ribasushi | 2010-02-13 15:15:33 +0100
 r8001@Thesaurus (orig r7989):  goraxe | 2009-11-30 01:14:47 +0100
 Branch for dbicadmin script refactor

 r8003@Thesaurus (orig r7991):  goraxe | 2009-11-30 01:26:39 +0100
 add DBIx::Class::Admin
 r8024@Thesaurus (orig r8012):  goraxe | 2009-12-02 22:49:27 +0100
 get deployment tests to pass
 r8025@Thesaurus (orig r8013):  goraxe | 2009-12-02 22:50:42 +0100
 get deployment tests to pass
 r8026@Thesaurus (orig r8014):  goraxe | 2009-12-02 23:52:40 +0100
 all ddl tests now pass
 r8083@Thesaurus (orig r8071):  goraxe | 2009-12-12 17:01:11 +0100
 add quite attribute to DBIx::Class admin
 r8086@Thesaurus (orig r8074):  goraxe | 2009-12-12 17:36:58 +0100
 add tests for data manipulation ported from 89dbicadmin.t
 r8088@Thesaurus (orig r8076):  goraxe | 2009-12-12 17:38:07 +0100
 add sleep 1 to t/admin/02ddl.t so insert into upgrade table does not happen too quickly
 r8089@Thesaurus (orig r8077):  goraxe | 2009-12-12 17:40:33 +0100
 update DBIx::Class::Admin data manip functions to pass the test
 r8095@Thesaurus (orig r8083):  goraxe | 2009-12-12 19:36:22 +0100
 change passing of preversion to be a parameter
 r8096@Thesaurus (orig r8084):  goraxe | 2009-12-12 19:38:26 +0100
 add some pod to DBIx::Class::Admin
 r8103@Thesaurus (orig r8091):  goraxe | 2009-12-12 22:08:55 +0100
 some changes to make DBIx::Class::Admin more compatible with dbicadmin interface
 r8104@Thesaurus (orig r8092):  goraxe | 2009-12-12 22:09:39 +0100
 commit refactored dbicadmin script and very minor changes to its existing test suite
 r8107@Thesaurus (orig r8095):  goraxe | 2009-12-12 22:34:35 +0100
 add compatability for --op for dbicadmin, revert test suite
 r8127@Thesaurus (orig r8115):  goraxe | 2009-12-15 22:14:20 +0100
 dep check to end of module
 r8128@Thesaurus (orig r8116):  goraxe | 2009-12-15 23:15:25 +0100
 add namespace::autoclean to DBIx::Class::Admin
 r8129@Thesaurus (orig r8117):  goraxe | 2009-12-15 23:16:00 +0100
 update test suite to skip if cannot load DBIx::Class::Admin
 r8130@Thesaurus (orig r8118):  goraxe | 2009-12-15 23:18:35 +0100
 add deps check for 89dbicadmin.t
 r8131@Thesaurus (orig r8119):  goraxe | 2009-12-15 23:19:01 +0100
 include deps for dbicadmin DBIx::Class::Admin to Makefile.PL
 r8149@Thesaurus (orig r8137):  goraxe | 2009-12-17 23:21:50 +0100
 use DBICTest::_database over creating a schema object to steal conn info
 r8338@Thesaurus (orig r8326):  goraxe | 2010-01-15 19:00:17 +0100
 change white space to not be tabs
 r8339@Thesaurus (orig r8327):  goraxe | 2010-01-15 19:10:42 +0100
 remove Module::Load from test suite
 r8358@Thesaurus (orig r8346):  ribasushi | 2010-01-17 17:52:10 +0100
 Real detabify
 r8359@Thesaurus (orig r8347):  ribasushi | 2010-01-17 18:01:53 +0100
 Fix POD (spacing matters)
 r8360@Thesaurus (orig r8348):  ribasushi | 2010-01-17 21:57:53 +0100
 More detabification
 r8361@Thesaurus (orig r8349):  ribasushi | 2010-01-17 22:33:12 +0100
 Test cleanup
 r8362@Thesaurus (orig r8350):  ribasushi | 2010-01-17 22:41:11 +0100
 More tets cleanup
 r8363@Thesaurus (orig r8351):  ribasushi | 2010-01-17 22:43:57 +0100
 And more cleanup
 r8364@Thesaurus (orig r8352):  ribasushi | 2010-01-17 22:51:21 +0100
 Disallow mucking with INC
 r8365@Thesaurus (orig r8353):  ribasushi | 2010-01-17 23:23:15 +0100
 More cleanup
 r8366@Thesaurus (orig r8354):  ribasushi | 2010-01-17 23:27:49 +0100
 Add lib path to ENV so that $^X can see it
 r8367@Thesaurus (orig r8355):  ribasushi | 2010-01-17 23:33:10 +0100
 Move script-test
 r8368@Thesaurus (orig r8356):  goraxe | 2010-01-17 23:35:03 +0100
 change warns/dies -> carp/throw_exception
 r8369@Thesaurus (orig r8357):  goraxe | 2010-01-17 23:53:54 +0100
 add goraxe to contributors
 r8370@Thesaurus (orig r8358):  goraxe | 2010-01-17 23:54:15 +0100
 remove comment headers
 r8404@Thesaurus (orig r8391):  caelum | 2010-01-20 20:54:29 +0100
 minor fixups
 r8405@Thesaurus (orig r8392):  goraxe | 2010-01-20 21:13:24 +0100
 add private types to coerce
 r8406@Thesaurus (orig r8393):  goraxe | 2010-01-20 21:17:19 +0100
 remove un-needed coerce from schema_class of type Str
 r8411@Thesaurus (orig r8398):  caelum | 2010-01-21 23:36:25 +0100
 minor documentation updates
 r8436@Thesaurus (orig r8423):  caelum | 2010-01-25 02:56:30 +0100
 this code never runs anyway
 r8440@Thesaurus (orig r8427):  caelum | 2010-01-26 14:05:53 +0100
 prefer JSON::DWIW for barekey support
 r8693@Thesaurus (orig r8680):  ribasushi | 2010-02-13 10:27:18 +0100
 dbicadmin dependencies
 r8694@Thesaurus (orig r8681):  ribasushi | 2010-02-13 10:28:04 +0100
 Some cleaup, make use of Text::CSV
 r8695@Thesaurus (orig r8682):  ribasushi | 2010-02-13 10:34:19 +0100
 We use Try::Tiny in a single spot, not grounds for inlusion in deps
 r8696@Thesaurus (orig r8683):  ribasushi | 2010-02-13 10:37:30 +0100
 POD section
 r8697@Thesaurus (orig r8684):  ribasushi | 2010-02-13 11:05:17 +0100
 Switch tests to Optional::Deps
 r8700@Thesaurus (orig r8687):  ribasushi | 2010-02-13 14:32:50 +0100
 Switch Admin/dbicadmin to Opt::Deps
 r8702@Thesaurus (orig r8689):  ribasushi | 2010-02-13 14:39:24 +0100
 JSON dep is needed for Admin.pm itself
 r8703@Thesaurus (orig r8690):  ribasushi | 2010-02-13 15:06:28 +0100
 Test fixes
 r8704@Thesaurus (orig r8691):  ribasushi | 2010-02-13 15:13:31 +0100
 Changes

r8707@Thesaurus (orig r8694):  ribasushi | 2010-02-13 16:37:57 +0100
Test for optional deps manager
r8710@Thesaurus (orig r8697):  caelum | 2010-02-14 05:22:03 +0100
add doc on maximum cursors for SQLAnywhere
r8711@Thesaurus (orig r8698):  ribasushi | 2010-02-14 09:23:09 +0100
Cleanup dependencies / Admin inheritance
r8712@Thesaurus (orig r8699):  ribasushi | 2010-02-14 09:28:29 +0100
Some formatting
r8715@Thesaurus (orig r8702):  ribasushi | 2010-02-14 10:46:51 +0100
This is Moose, so use CMOP

lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm
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 26ee0f7..cbf8be4 100644 (file)
@@ -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;
+# 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.
+
+# "$rows" is a bit misleading. In the end, there should only be one
+# element in this arrayref. 
 
-  # 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
-
-  # store just the index so we can check the array positions from the row
-  # without having to contruct the full hash
-
-  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 = keys %{ $self->{_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
index 1b9baa8..9265d32 100644 (file)
@@ -1424,19 +1424,7 @@ 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 ];
@@ -1458,6 +1446,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 fab040e..ff04c68 100644 (file)
@@ -45,7 +45,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;