Functional row-parse generator - really works!!!
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index cbf8be4..aa64774 100644 (file)
@@ -14,8 +14,12 @@ use DBIx::Class::ResultSetColumn;
 use DBIx::Class::ResultSourceHandle;
 use List::Util ();
 use Scalar::Util ();
+
 use base qw/DBIx::Class/;
 
+#use Test::Deep::NoTest (qw/eq_deeply/);
+use Data::Dumper::Concise;
+
 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
 
 =head1 NAME
@@ -141,7 +145,7 @@ See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
 =head1 OVERLOADING
 
 If a resultset is used in a numeric context it returns the L</count>.
-However, if it is used in a booleand context it is always true.  So if
+However, if it is used in a boolean context it is always true.  So if
 you want to check if a resultset has any results use C<if $rs != 0>.
 C<if $rs> will always be true.
 
@@ -524,7 +528,7 @@ sub find {
     # in ::Relationship::Base::search_related (the row method), and furthermore
     # the relationship is of the 'single' type. This means that the condition
     # provided by the relationship (already attached to $self) is sufficient,
-    # as there can be only one row in the databse that would satisfy the
+    # as there can be only one row in the database that would satisfy the
     # relationship
   }
   else {
@@ -536,7 +540,7 @@ sub find {
 
   # Run the query
   my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
-  if (keys %{$rs->_resolved_attrs->{collapse}}) {
+  if ($rs->_resolved_attrs->{collapse}) {
     my $row = $rs->next;
     carp "Query returned more than one row" if $rs->next;
     return $row;
@@ -639,7 +643,7 @@ sub search_related {
 =head2 search_related_rs
 
 This method works exactly the same as search_related, except that
-it guarantees a restultset, even in list context.
+it guarantees a resultset, even in list context.
 
 =cut
 
@@ -697,7 +701,7 @@ L<DBIx::Class::ResultSet> returned.
 
 =item B<Note>
 
-As of 0.08100, this method enforces the assumption that the preceeding
+As of 0.08100, this method enforces the assumption that the preceding
 query returns only one row. If more than one row is returned, you will receive
 a warning:
 
@@ -723,7 +727,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'
     );
@@ -752,7 +756,10 @@ sub single {
     $attrs->{where}, $attrs
   );
 
-  return (@data ? ($self->_construct_object(@data))[0] : undef);
+  return @data
+    ? ($self->_construct_objects(@data))[0]
+    : undef
+  ;
 }
 
 
@@ -960,22 +967,99 @@ sub next {
       : $self->cursor->next
   );
   return undef unless (@row);
-  my ($row, @more) = $self->_construct_object(@row);
+  my ($row, @more) = $self->_construct_objects(@row);
   $self->{stashed_objects} = \@more if @more;
   return $row;
 }
 
-sub _construct_object {
+# takes a single DBI-row of data and coinstructs as many objects
+# as the resultset attributes call for.
+# This can be a bit of an action at a distance - it takes as an argument
+# the *current* cursor-row (already taken off the $sth), but if
+# collapsing is requested it will keep advancing the cursor either
+# until the current row-object is assembled (the collapser was able to
+# order the result sensibly) OR until the cursor is exhausted (an
+# unordered collapsing resultset effectively triggers ->all)
+
+# FIXME: why the *FUCK* do we pass around DBI data by copy?! Sadly needs
+# assessment before changing...
+#
+sub _construct_objects {
   my ($self, @row) = @_;
 
-  my $info = $self->_collapse_result($self->{_attrs}{as}, \@row)
+  my $attrs = $self->_resolved_attrs;
+  my $keep_collapsing = $attrs->{collapse};
+
+  my $res_index;
+=begin
+  do {
+    my $me_pref_col = $attrs->{_row_parser}->($row_ref);
+
+    my $container;
+    if ($keep_collapsing) {
+
+      # FIXME - we should be able to remove these 2 checks after the design validates
+      $self->throw_exception ('Collapsing without a top-level collapse-set... can not happen')
+        unless @{$me_ref_col->[2]};
+      $self->throw_exception ('Top-level collapse-set contains a NULL-value... can not happen')
+        if grep { ! defined $_ }  @{$me_pref_col->[2]};
+
+      my $main_ident = join "\x00", @{$me_pref_col->[2]};
+
+      if (! $res_index->{$main_ident}) {
+        # this is where we bail out IFF we are ordered, and the $main_ident changes
+
+        $res_index->{$main_ident} = {
+          all_me_pref => [,
+          index => scalar keys %$res_index,
+        };
+      }
+    }
+
+
+
+      $container = $res_index->{$main_ident}{container};
+    };
+
+    push @$container, [ @{$me_pref_col}[0,1] ];
+
+
+
+  } while (
+    $keep_collapsing
+      &&
+    do { $row_ref = [$self->cursor->next]; $self->{stashed_row} = $row_ref if @$row_ref; scalar @$row_ref }
+  );
+
+  # attempt collapse all rows with same collapse identity
+  if (@to_collapse > 1) {
+    my @collapsed;
+    while (@to_collapse) {
+      $self->_merge_result(\@collapsed, shift @to_collapse);
+    }
+  }
+=cut
+
+  my $mepref_structs = $self->_collapse_result(\@row)
     or return ();
-  my @new = $self->result_class->inflate_result($self->result_source, @$info);
-  @new = $self->{_attrs}{record_filter}->(@new)
-    if exists $self->{_attrs}{record_filter};
-  return @new;
+
+  my $rsrc = $self->result_source;
+  my $res_class = $self->result_class;
+  my $inflator = $res_class->can ('inflate_result');
+
+  my @objs = map {
+    $res_class->$inflator ($rsrc, @$_)
+  } (@$mepref_structs);
+
+  if (my $f = $attrs->{record_filter}) {
+    @objs = map { $f->($_) } @objs;
+  }
+
+  return @objs;
 }
 
+=begin
+
 # 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
@@ -1001,7 +1085,7 @@ sub _collapse_result {
     }
     return undef unless $has_def;
 
-    my $collapse = keys %{ $self->{_attrs}{collapse} || {} };
+    my $collapse = $self->_resolved_attrs->{collapse};
     my $rows     = [];
     my @row      = @$row_ref;
     do {
@@ -1061,18 +1145,115 @@ sub _merge_result {
                 : $rels->{$rel}->[0]
             );
 
-        }
+  my $attrs = $self->_resolved_attrs;
+  my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/};
+
+  # FIXME this is temporary, need to calculate in _resolved_attrs
+  $set_ident ||= { me => [ $self->result_source->_pri_cols ], pref => {} };
+
+  my @cur_row = @$row_ref;
+  my (@to_collapse, $last_ident);
+
+  do {
+    my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) };
+
+    # see if we are switching to another object
+    # this can be turned off and things will still work
+    # since _merge_prefetch knows about _collapse_ident
+#    my $cur_ident = [ @{$row_hr}{@$set_ident} ];
+    my $cur_ident = [];
+    $last_ident ||= $cur_ident;
+
+#    if ($keep_collapsing = Test::Deep::eq_deeply ($cur_ident, $last_ident)) {
+#      push @to_collapse, $self->result_source->_parse_row (
+#        $row_hr,
+#      );
+#    }
+  } while (
+    $keep_collapsing
+      &&
+    do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; }
+  );
 
+  die Dumper \@to_collapse;
+
+
+  # attempt collapse all rows with same collapse identity
+  if (@to_collapse > 1) {
+    my @collapsed;
+    while (@to_collapse) {
+      $self->_merge_result(\@collapsed, shift @to_collapse);
     }
-    else {
-        push( @$rows, $row );
-        return undef;
-    }
+    @to_collapse = @collapsed;
+  }
 
-    return 1;
+  # still didn't fully collapse
+  $self->throw_exception ('Resultset collapse failed (theoretically impossible). Maybe a wrong collapse_ident...?')
+    if (@to_collapse > 1);
+
+  return $to_collapse[0];
 }
 
 
+# two arguments: $as_proto is an arrayref of 'as' column names,
+# $row_ref is an arrayref of the data. 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, which in turn
+# means we need to stash the row for the subsequent ->next call
+sub _collapse_result {
+  my ( $self, $as_proto, $row_ref ) = @_;
+
+  my $attrs = $self->_resolved_attrs;
+  my ($keep_collapsing, $set_ident) = @{$attrs}{qw/collapse _collapse_ident/};
+
+  die Dumper [$as_proto, $row_ref, $keep_collapsing, $set_ident ];
+
+
+  my @cur_row = @$row_ref;
+  my (@to_collapse, $last_ident);
+
+  do {
+    my $row_hr = { map { $as_proto->[$_] => $cur_row[$_] } (0 .. $#$as_proto) };
+
+    # see if we are switching to another object
+    # this can be turned off and things will still work
+    # since _merge_prefetch knows about _collapse_ident
+#    my $cur_ident = [ @{$row_hr}{@$set_ident} ];
+    my $cur_ident = [];
+    $last_ident ||= $cur_ident;
+
+#    if ($keep_collapsing = eq_deeply ($cur_ident, $last_ident)) {
+#      push @to_collapse, $self->result_source->_parse_row (
+#        $row_hr,
+#      );
+#    }
+  } while (
+    $keep_collapsing
+      &&
+    do { @cur_row = $self->cursor->next; $self->{stashed_row} = \@cur_row if @cur_row; }
+  );
+
+  # attempt collapse all rows with same collapse identity
+}
+=cut
+
+# Takes an arrayref of me/pref pairs and a new me/pref pair that should
+# be merged on a preexisting matching me (or should be pushed into $merged
+# as a new me/pref pair for further invocations). It should be possible to
+# use this function to collapse complete ->all results,  provided _collapse_result() is adjusted
+# to provide everything to this sub not to barf when $merged contains more than one 
+# arrayref)
+sub _merge_prefetch {
+  my ($self, $merged, $next_row) = @_;
+
+  unless (@$merged) {
+    push @$merged, $next_row;
+    return;
+  }
+
+}
+
 =head2 result_source
 
 =over 4
@@ -1112,6 +1293,7 @@ sub result_class {
   if ($result_class) {
     $self->ensure_class_loaded($result_class);
     $self->_result_class($result_class);
+    $self->{attrs}{result_class} = $result_class if ref $self;
   }
   $self->_result_class;
 }
@@ -1236,11 +1418,11 @@ 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}}  ) {
-    $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
+  if ( $attrs->{collapse}  ) {
+    $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ]
   }
 
-  $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
+  $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $attrs);
 
   # this is so that the query can be simplified e.g.
   # * ordering can be thrown away in things like Top limit
@@ -1302,30 +1484,32 @@ sub all {
       $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
   }
 
-  return @{ $self->get_cache } if $self->get_cache;
+  if (my $c = $self->get_cache) {
+    return @$c;
+  }
 
-  my @obj;
+  my @objects;
 
-  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
-    # _construct_object to survive the approach
+    # _construct_objects to survive the approach
     $self->cursor->reset;
     my @row = $self->cursor->next;
     while (@row) {
-      push(@obj, $self->_construct_object(@row));
+      push(@objects, $self->_construct_objects(@row));
       @row = (exists $self->{stashed_row}
                ? @{delete $self->{stashed_row}}
                : $self->cursor->next);
     }
   } else {
-    @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
+    @objects = map { $self->_construct_objects($_) } $self->cursor->all;
   }
 
-  $self->set_cache(\@obj) if $self->{attrs}{cache};
+  $self->set_cache(\@objects) if $self->{attrs}{cache};
 
-  return @obj;
+  return @objects;
 }
 
 =head2 reset
@@ -1396,7 +1580,7 @@ sub _rs_update_delete {
     my $attrs = $self->_resolved_attrs_copy;
 
     delete $attrs->{$_} for qw/collapse select as/;
-    $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ];
+    $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
 
     if ($needs_group_by_subq) {
       # make sure no group_by was supplied, or if there is one - make sure it matches
@@ -1573,7 +1757,7 @@ Example:  Assuming an Artist Class that has many CDs Classes relating:
       ],
      },
      { artistid => 5, name => 'Angsty-Whiny Girl', cds => [
-        { title => 'My parents sold me to a record company' ,year => 2005 },
+        { title => 'My parents sold me to a record company', year => 2005 },
         { title => 'Why Am I So Ugly?', year => 2006 },
         { title => 'I Got Surgery and am now Popular', year => 2007 }
       ],
@@ -1601,7 +1785,7 @@ example:
     [qw/artistid name/],
     [100, 'A Formally Unknown Singer'],
     [101, 'A singer that jumped the shark two albums ago'],
-    [102, 'An actually cool singer.'],
+    [102, 'An actually cool singer'],
   ]);
 
 Please note an important effect on your data when choosing between void and
@@ -2108,7 +2292,7 @@ To create related objects, pass a hashref of related-object column values
 B<keyed on the relationship name>. If the relationship is of type C<multi>
 (L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
 The process will correctly identify columns holding foreign keys, and will
-transparrently populate them from the keys of the corresponding relation.
+transparently populate them from the keys of the corresponding relation.
 This can be applied recursively, and will work correctly for a structure
 with an arbitrary depth and width, as long as the relationships actually
 exists and the correct column data has been supplied.
@@ -2841,7 +3025,6 @@ sub _resolved_attrs {
     }
   }
   else {
-
     # otherwise we intialise select & as to empty
     $attrs->{select} = [];
     $attrs->{as}     = [];
@@ -2931,11 +3114,9 @@ sub _resolved_attrs {
     }
   }
 
-  $attrs->{collapse} ||= {};
+  # generate selections based on the prefetch helper
   if ( my $prefetch = delete $attrs->{prefetch} ) {
-    $prefetch = $self->_merge_attr( {}, $prefetch );
-
-    my $prefetch_ordering = [];
+    $attrs->{collapse} = 1;
 
     # this is a separate structure (we don't look in {from} directly)
     # as the resolver needs to shift things off the lists to work
@@ -2958,19 +3139,46 @@ 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 );
 
     # we need to somehow mark which columns came from prefetch
     $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
 
     push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
+  }
+
+  # run through the resulting joinstructure (starting from our current slot)
+  # and unset collapse if proven unnesessary
+  if ($attrs->{collapse} && ref $attrs->{from} eq 'ARRAY') {
 
-    push( @{$attrs->{order_by}}, @$prefetch_ordering );
-    $attrs->{_collapse_order_by} = \@$prefetch_ordering;
+    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);
+      }
+
+      for (@fromlist) {
+        $attrs->{collapse} = ! $_->[0]{-is_single}
+          and last;
+      }
+    }
+    else {
+      # no joins - no collapse
+      $attrs->{collapse} = 0;
+    }
   }
 
+  # the row parser generates differently depending on whether collapsing is requested
+  # the need to look at {select} is temporary
+  $attrs->{_row_parser} = $source->_mk_row_parser (
+    @{$attrs}{qw/as collapse select/}
+  );
+
   # 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
@@ -3305,7 +3513,7 @@ attempting to use the accessor in an C<order_by> clause or similar
 will fail miserably.
 
 To get around this limitation, you can supply literal SQL to your
-C<select> attibute that contains the C<AS alias> text, eg:
+C<select> attribute that contains the C<AS alias> text, e.g.
 
   select => [\'myfield AS alias']
 
@@ -3416,7 +3624,7 @@ for a C<join> attribute in the above search.
 C<prefetch> can be used with the following relationship types: C<belongs_to>,
 C<has_one> (or if you're using C<add_relationship>, any relationship declared
 with an accessor type of 'single' or 'filter'). A more complex example that
-prefetches an artists cds, the tracks on those cds, and the tags associted
+prefetches an artists cds, the tracks on those cds, and the tags associated
 with that artist is given below (assuming many-to-many from artists to tags):
 
  my $rs = $schema->resultset('Artist')->search(
@@ -3495,7 +3703,7 @@ C<total_entries> on it.
 
 =back
 
-Specifes the maximum number of rows for direct retrieval or the number of
+Specifies the maximum number of rows for direct retrieval or the number of
 rows per page if the page attribute or method is used.
 
 =head2 offset