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 _on_connect_do
- _on_disconnect_do _on_connect_do_store _on_disconnect_do_store
- 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_call on_disconnect_call 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);
$self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
}
}
- for my $connect_do_opt (qw/on_connect_do on_disconnect_do/) {
- if(my $opt_val = delete $attrs{$connect_do_opt}) {
- $self->$connect_do_opt($opt_val);
- }
- }
}
%attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case
=cut
-sub on_connect_do {
- my $self = shift;
- $self->_setup_connect_do(on_connect_do => @_);
-}
-
=head2 on_disconnect_do
This method is deprecated in favour of setting via L</connect_info>.
=cut
-sub on_disconnect_do {
- my $self = shift;
- $self->_setup_connect_do(on_disconnect_do => @_);
-}
-
-sub _setup_connect_do {
- my ($self, $opt) = (shift, shift);
+sub _parse_connect_do {
+ my ($self, $type) = @_;
- my $accessor = "_$opt";
- my $store = "_${opt}_store";
+ my $val = $self->$type;
+ return () if not defined $val;
- return $self->$accessor if not @_;
-
- my $val = shift;
-
- if (not defined $val) {
- $self->$accessor(undef);
- $self->$store(undef);
- return;
- }
-
- my @store;
+ my @res;
if (not ref($val)) {
- push @store, [ 'do_sql', $val ];
+ push @res, [ 'do_sql', $val ];
} elsif (ref($val) eq 'CODE') {
- push @store, $val;
+ push @res, $val;
} elsif (ref($val) eq 'ARRAY') {
- push @store, map [ 'do_sql', $_ ], @$val;
+ push @res, map { [ 'do_sql', $_ ] } @$val;
} else {
- $self->throw_exception("Invalid type for $opt ".ref($val));
+ $self->throw_exception("Invalid type for $type: ".ref($val));
}
- $self->$store(\@store);
- $self->$accessor($val);
+ return \@res;
}
=head2 dbh_do
my ($self) = @_;
if( $self->connected ) {
- if (my $connection_call = $self->on_disconnect_call) {
- $self->_do_connection_actions(disconnect_call_ => $connection_call)
- }
- if (my $connection_do = $self->_on_disconnect_do_store) {
- $self->_do_connection_actions(disconnect_call_ => $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;
- if (my $connection_call = $self->on_connect_call) {
- $self->_do_connection_actions(connect_call_ => $connection_call)
- }
- if (my $connection_do = $self->_on_connect_do_store) {
- $self->_do_connection_actions(connect_call_ => $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 {
}
}
- 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}
+ my $select_root = shift @$from;
+ my @outer_from = @$from;
- # mangle the head of the {from}
- my $self_ident = shift @$from;
-
+ my %inner_joins;
my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
- my (%inner_joins);
+ # in complex search_related chains $alias may *not* be 'me'
+ # so always include it in the inner join, and also shift away
+ # from the outer stack, so that the two datasets actually do
+ # meet
+ if ($select_root->{-alias} ne $alias) {
+ $inner_joins{$alias} = 1;
+
+ while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
+ shift @outer_from;
+ }
+ if (! @outer_from) {
+ $self->throw_exception ("Unable to find '$alias' in the {from} stack, something is wrong");
+ }
+
+ shift @outer_from; # the new subquery will represent this alias, so get rid of it
+ }
+
# decide which parts of the join will remain on the inside
#
# 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.
#
#
}
# construct the inner $from for the subquery
- my $inner_from = [ $self_ident ];
- if (keys %inner_joins) {
- for my $j (@$from) {
- push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
- }
+ my $inner_from = [ $select_root ];
+ for my $j (@$from) {
+ push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+ }
- # if a multi-type join was needed in the subquery ("multi" is indicated by
- # presence in {collapse}) - add a group_by to simulate the collapse in the subq
- for my $alias (keys %inner_joins) {
+ # if a multi-type join was needed in the subquery ("multi" is indicated by
+ # presence in {collapse}) - add a group_by to simulate the collapse in the subq
- # the dot comes from some weirdness in collapse
- # remove after the rewrite
- if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} = $sub_select;
- last;
- }
+ for my $alias (keys %inner_joins) {
+
+ # the dot comes from some weirdness in collapse
+ # remove after the rewrite
+ if ($attrs->{collapse}{".$alias"}) {
+ $sub_attrs->{group_by} ||= $sub_select;
+ last;
}
}
$sub_attrs
);
- # put it back in $from
- unshift @$from, { $alias => $subq };
+ # put it in the new {from}
+ unshift @outer_from, { $alias => $subq };
# This is totally horrific - the $where ends up in both the inner and outer query
# Unfortunately not much can be done until SQLA2 introspection arrives
#
# OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
- return ($from, $select, $where, $attrs);
+ return (\@outer_from, $select, $where, $attrs);
}
sub _resolve_ident_sources {
return $alias2source;
}
-sub count {
- my ($self, $source, $attrs) = @_;
-
- my $tmp_attrs = { %$attrs };
-
- # take off any limits, record_filter is cdbi, and no point of ordering a count
- delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/);
-
- # overwrite the selector
- $tmp_attrs->{select} = { count => '*' };
-
- my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs);
- my ($count) = $tmp_rs->cursor->next;
-
- # if the offset/rows attributes are still present, we did not use
- # a subquery, so we need to make the calculations in software
- $count -= $attrs->{offset} if $attrs->{offset};
- $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count;
- $count = 0 if ($count < 0);
-
- return $count;
-}
-
-sub count_grouped {
- my ($self, $source, $attrs) = @_;
-
- # copy for the subquery, we need to do some adjustments to it too
- 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/;
-
- # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
- # simply deleting group_by suffices, as the code below will re-fill it
- # Note: we check $attrs, as $sub_attrs has collapse deleted
- if (ref $attrs->{collapse} and keys %{$attrs->{collapse}} ) {
- delete $sub_attrs->{group_by};
- }
-
- $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ];
- $sub_attrs->{select} = $self->_grouped_count_select ($source, $sub_attrs);
-
- $attrs->{from} = [{
- count_subq => $source->resultset_class->new ($source, $sub_attrs )->as_query
- }];
-
- # the subquery replaces this
- delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/;
-
- return $self->count ($source, $attrs);
+# Returns a counting SELECT for a simple count
+# query. Abstracted so that a storage could override
+# this to { count => 'firstcol' } or whatever makes
+# sense as a performance optimization
+sub _count_select {
+ #my ($self, $source, $rs_attrs) = @_;
+ return { count => '*' };
}
+# Returns a SELECT which will end up in the subselect
+# There may or may not be a group_by, as the subquery
+# might have been called to accomodate a limit
#
-# Returns a SELECT to go with a supplied GROUP BY
-# (caled by count_grouped so a group_by is present)
-# Most databases expect them to match, but some
-# choke in various ways.
+# Most databases would be happy with whatever ends up
+# here, but some choke in various ways.
#
-sub _grouped_count_select {
- my ($self, $source, $rs_args) = @_;
- return $rs_args->{group_by};
+sub _subq_count_select {
+ my ($self, $source, $rs_attrs) = @_;
+ return $rs_attrs->{group_by} if $rs_attrs->{group_by};
+
+ my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
+ return @pcols ? \@pcols : [ 1 ];
}
+
sub source_bind_attributes {
my ($self, $source) = @_;
-
+
my $bind_attributes;
foreach my $column ($source->columns) {
-
+
my $data_type = $source->column_info($column)->{data_type} || '';
$bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
if $data_type;
projects / dbsrgits/DBIx-Class-Historic.git / blobdiff