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
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
"' 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);
# 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};
: [ $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;
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);
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
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
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;
sub _sql_maker_args {
my ($self) = @_;
-
+
return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
}
# 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) = @_;
}
}
- 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;
}
}