Merge 'trunk' into 'grouped_prefetch'
Peter Rabbitson [Tue, 30 Jun 2009 15:39:11 +0000 (15:39 +0000)]
r6844@Thesaurus (orig r6843):  abraxxa | 2009-06-29 11:02:17 +0200
fixed typo in test

r6848@Thesaurus (orig r6847):  ribasushi | 2009-06-29 19:09:00 +0200
Minor Ordered optimization (don't use count)
r6856@Thesaurus (orig r6855):  caelum | 2009-06-29 23:42:11 +0200
 r5451@hlagh (orig r6605):  caelum | 2009-06-10 09:23:44 -0700
 new branch to implement on_connect_call
 r5484@hlagh (orig r6633):  caelum | 2009-06-11 11:03:10 -0700
 on_connect_call implementation and set_datetime_format support for Oracle
 r5492@hlagh (orig r6641):  caelum | 2009-06-11 16:39:28 -0700
 connect_call_set_datetime_format for Oracle, I have no idea why this didn't get committed before...
 r5504@hlagh (orig r6655):  caelum | 2009-06-12 17:28:06 -0700
 finished up on_connect_call stuff
 r5507@hlagh (orig r6658):  caelum | 2009-06-13 04:03:36 -0700
 fixup _setup_connect_do, other minor cleanups
 r5508@hlagh (orig r6659):  caelum | 2009-06-13 04:35:33 -0700
 make the on_(dis)?connect_do accessors returnn the original structure
 r5509@hlagh (orig r6660):  caelum | 2009-06-13 08:31:52 -0700
 allow undef for _setup_connect_do
 r5522@hlagh (orig r6679):  caelum | 2009-06-14 09:56:40 -0700
 rename connect_do store
 r5621@hlagh (orig r6769):  caelum | 2009-06-23 07:38:33 -0700
 minor doc update
 r5628@hlagh (orig r6777):  caelum | 2009-06-23 16:36:12 -0700
 properly test nanosecond precision with oracle and datetime_setup
 r5669@hlagh (orig r6784):  caelum | 2009-06-24 10:49:25 -0700
 IC::DT does support timestamp with timezone
 r5768@hlagh (orig r6846):  caelum | 2009-06-29 08:20:32 -0700
 remove DateTime from 73oracle.t
 r5781@hlagh (orig r6849):  caelum | 2009-06-29 13:07:43 -0700
 remove the _store stuff for on_connect_do
 r5785@hlagh (orig r6853):  ribasushi | 2009-06-29 14:38:30 -0700
 Some beautification

r6871@Thesaurus (orig r6870):  ribasushi | 2009-06-30 10:09:03 +0200
Cleanup dependency handling a bit
r6875@Thesaurus (orig r6874):  ribasushi | 2009-06-30 12:39:06 +0200
Allow broken resultsource-class-derived objects to still work
r6876@Thesaurus (orig r6875):  ribasushi | 2009-06-30 12:40:46 +0200
clarify
r6878@Thesaurus (orig r6877):  ash | 2009-06-30 13:48:13 +0200
Update POD on Dynamic sub-classing

r6883@Thesaurus (orig r6882):  ribasushi | 2009-06-30 17:36:38 +0200
 r6815@Thesaurus (orig r6814):  ribasushi | 2009-06-28 10:32:42 +0200
 Branch to explore double joins on search_related
 r6816@Thesaurus (orig r6815):  ribasushi | 2009-06-28 10:34:16 +0200
 Thetest case that started it all
 r6817@Thesaurus (orig r6816):  ribasushi | 2009-06-28 10:35:11 +0200
 The proposed fix (do not add an extra join if it is already present in the topmost join)
 r6818@Thesaurus (orig r6817):  ribasushi | 2009-06-28 11:04:26 +0200
 Minor omission
 r6819@Thesaurus (orig r6818):  ribasushi | 2009-06-28 11:07:33 +0200
 Adjust a couple of tests for new behavior (thus all of this might be backwards incompatible to the point of being useless):
 The counts in t/90join_torture.t are now 5*3, not 5*3*3, as a second join is not induced by search_related
 The raw sql scan in t/prefetch/standard.t is just silly, won't even try to understand it
 Just to maintain the TreeLike folding, I add a 3rd children join which was inserted by search_related before the code changes

1  2 
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Storage/DBI.pm
t/prefetch/standard.t

@@@ -1243,8 -1243,8 +1243,8 @@@ sub _count_subq_rs 
  
    my $sub_attrs = { %$attrs };
  
 -  # these can not go in the subquery, and there is no point of ordering it
 -  delete $sub_attrs->{$_} for qw/collapse select as order_by/;
 +  # extra selectors do not go in the subquery and there is no point of ordering it
 +  delete $sub_attrs->{$_} for qw/collapse prefetch_select select as order_by/;
  
    # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
    # clobber old group_by regardless
@@@ -1311,12 -1311,13 +1311,12 @@@ sub all 
  
    my @obj;
  
 -  # TODO: don't call resolve here
    if (keys %{$self->_resolved_attrs->{collapse}}) {
 -#  if ($self->{attrs}{prefetch}) {
 -      # 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
 +    # 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
 +    $self->cursor->reset;
      my @row = $self->cursor->next;
      while (@row) {
        push(@obj, $self->_construct_object(@row));
  =back
  
  Resets the resultset's cursor, so you can iterate through the elements again.
 +Implicitly resets the storage cursor, so a subsequent L</next> will trigger
 +another query.
  
  =cut
  
@@@ -2451,7 -2450,7 +2451,7 @@@ sub related_resultset 
          "' has no such relationship $rel")
        unless $rel_info;
  
-     my ($from,$seen) = $self->_resolve_from($rel);
+     my ($from,$seen) = $self->_chain_relationship($rel);
  
      my $join_count = $seen->{$rel};
      my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
@@@ -2549,7 -2548,7 +2549,7 @@@ sub current_source_alias 
  # in order to properly resolve prefetch aliases (any alias
  # with a relation_chain_depth less than the depth of the
  # current prefetch is not considered)
- sub _resolve_from {
+ sub _chain_relationship {
    my ($self, $rel) = @_;
    my $source = $self->result_source;
    my $attrs = $self->{attrs};
    # ->_resolve_join as otherwise they get lost - captainL
    my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
  
-   push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged);
+   my @requested_joins = $source->_resolve_join($merged, $attrs->{alias}, $seen);
+   push @$from, @requested_joins;
  
    ++$seen->{-relation_chain_depth};
  
-   push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+   # if $self already had a join/prefetch specified on it, the requested
+   # $rel might very well be already included. What we do in this case
+   # is effectively a no-op (except that we bump up the chain_depth on
+   # the join in question so we could tell it *is* the search_related)
+   my $already_joined;
+   # we consider the last one thus reverse
+   for my $j (reverse @requested_joins) {
+     if ($rel eq $j->[0]{-join_path}[-1]) {
+       $j->[0]{-relation_chain_depth}++;
+       $already_joined++;
+       last;
+     }
+   }
+   unless ($already_joined) {
+     push @$from, $source->_resolve_join($rel, $attrs->{alias}, $seen);
+   }
  
    ++$seen->{-relation_chain_depth};
  
@@@ -2700,9 -2717,8 +2718,9 @@@ sub _resolved_attrs 
        : [ $attrs->{order_by} ]
      );
    }
 -  else {
 -    $attrs->{order_by} = [];
 +
 +  if ($attrs->{group_by} and ! ref $attrs->{group_by}) {
 +    $attrs->{group_by} = [ $attrs->{group_by} ];
    }
  
    # If the order_by is otherwise empty - we will use this for TOP limit
      my @prefetch =
        $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
  
 -    push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
 -    push( @{ $attrs->{as} },     map { $_->[1] } @prefetch );
 +    $attrs->{prefetch_select} = [ map { $_->[0] } @prefetch ];
 +    push @{ $attrs->{select} }, @{$attrs->{prefetch_select}};
 +    push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
  
      push( @{ $attrs->{order_by} }, @$prefetch_ordering );
      $attrs->{_collapse_order_by} = \@$prefetch_ordering;
@@@ -13,14 -13,15 +13,15 @@@ use Scalar::Util()
  use List::Util();
  
  __PACKAGE__->mk_group_accessors('simple' =>
-     qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
-        _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
+   qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
+      _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
  );
  
  # the values for these accessors are picked out (and deleted) from
  # the attribute hashref passed to connect_info
  my @storage_options = qw/
-   on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
+   on_connect_call on_disconnect_call on_connect_do on_disconnect_do
+   disable_sth_caching unsafe auto_savepoint
  /;
  __PACKAGE__->mk_group_accessors('simple' => @storage_options);
  
@@@ -177,6 -178,91 +178,91 @@@ immediately before disconnecting from t
  Note, this only runs if you explicitly call L</disconnect> on the
  storage object.
  
+ =item on_connect_call
+ A more generalized form of L</on_connect_do> that calls the specified
+ C<connect_call_METHOD> methods in your storage driver.
+   on_connect_do => 'select 1'
+ is equivalent to:
+   on_connect_call => [ [ do_sql => 'select 1' ] ]
+ Its values may contain:
+ =over
+ =item a scalar
+ Will call the C<connect_call_METHOD> method.
+ =item a code reference
+ Will execute C<< $code->($storage) >>
+ =item an array reference
+ Each value can be a method name or code reference.
+ =item an array of arrays
+ For each array, the first item is taken to be the C<connect_call_> method name
+ or code reference, and the rest are parameters to it.
+ =back
+ Some predefined storage methods you may use:
+ =over
+ =item do_sql
+ Executes a SQL string or a code reference that returns a SQL string. This is
+ what L</on_connect_do> and L</on_disconnect_do> use.
+ It can take:
+ =over
+ =item a scalar
+ Will execute the scalar as SQL.
+ =item an arrayref
+ Taken to be arguments to L<DBI/do>, the SQL string optionally followed by the
+ attributes hashref and bind values.
+ =item a code reference
+ Will execute C<< $code->($storage) >> and execute the return array refs as
+ above.
+ =back
+ =item datetime_setup
+ Execute any statements necessary to initialize the database session to return
+ and accept datetime/timestamp values used with
+ L<DBIx::Class::InflateColumn::DateTime>.
+ Only necessary for some databases, see your specific storage driver for
+ implementation details.
+ =back
+ =item on_disconnect_call
+ Takes arguments in the same form as L</on_connect_call> and executes them
+ immediately before disconnecting from the database.
+ Calls the C<disconnect_call_METHOD> methods as opposed to the
+ C<connect_call_METHOD> methods called by L</on_connect_call>.
+ Note, this only runs if you explicitly call L</disconnect> on the
+ storage object.
  =item disable_sth_caching
  
  If set to a true value, this option will disable the caching of
@@@ -359,6 -445,34 +445,34 @@@ sub connect_info 
  
  This method is deprecated in favour of setting via L</connect_info>.
  
+ =cut
+ =head2 on_disconnect_do
+ This method is deprecated in favour of setting via L</connect_info>.
+ =cut
+ sub _parse_connect_do {
+   my ($self, $type) = @_;
+   my $val = $self->$type;
+   return () if not defined $val;
+   my @res;
+   if (not ref($val)) {
+     push @res, [ 'do_sql', $val ];
+   } elsif (ref($val) eq 'CODE') {
+     push @res, $val;
+   } elsif (ref($val) eq 'ARRAY') {
+     push @res, map { [ 'do_sql', $_ ] } @$val;
+   } else {
+     $self->throw_exception("Invalid type for $type: ".ref($val));
+   }
+   return \@res;
+ }
  
  =head2 dbh_do
  
@@@ -506,8 -620,12 +620,12 @@@ sub disconnect 
    my ($self) = @_;
  
    if( $self->connected ) {
-     my $connection_do = $self->on_disconnect_do;
-     $self->_do_connection_actions($connection_do) if ref($connection_do);
+     my @actions;
+     push @actions, ( $self->on_disconnect_call || () );
+     push @actions, $self->_parse_connect_do ('on_disconnect_do');
+     $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
  
      $self->_dbh->rollback unless $self->_dbh_autocommit;
      $self->_dbh->disconnect;
@@@ -594,7 -712,7 +712,7 @@@ sub dbh 
  
  sub _sql_maker_args {
      my ($self) = @_;
-     
      return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
  }
  
@@@ -624,8 -742,12 +742,12 @@@ sub _populate_dbh 
    #  there is no transaction in progress by definition
    $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
  
-   my $connection_do = $self->on_connect_do;
-   $self->_do_connection_actions($connection_do) if $connection_do;
+   my @actions;
+   push @actions, ( $self->on_connect_call || () );
+   push @actions, $self->_parse_connect_do ('on_connect_do');
+   $self->_do_connection_actions(connect_call_ => $_) for @actions;
  }
  
  sub _determine_driver {
  }
  
  sub _do_connection_actions {
-   my $self = shift;
-   my $connection_do = shift;
-   if (!ref $connection_do) {
-     $self->_do_query($connection_do);
-   }
-   elsif (ref $connection_do eq 'ARRAY') {
-     $self->_do_query($_) foreach @$connection_do;
-   }
-   elsif (ref $connection_do eq 'CODE') {
-     $connection_do->($self);
-   }
-   else {
-     $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
+   my $self          = shift;
+   my $method_prefix = shift;
+   my $call          = shift;
+   if (not ref($call)) {
+     my $method = $method_prefix . $call;
+     $self->$method(@_);
+   } elsif (ref($call) eq 'CODE') {
+     $self->$call(@_);
+   } elsif (ref($call) eq 'ARRAY') {
+     if (ref($call->[0]) ne 'ARRAY') {
+       $self->_do_connection_actions($method_prefix, $_) for @$call;
+     } else {
+       $self->_do_connection_actions($method_prefix, @$_) for @$call;
+     }
+   } else {
+     $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
    }
  
    return $self;
  }
  
+ sub connect_call_do_sql {
+   my $self = shift;
+   $self->_do_query(@_);
+ }
+ sub disconnect_call_do_sql {
+   my $self = shift;
+   $self->_do_query(@_);
+ }
+ # override in db-specific backend when necessary
+ sub connect_call_datetime_setup { 1 }
  sub _do_query {
    my ($self, $action) = @_;
  
@@@ -1245,37 -1383,24 +1383,37 @@@ sub _select_args 
      }
    }
  
 -  my @limit;
 -  if ($attrs->{software_limit} ||
 -      $sql_maker->_default_limit_syntax eq "GenericSubQ") {
 -        $attrs->{software_limit} = 1;
 -  } else {
 +  # adjust limits
 +  if (
 +    $attrs->{software_limit}
 +      ||
 +    $sql_maker->_default_limit_syntax eq "GenericSubQ"
 +  ) {
 +    $attrs->{software_limit} = 1;
 +  }
 +  else {
      $self->throw_exception("rows attribute must be positive if present")
        if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
  
      # MySQL actually recommends this approach.  I cringe.
      $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
 +  }
  
 -    if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
 -      ($ident, $select, $where, $attrs)
 -        = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
 -    }
 -    else {
 -      push @limit, $attrs->{rows}, $attrs->{offset};
 -    }
 +  my @limit;
 +
 +  # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
 +  # otherwise delegate the limiting to the storage, unless software limit was requested
 +  if (
 +    ( $attrs->{rows} && keys %{$attrs->{collapse}} )
 +       ||
 +    ( $attrs->{group_by} && @{$attrs->{group_by}} &&
 +      $attrs->{prefetch_select} && @{$attrs->{prefetch_select}} )
 +  ) {
 +    ($ident, $select, $where, $attrs)
 +      = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
 +  }
 +  elsif (! $attrs->{software_limit} ) {
 +    push @limit, $attrs->{rows}, $attrs->{offset};
    }
  
  ###
      (qw/order_by group_by having _virtual_order_by/ )
    };
  
 -
    $sql_maker->{for} = delete $attrs->{for};
  
    return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
  }
  
 -sub _adjust_select_args_for_limited_prefetch {
 +sub _adjust_select_args_for_complex_prefetch {
    my ($self, $from, $select, $where, $attrs) = @_;
  
 -  if ($attrs->{group_by} and @{$attrs->{group_by}}) {
 -    $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a group_by attribute');
 -  }
 +  # copies for mangling
 +  $from = [ @$from ];
 +  $select = [ @$select ];
 +  $attrs = { %$attrs };
  
 -  $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
 +  $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
      if (ref $from ne 'ARRAY');
  
 -
    # separate attributes
    my $sub_attrs = { %$attrs };
 -  delete $attrs->{$_} for qw/where bind rows offset/;
 -  delete $sub_attrs->{$_} for qw/for collapse select order_by/;
 +  delete $attrs->{$_} for qw/where bind rows offset group_by having/;
 +  delete $sub_attrs->{$_} for qw/for collapse prefetch_select _collapse_order_by select as/;
  
    my $alias = $attrs->{alias};
  
 -  # create subquery select list
 -  my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
 +  # create subquery select list - loop only over primary columns
 +  my $sub_select = [];
 +  for my $i (0 .. @{$attrs->{select}} - @{$attrs->{prefetch_select}} - 1) {
 +    my $sel = $attrs->{select}[$i];
 +
 +    # alias any functions to the dbic-side 'as' label
 +    # adjust the outer select accordingly
 +    if (ref $sel eq 'HASH' && !$sel->{-select}) {
 +      $sel = { -select => $sel, -as => $attrs->{as}[$i] };
 +      $select->[$i] = join ('.', $attrs->{alias}, $attrs->{as}[$i]);
 +    }
 +
 +    push @$sub_select, $sel;
 +  }
  
    # bring over all non-collapse-induced order_by into the inner query (if any)
    # the outer one will have to keep them all
 +  delete $sub_attrs->{order_by};
    if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
      $sub_attrs->{order_by} = [
 -      @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
 +      @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
      ];
    }
  
    # mangle {from}
 -  $from = [ @$from ];
    my $select_root = shift @$from;
    my @outer_from = @$from;
  
    # away _any_ branches of the join tree that are:
    # 1) not mentioned in the condition/order
    # 2) left-join leaves (or left-join leaf chains)
 -  # Most of the join ocnditions will not satisfy this, but for real
 +  # Most of the join conditions will not satisfy this, but for real
    # complex queries some might, and we might make some RDBMS happy.
    #
    #
      # the dot comes from some weirdness in collapse
      # remove after the rewrite
      if ($attrs->{collapse}{".$alias"}) {
 -      $sub_attrs->{group_by} = $sub_select;
 +      $sub_attrs->{group_by} ||= $sub_select;
        last;
      }
    }
diff --combined t/prefetch/standard.t
@@@ -1,17 -1,19 +1,17 @@@
  use strict;
- use warnings;  
+ use warnings;
  
  use Test::More;
  use Test::Exception;
  use lib qw(t/lib);
  use DBICTest;
  use Data::Dumper;
 +use IO::File;
  
  my $schema = DBICTest->init_schema();
 -
  my $orig_debug = $schema->storage->debug;
  
 -use IO::File;
 -
 -plan tests => 44;
 +plan tests => 45;
  
  my $queries = 0;
  $schema->storage->debugcb(sub { $queries++; });
@@@ -220,29 -222,11 +220,11 @@@ is(eval { $tree_like->children->first->
  
  $tree_like = eval { $schema->resultset('TreeLike')->search(
      { 'children.id' => 3, 'children_2.id' => 6 }, 
-     { join => [qw/children children/] }
+     { join => [qw/children children children/] }
    )->search_related('children', { 'children_4.id' => 7 }, { prefetch => 'children' }
    )->first->children->first; };
  is(eval { $tree_like->name }, 'fong', 'Tree with multiple has_many joins ok');
  
- # test that collapsed joins don't get a _2 appended to the alias
- my $sql = '';
- $schema->storage->debugcb(sub { $sql = $_[1] });
- $schema->storage->debug(1);
- eval {
-   my $row = $schema->resultset('Artist')->search_related('cds', undef, {
-     join => 'tracks',
-     prefetch => 'tracks',
-   })->search_related('tracks')->first;
- };
- like( $sql, qr/^SELECT tracks_2\.trackid/, "join not collapsed for search_related" );
- $schema->storage->debug($orig_debug);
- $schema->storage->debugobj->callback(undef);
  $rs = $schema->resultset('Artist');
  $rs->create({ artistid => 4, name => 'Unknown singer-songwriter' });
  $rs->create({ artistid => 5, name => 'Emo 4ever' });
@@@ -307,5 -291,3 +289,5 @@@ is($art_rs_pr->search_related('cds')->s
  
  is($queries, 0, 'chained search_related after has_many->has_many prefetch ran no queries');
  
 +$schema->storage->debug($orig_debug);
 +$schema->storage->debugobj->callback(undef);