#
# This module contains code that should never have seen the light of day,
# does not belong in the Storage, or is otherwise unfit for public
-# display. The arrival of SQLA2 should immediately oboslete 90% of this
+# display. The arrival of SQLA2 should immediately obsolete 90% of this
#
use strict;
use List::Util 'first';
use Scalar::Util 'blessed';
+use Sub::Name 'subname';
use namespace::clean;
#
#
# This is the code producing joined subqueries like:
-# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
#
sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
$self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
-
# generate inner/outer attribute lists, remove stuff that doesn't apply
my $outer_attrs = { %$attrs };
delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
- my $inner_attrs = { %$attrs };
- delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range _collapse_order_by select as/;
-
+ my $inner_attrs = { %$attrs, _is_internal_subuery => 1 };
+ delete $inner_attrs->{$_} for qw/for collapse _prefetch_selector_range select as/;
- # bring over all non-collapse-induced order_by into the inner query (if any)
- # the outer one will have to keep them all
- delete $inner_attrs->{order_by};
- if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
- $inner_attrs->{order_by} = [
- @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
- ];
- }
+ # if the user did not request it, there is no point using it inside
+ delete $inner_attrs->{order_by} if delete $inner_attrs->{_order_is_artificial};
# generate the inner/outer select lists
# for inside we consider only stuff *not* brought in by the prefetch
},
-result_source => $rsrc,
-source_alias => $source_alias,
+ -fq_colname => $col eq $colname ? "$source_alias.$col" : $col,
+ -colname => $colname,
};
+
+ $return{"$source_alias.$colname"} = $return{$col} if $col eq $colname;
}
return \%return;
# So it looks like we will have to switch some stuff around.
# local() is useless here as we will be leaving the scope
# anyway, and deep cloning is just too fucking expensive
- # So replace the first hashref in the node arrayref manually
+ # So replace the first hashref in the node arrayref manually
my @new_from = ($from->[0]);
my $sw_idx = { map { (values %$_), 1 } @$switch_branch }; #there's one k/v per join-path
return \@new_from;
}
+# yet another atrocity: attempt to extract all columns from a
+# where condition by hooking _quote
+sub _extract_condition_columns {
+ my ($self, $cond, $sql_maker) = @_;
+
+ return [] unless $cond;
+
+ $sql_maker ||= $self->{_sql_ident_capturer} ||= do {
+ # FIXME - replace with a Moo trait
+ my $orig_sm_class = ref $self->sql_maker;
+ my $smic_class = "${orig_sm_class}::_IdentCapture_";
+
+ unless ($smic_class->isa('SQL::Abstract')) {
+
+ no strict 'refs';
+ *{"${smic_class}::_quote"} = subname "${smic_class}::_quote" => sub {
+ my ($self, $ident) = @_;
+ if (ref $ident eq 'SCALAR') {
+ $ident = $$ident;
+ my $storage_quotes = $self->sql_quote_char || '"';
+ my ($ql, $qr) = map
+ { quotemeta $_ }
+ (ref $storage_quotes eq 'ARRAY' ? @$storage_quotes : ($storage_quotes) x 2 )
+ ;
+
+ while ($ident =~ /
+ $ql (\w+) $qr
+ |
+ ([\w\.]+)
+ /xg) {
+ $self->{_captured_idents}{$1||$2}++;
+ }
+ }
+ else {
+ $self->{_captured_idents}{$ident}++;
+ }
+ return $ident;
+ };
+
+ *{"${smic_class}::_get_captured_idents"} = subname "${smic_class}::_get_captures" => sub {
+ (delete shift->{_captured_idents}) || {};
+ };
+
+ $self->inject_base ($smic_class, $orig_sm_class);
+
+ }
+
+ $smic_class->new();
+ };
+
+ $sql_maker->_recurse_where($cond);
+
+ return [ sort keys %{$sql_maker->_get_captured_idents} ];
+}
+
sub _extract_order_criteria {
my ($self, $order_by, $sql_maker) = @_;
}
}
+sub _order_by_is_stable {
+ my ($self, $ident, $order_by, $where) = @_;
+
+ my $colinfo = $self->_resolve_column_info($ident, [
+ (map { $_->[0] } $self->_extract_order_criteria($order_by)),
+ $where ? @{$self->_extract_fixed_condition_columns($where)} :(),
+ ]);
+
+ return undef unless keys %$colinfo;
+
+ my $cols_per_src;
+ $cols_per_src->{$_->{-source_alias}}{$_->{-colname}} = $_ for values %$colinfo;
+
+ for (values %$cols_per_src) {
+ my $src = (values %$_)[0]->{-result_source};
+ return 1 if $src->_identifying_column_set($_);
+ }
+
+ return undef;
+}
+
+# returns an arrayref of column names which *definitely* have som
+# sort of non-nullable equality requested in the given condition
+# specification. This is used to figure out if a resultset is
+# constrained to a column which is part of a unique constraint,
+# which in turn allows us to better predict how ordering will behave
+# etc.
+#
+# this is a rudimentary, incomplete, and error-prone extractor
+# however this is OK - it is conservative, and if we can not find
+# something that is in fact there - the stack will recover gracefully
+# Also - DQ and the mst it rode in on will save us all RSN!!!
+sub _extract_fixed_condition_columns {
+ my ($self, $where, $nested) = @_;
+
+ return unless ref $where eq 'HASH';
+
+ my @cols;
+ for my $lhs (keys %$where) {
+ if ($lhs =~ /^\-and$/i) {
+ push @cols, ref $where->{$lhs} eq 'ARRAY'
+ ? ( map { $self->_extract_fixed_condition_columns($_, 1) } @{$where->{$lhs}} )
+ : $self->_extract_fixed_condition_columns($where->{$lhs}, 1)
+ ;
+ }
+ elsif ($lhs !~ /^\-/) {
+ my $val = $where->{$lhs};
+
+ push @cols, $lhs if (defined $val and (
+ ! ref $val
+ or
+ (ref $val eq 'HASH' and keys %$val == 1 and defined $val->{'='})
+ ));
+ }
+ }
+ return $nested ? @cols : \@cols;
+}
+
1;