X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker%2FLimitDialects.pm;h=0e6eb7e999a729dba731fb19f8b0914060a78562;hb=02562a2092543488bba4ccd98c39abca72560555;hp=6ec33d5782367cd81e274ece907d1f76b086adf8;hpb=96eacdb705e37cca2a5a420ec92e353d0d8823b9;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker/LimitDialects.pm b/lib/DBIx/Class/SQLMaker/LimitDialects.pm index 6ec33d5..0e6eb7e 100644 --- a/lib/DBIx/Class/SQLMaker/LimitDialects.pm +++ b/lib/DBIx/Class/SQLMaker/LimitDialects.pm @@ -3,8 +3,16 @@ package DBIx::Class::SQLMaker::LimitDialects; use warnings; use strict; -use List::Util 'first'; -use namespace::clean; +# constants are used not only here, but also in comparison tests +sub __rows_bindtype () { + +{ sqlt_datatype => 'integer' } +} +sub __offset_bindtype () { + +{ sqlt_datatype => 'integer' } +} +sub __total_bindtype () { + +{ sqlt_datatype => 'integer' } +} =head1 NAME @@ -30,8 +38,6 @@ names. Currently the provided dialects are: -=cut - =head2 LimitOffset SELECT ... LIMIT $limit OFFSET $offset @@ -40,24 +46,33 @@ Supported by B and B =cut sub _LimitOffset { - my ( $self, $sql, $order, $rows, $offset ) = @_; - $sql .= $self->_order_by( $order ) . " LIMIT $rows"; - $sql .= " OFFSET $offset" if +$offset; + my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; + $sql .= $self->_parse_rs_attrs( $rs_attrs ) . " LIMIT ?"; + push @{$self->{limit_bind}}, [ $self->__rows_bindtype => $rows ]; + if ($offset) { + $sql .= " OFFSET ?"; + push @{$self->{limit_bind}}, [ $self->__offset_bindtype => $offset ]; + } return $sql; } =head2 LimitXY - SELECT ... LIMIT $offset $limit + SELECT ... LIMIT $offset, $limit Supported by B and any L based DBD =cut sub _LimitXY { - my ( $self, $sql, $order, $rows, $offset ) = @_; - $sql .= $self->_order_by( $order ) . " LIMIT "; - $sql .= "$offset, " if +$offset; - $sql .= $rows; + my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; + $sql .= $self->_parse_rs_attrs( $rs_attrs ) . " LIMIT "; + if ($offset) { + $sql .= '?, '; + push @{$self->{limit_bind}}, [ $self->__offset_bindtype => $offset ]; + } + $sql .= '?'; + push @{$self->{limit_bind}}, [ $self->__rows_bindtype => $rows ]; + return $sql; } @@ -77,39 +92,36 @@ B<< MSSQL >= 2005 >>. sub _RowNumberOver { my ($self, $sql, $rs_attrs, $rows, $offset ) = @_; - # mangle the input sql as we will be replacing the selector - $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix - or $self->throw_exception("Unrecognizable SELECT: $sql"); - # get selectors, and scan the order_by (if any) - my ($in_sel, $out_sel, $alias_map, $extra_order_sel) - = $self->_subqueried_limit_attrs ( $rs_attrs ); + my $sq_attrs = $self->_subqueried_limit_attrs ( $sql, $rs_attrs ); # make up an order if none exists my $requested_order = (delete $rs_attrs->{order_by}) || $self->_rno_default_order; + + # the order binds (if any) will need to go at the end of the entire inner select + local $self->{order_bind}; my $rno_ord = $self->_order_by ($requested_order); + push @{$self->{select_bind}}, @{$self->{order_bind}}; # this is the order supplement magic - my $mid_sel = $out_sel; - if ($extra_order_sel) { + my $mid_sel = $sq_attrs->{selection_outer}; + if (my $extra_order_sel = $sq_attrs->{order_supplement}) { for my $extra_col (sort { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } keys %$extra_order_sel ) { - $in_sel .= sprintf (', %s AS %s', + $sq_attrs->{selection_inner} .= sprintf (', %s AS %s', $extra_col, $extra_order_sel->{$extra_col}, ); - - $mid_sel .= ', ' . $extra_order_sel->{$extra_col}; } } # and this is order re-alias magic - for ($extra_order_sel, $alias_map) { - for my $col (keys %$_) { + for my $map ($sq_attrs->{order_supplement}, $sq_attrs->{outer_renames}) { + for my $col (sort { (length $b) <=> (length $a) } keys %{$map||{}} ) { my $re_col = quotemeta ($col); - $rno_ord =~ s/$re_col/$_->{$col}/; + $rno_ord =~ s/$re_col/$map->{$col}/; } } @@ -119,17 +131,18 @@ sub _RowNumberOver { my $qalias = $self->_quote ($rs_attrs->{alias}); my $idx_name = $self->_quote ('rno__row__index'); - $sql = sprintf (<{limit_bind}}, [ $self->__offset_bindtype => $offset + 1], [ $self->__total_bindtype => $offset + $rows ]; -SELECT $out_sel FROM ( + return <{selection_outer} FROM ( SELECT $mid_sel, ROW_NUMBER() OVER( $rno_ord ) AS $idx_name FROM ( - SELECT $in_sel ${sql}${group_having} + SELECT $sq_attrs->{selection_inner} $sq_attrs->{query_leftover}${group_having} ) $qalias -) $qalias WHERE $idx_name BETWEEN %u AND %u +) $qalias WHERE $idx_name >= ? AND $idx_name <= ? EOS - return $sql; } # some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) ) @@ -141,7 +154,7 @@ sub _rno_default_order { SELECT SKIP $offset FIRST $limit * FROM ... -Suported by B, almost like LimitOffset. According to +Supported by B, almost like LimitOffset. According to L C<... SKIP $offset LIMIT $limit ...> is also supported. =cut @@ -153,10 +166,16 @@ sub _SkipFirst { return sprintf ('SELECT %s%s%s%s', $offset - ? sprintf ('SKIP %u ', $offset) + ? do { + push @{$self->{pre_select_bind}}, [ $self->__offset_bindtype => $offset]; + 'SKIP ? ' + } : '' , - sprintf ('FIRST %u ', $rows), + do { + push @{$self->{pre_select_bind}}, [ $self->__rows_bindtype => $rows ]; + 'FIRST ? ' + }, $sql, $self->_parse_rs_attrs ($rs_attrs), ); @@ -177,9 +196,15 @@ sub _FirstSkip { or $self->throw_exception("Unrecognizable SELECT: $sql"); return sprintf ('SELECT %s%s%s%s', - sprintf ('FIRST %u ', $rows), + do { + push @{$self->{pre_select_bind}}, [ $self->__rows_bindtype => $rows ]; + 'FIRST ? ' + }, $offset - ? sprintf ('SKIP %u ', $offset) + ? do { + push @{$self->{pre_select_bind}}, [ $self->__offset_bindtype => $offset]; + 'SKIP ? ' + } : '' , $sql, @@ -187,137 +212,188 @@ sub _FirstSkip { ); } + =head2 RowNum +Depending on the resultset attributes one of: + SELECT * FROM ( - SELECT *, ROWNUM rownum__index FROM ( + SELECT *, ROWNUM AS rownum__index FROM ( SELECT ... ) WHERE ROWNUM <= ($limit+$offset) ) WHERE rownum__index >= ($offset+1) +or + + SELECT * FROM ( + SELECT *, ROWNUM AS rownum__index FROM ( + SELECT ... + ) + ) WHERE rownum__index BETWEEN ($offset+1) AND ($limit+$offset) + +or + + SELECT * FROM ( + SELECT ... + ) WHERE ROWNUM <= ($limit+1) + Supported by B. =cut sub _RowNum { my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; - # mangle the input sql as we will be replacing the selector - $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix - or $self->throw_exception("Unrecognizable SELECT: $sql"); - - my ($insel, $outsel) = $self->_subqueried_limit_attrs ($rs_attrs); + my $sq_attrs = $self->_subqueried_limit_attrs ($sql, $rs_attrs); my $qalias = $self->_quote ($rs_attrs->{alias}); my $idx_name = $self->_quote ('rownum__index'); my $order_group_having = $self->_parse_rs_attrs($rs_attrs); - if ($offset) { - $sql = sprintf (<{limit_bind}}, [ $self->__rows_bindtype => $rows ]; -SELECT $outsel FROM ( - SELECT $outsel, ROWNUM $idx_name FROM ( - SELECT $insel ${sql}${order_group_having} - ) $qalias WHERE ROWNUM <= %u -) $qalias WHERE $idx_name >= %u + return <{selection_outer} FROM ( + SELECT $sq_attrs->{selection_inner} $sq_attrs->{query_leftover}${order_group_having} +) $qalias WHERE ROWNUM <= ? +EOS + } + # + # There are two ways to limit in Oracle, one vastly faster than the other + # on large resultsets: https://decipherinfosys.wordpress.com/2007/08/09/paging-and-countstopkey-optimization/ + # However Oracle is retarded and does not preserve stable ROWNUM() values + # when called twice in the same scope. Therefore unless the resultset is + # ordered by a unique set of columns, it is not safe to use the faster + # method, and the slower BETWEEN query is used instead + # + # FIXME - this is quite expensive, and does not perform caching of any sort + # as soon as some of the SQLA-inlining work becomes viable consider adding + # some rudimentary caching support + if ( + $rs_attrs->{order_by} + and + $rs_attrs->{result_source}->schema->storage->_order_by_is_stable( + @{$rs_attrs}{qw/from order_by where/} + ) + ) { + push @{$self->{limit_bind}}, [ $self->__total_bindtype => $offset + $rows ], [ $self->__offset_bindtype => $offset + 1 ]; + + return <{selection_outer} FROM ( + SELECT $sq_attrs->{selection_outer}, ROWNUM AS $idx_name FROM ( + SELECT $sq_attrs->{selection_inner} $sq_attrs->{query_leftover}${order_group_having} + ) $qalias WHERE ROWNUM <= ? +) $qalias WHERE $idx_name >= ? EOS } else { - $sql = sprintf (<{limit_bind}}, [ $self->__offset_bindtype => $offset + 1 ], [ $self->__total_bindtype => $offset + $rows ]; + return <{selection_outer} FROM ( + SELECT $sq_attrs->{selection_outer}, ROWNUM AS $idx_name FROM ( + SELECT $sq_attrs->{selection_inner} $sq_attrs->{query_leftover}${order_group_having} + ) $qalias +) $qalias WHERE $idx_name BETWEEN ? AND ? EOS } - - return $sql; } -# used by _Top and _FetchFirst +# used by _Top and _FetchFirst below sub _prep_for_skimming_limit { my ( $self, $sql, $rs_attrs ) = @_; - # mangle the input sql as we will be replacing the selector - $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix - or $self->throw_exception("Unrecognizable SELECT: $sql"); - - my %r = ( inner_sql => $sql ); - # get selectors - my ($alias_map, $extra_order_sel); - ($r{in_sel}, $r{out_sel}, $alias_map, $extra_order_sel) - = $self->_subqueried_limit_attrs ($rs_attrs); + my $sq_attrs = $self->_subqueried_limit_attrs ($sql, $rs_attrs); my $requested_order = delete $rs_attrs->{order_by}; - $r{order_by_requested} = $self->_order_by ($requested_order); - - # make up an order unless supplied - my $inner_order = ($r{order_by_requested} - ? $requested_order - : [ map - { "$rs_attrs->{alias}.$_" } - ( $rs_attrs->{_rsroot_rsrc}->_pri_cols ) - ] - ); + $sq_attrs->{order_by_requested} = $self->_order_by ($requested_order); + $sq_attrs->{grpby_having} = $self->_parse_rs_attrs ($rs_attrs); - # localise as we already have all the bind values we need - { + # without an offset things are easy + if (! $rs_attrs->{offset}) { + $sq_attrs->{order_by_inner} = $sq_attrs->{order_by_requested}; + } + else { + $sq_attrs->{quoted_rs_alias} = $self->_quote ($rs_attrs->{alias}); + + # localise as we already have all the bind values we need local $self->{order_bind}; - $r{order_by_inner} = $self->_order_by ($inner_order); + + # make up an order unless supplied or sanity check what we are given + my $inner_order; + if ($sq_attrs->{order_by_requested}) { + $self->throw_exception ( + 'Unable to safely perform "skimming type" limit with supplied unstable order criteria' + ) unless ($rs_attrs->{result_source}->schema->storage->_order_by_is_stable( + $rs_attrs->{from}, + $requested_order, + $rs_attrs->{where}, + )); + + $inner_order = $requested_order; + } + else { + $inner_order = [ map + { "$rs_attrs->{alias}.$_" } + ( @{ + $rs_attrs->{result_source}->_identifying_column_set + || + $self->throw_exception(sprintf( + 'Unable to auto-construct stable order criteria for "skimming type" limit ' + . "dialect based on source '%s'", $rs_attrs->{result_source}->name) ); + } ) + ]; + } + + $sq_attrs->{order_by_inner} = $self->_order_by ($inner_order); my @out_chunks; for my $ch ($self->_order_by_chunks ($inner_order)) { $ch = $ch->[0] if ref $ch eq 'ARRAY'; - $ch =~ s/\s+ ( ASC|DESC ) \s* $//ix; - my $dir = uc ($1||'ASC'); + ($ch, my $is_desc) = $self->_split_order_chunk($ch); - push @out_chunks, \join (' ', $ch, $dir eq 'ASC' ? 'DESC' : 'ASC' ); + # !NOTE! outside chunks come in reverse order ( !$is_desc ) + push @out_chunks, { ($is_desc ? '-asc' : '-desc') => \$ch }; } - $r{order_by_reversed} = $self->_order_by (\@out_chunks); - } - - # this is the order supplement magic - $r{mid_sel} = $r{out_sel}; - if ($extra_order_sel) { - for my $extra_col (sort - { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } - keys %$extra_order_sel - ) { - $r{in_sel} .= sprintf (', %s AS %s', - $extra_col, - $extra_order_sel->{$extra_col}, - ); - - $r{mid_sel} .= ', ' . $extra_order_sel->{$extra_col}; + $sq_attrs->{order_by_middle} = $self->_order_by (\@out_chunks); + + # this is the order supplement magic + $sq_attrs->{selection_middle} = $sq_attrs->{selection_outer}; + if (my $extra_order_sel = $sq_attrs->{order_supplement}) { + for my $extra_col (sort + { $extra_order_sel->{$a} cmp $extra_order_sel->{$b} } + keys %$extra_order_sel + ) { + $sq_attrs->{selection_inner} .= sprintf (', %s AS %s', + $extra_col, + $extra_order_sel->{$extra_col}, + ); + + $sq_attrs->{selection_middle} .= ', ' . $extra_order_sel->{$extra_col}; + } + + # Whatever order bindvals there are, they will be realiased and + # reselected, and need to show up at end of the initial inner select + push @{$self->{select_bind}}, @{$self->{order_bind}}; } - # since whatever order bindvals there are, they will be realiased - # and need to show up in front of the entire initial inner subquery - # *unshift* the selector bind stack to make this happen (horrible, - # horrible, but we don't have another mechanism yet) - unshift @{$self->{select_bind}}, @{$self->{order_bind}}; - } - - # and this is order re-alias magic - for my $map ($extra_order_sel, $alias_map) { - for my $col (keys %$map) { - my $re_col = quotemeta ($col); - $_ =~ s/$re_col/$map->{$col}/ - for ($r{order_by_reversed}, $r{order_by_requested}); + # and this is order re-alias magic + for my $map ($sq_attrs->{order_supplement}, $sq_attrs->{outer_renames}) { + for my $col (sort { (length $b) <=> (length $a) } keys %{$map||{}}) { + my $re_col = quotemeta ($col); + $_ =~ s/$re_col/$map->{$col}/ + for ($sq_attrs->{order_by_middle}, $sq_attrs->{order_by_requested}); + } } } - # generate the rest of the sql - $r{grpby_having} = $self->_parse_rs_attrs ($rs_attrs); - - $r{quoted_rs_alias} = $self->_quote ($rs_attrs->{alias}); - - \%r; + $sq_attrs; } =head2 Top @@ -342,31 +418,32 @@ when $limit+$offset > total amount of rows in the resultset. sub _Top { my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; - my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; + my $lim = $self->_prep_for_skimming_limit($sql, $rs_attrs); $sql = sprintf ('SELECT TOP %u %s %s %s %s', $rows + ($offset||0), - $l{in_sel}, - $l{inner_sql}, - $l{grpby_having}, - $l{order_by_inner}, + $offset ? $lim->{selection_inner} : $lim->{selection_original}, + $lim->{query_leftover}, + $lim->{grpby_having}, + $lim->{order_by_inner}, ); $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', $rows, - $l{mid_sel}, + $lim->{selection_middle}, $sql, - $l{quoted_rs_alias}, - $l{order_by_reversed}, + $lim->{quoted_rs_alias}, + $lim->{order_by_middle}, ) if $offset; - $sql = sprintf ('SELECT TOP %u %s FROM ( %s ) %s %s', - $rows, - $l{out_sel}, + $sql = sprintf ('SELECT %s FROM ( %s ) %s %s', + $lim->{selection_outer}, $sql, - $l{quoted_rs_alias}, - $l{order_by_requested}, - ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); + $lim->{quoted_rs_alias}, + $lim->{order_by_requested}, + ) if $offset and ( + $lim->{order_by_requested} or $lim->{selection_middle} ne $lim->{selection_outer} + ); return $sql; } @@ -396,61 +473,37 @@ when $limit+$offset > total amount of rows in the resultset. sub _FetchFirst { my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_; - my %l = %{ $self->_prep_for_skimming_limit($sql, $rs_attrs) }; + my $lim = $self->_prep_for_skimming_limit($sql, $rs_attrs); $sql = sprintf ('SELECT %s %s %s %s FETCH FIRST %u ROWS ONLY', - $l{in_sel}, - $l{inner_sql}, - $l{grpby_having}, - $l{order_by_inner}, + $offset ? $lim->{selection_inner} : $lim->{selection_original}, + $lim->{query_leftover}, + $lim->{grpby_having}, + $lim->{order_by_inner}, $rows + ($offset||0), ); $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', - $l{mid_sel}, + $lim->{selection_middle}, $sql, - $l{quoted_rs_alias}, - $l{order_by_reversed}, + $lim->{quoted_rs_alias}, + $lim->{order_by_middle}, $rows, ) if $offset; - $sql = sprintf ('SELECT %s FROM ( %s ) %s %s FETCH FIRST %u ROWS ONLY', - $l{out_sel}, + + $sql = sprintf ('SELECT %s FROM ( %s ) %s %s', + $lim->{selection_outer}, $sql, - $l{quoted_rs_alias}, - $l{order_by_requested}, - $rows, - ) if ( ($offset && $l{order_by_requested}) || ($l{mid_sel} ne $l{out_sel}) ); + $lim->{quoted_rs_alias}, + $lim->{order_by_requested}, + ) if $offset and ( + $lim->{order_by_requested} or $lim->{selection_middle} ne $lim->{selection_outer} + ); return $sql; } -=head2 RowCountOrGenericSubQ - -This is not exactly a limit dialect, but more of a proxy for B. -If no $offset is supplied the limit is simply performed as: - - SET ROWCOUNT $limit - SELECT ... - SET ROWCOUNT 0 - -Otherwise we fall back to L - -=cut - -sub _RowCountOrGenericSubQ { - my $self = shift; - my ($sql, $rs_attrs, $rows, $offset) = @_; - - return $self->_GenericSubQ(@_) if $offset; - - return sprintf <<"EOF", $rows, $sql; -SET ROWCOUNT %d -%s -SET ROWCOUNT 0 -EOF -} - =head2 GenericSubQ SELECT * FROM ( @@ -464,8 +517,11 @@ This is the most evil limit "dialect" (more of a hack) for I stupid databases. It works by ordering the set by some unique column, and calculating the amount of rows that have a less-er value (thus emulating a L-like index). Of course this implies the set can only be ordered by a single unique -column. Also note that this technique can be and often is B. +column. + +Also note that this technique can be and often is B. You +may have much better luck using L +instead. Currently used by B, due to lack of any other option. @@ -473,105 +529,168 @@ Currently used by B, due to lack of any other option. sub _GenericSubQ { my ($self, $sql, $rs_attrs, $rows, $offset) = @_; - my $root_rsrc = $rs_attrs->{_rsroot_rsrc}; - my $root_tbl_name = $root_rsrc->name; + my $main_rsrc = $rs_attrs->{result_source}; - # mangle the input sql as we will be replacing the selector - $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix - or $self->throw_exception("Unrecognizable SELECT: $sql"); + # Explicitly require an order_by + # GenSubQ is slow enough as it is, just emulating things + # like in other cases is not wise - make the user work + # to shoot their DBA in the foot + $self->throw_exception ( + 'Generic Subquery Limit does not work on resultsets without an order. Provide a stable, ' + . 'main-table-based order criteria.' + ) unless $rs_attrs->{order_by}; + + my $usable_order_colinfo = $main_rsrc->schema->storage->_extract_colinfo_of_stable_main_source_order_by_portion( + $rs_attrs + ); + + $self->throw_exception( + 'Generic Subquery Limit can not work with order criteria based on sources other than the main one' + ) if ( + ! keys %{$usable_order_colinfo||{}} + or + grep + { $_->{-source_alias} ne $rs_attrs->{alias} } + (values %$usable_order_colinfo) + ); + +### +### +### we need to know the directions after we figured out the above - reextract *again* +### this is eyebleed - trying to get it to work at first + my $supplied_order = delete $rs_attrs->{order_by}; - my ($order_by, @rest) = do { + my @order_bits = do { local $self->{quote_char}; - $self->_order_by_chunks ($rs_attrs->{order_by}) + local $self->{order_bind}; + map { ref $_ ? $_->[0] : $_ } $self->_order_by_chunks ($supplied_order) }; - unless ( - $order_by - && - ! @rest - && - ( ! ref $order_by - || - ( ref $order_by eq 'ARRAY' and @$order_by == 1 ) - ) - ) { - $self->throw_exception ( - 'Generic Subquery Limit does not work on resultsets without an order, or resultsets ' - . 'with complex order criteria (multicolumn and/or functions). Provide a single, ' - . 'unique-column order criteria.' - ); + # truncate to what we'll use + $#order_bits = ( (keys %$usable_order_colinfo) - 1 ); + + # @order_bits likely will come back quoted (due to how the prefetch + # rewriter operates + # Hence supplement the column_info lookup table with quoted versions + if ($self->quote_char) { + $usable_order_colinfo->{$self->_quote($_)} = $usable_order_colinfo->{$_} + for keys %$usable_order_colinfo; } - ($order_by) = @$order_by if ref $order_by; +# calculate the condition + my $count_tbl_alias = 'rownum__emulation'; + my $main_alias = $rs_attrs->{alias}; + my $main_tbl_name = $main_rsrc->name; - $order_by =~ s/\s+ ( ASC|DESC ) \s* $//ix; - my $direction = lc ($1 || 'asc'); + my (@unqualified_names, @qualified_names, @is_desc, @new_order_by); - my ($unq_sort_col) = $order_by =~ /(?:^|\.)([^\.]+)$/; + for my $bit (@order_bits) { - my $inf = $root_rsrc->storage->_resolve_column_info ( - $rs_attrs->{from}, [$order_by, $unq_sort_col] - ); + ($bit, my $is_desc) = $self->_split_order_chunk($bit); - my $ord_colinfo = $inf->{$order_by} || $self->throw_exception("Unable to determine source of order-criteria '$order_by'"); + push @is_desc, $is_desc; + push @unqualified_names, $usable_order_colinfo->{$bit}{-colname}; + push @qualified_names, $usable_order_colinfo->{$bit}{-fq_colname}; - if ($ord_colinfo->{-result_source}->name ne $root_tbl_name) { - $self->throw_exception(sprintf - "Generic Subquery Limit order criteria can be only based on the root-source '%s'" - . " (aliased as '%s')", $root_rsrc->source_name, $rs_attrs->{alias}, - ); + push @new_order_by, { ($is_desc ? '-desc' : '-asc') => $usable_order_colinfo->{$bit}{-fq_colname} }; + }; + + my (@where_cond, @skip_colpair_stack); + for my $i (0 .. $#order_bits) { + my $ci = $usable_order_colinfo->{$order_bits[$i]}; + + my ($subq_col, $main_col) = map { "$_.$ci->{-colname}" } ($count_tbl_alias, $main_alias); + my $cur_cond = { $subq_col => { ($is_desc[$i] ? '>' : '<') => { -ident => $main_col } } }; + + push @skip_colpair_stack, [ + { $main_col => { -ident => $subq_col } }, + ]; + + # we can trust the nullability flag because + # we already used it during _id_col_set resolution + # + if ($ci->{is_nullable}) { + push @{$skip_colpair_stack[-1]}, { $main_col => undef, $subq_col=> undef }; + + $cur_cond = [ + { + ($is_desc[$i] ? $subq_col : $main_col) => { '!=', undef }, + ($is_desc[$i] ? $main_col : $subq_col) => undef, + }, + { + $subq_col => { '!=', undef }, + $main_col => { '!=', undef }, + -and => $cur_cond, + }, + ]; + } + + push @where_cond, { '-and', => [ @skip_colpair_stack[0..$i-1], $cur_cond ] }; } - # make sure order column is qualified - $order_by = "$rs_attrs->{alias}.$order_by" - unless $order_by =~ /^$rs_attrs->{alias}\./; +# reuse the sqlmaker WHERE, this will not be returning binds + my $counted_where = do { + local $self->{where_bind}; + $self->where(\@where_cond); + }; - my $is_u; - my $ucs = { $root_rsrc->unique_constraints }; - for (values %$ucs ) { - if (@$_ == 1 && "$rs_attrs->{alias}.$_->[0]" eq $order_by) { - $is_u++; - last; - } +# construct the rownum condition by hand + my $rownum_cond; + if ($offset) { + $rownum_cond = 'BETWEEN ? AND ?'; + push @{$self->{limit_bind}}, + [ $self->__offset_bindtype => $offset ], + [ $self->__total_bindtype => $offset + $rows - 1] + ; + } + else { + $rownum_cond = '< ?'; + push @{$self->{limit_bind}}, + [ $self->__rows_bindtype => $rows ] + ; } - $self->throw_exception( - "Generic Subquery Limit order criteria column '$order_by' must be unique (no unique constraint found)" - ) unless $is_u; - my ($in_sel, $out_sel, $alias_map, $extra_order_sel) - = $self->_subqueried_limit_attrs ($rs_attrs); +# and what we will order by inside + my $inner_order_sql = do { + local $self->{order_bind}; - my $cmp_op = $direction eq 'desc' ? '>' : '<'; - my $count_tbl_alias = 'rownum__emulation'; + my $s = $self->_order_by (\@new_order_by); - my $order_sql = $self->_order_by (delete $rs_attrs->{order_by}); - my $group_having_sql = $self->_parse_rs_attrs($rs_attrs); + $self->throw_exception('Inner gensubq order may not contain binds... something went wrong') + if @{$self->{order_bind}}; + + $s; + }; + +### resume originally scheduled programming +### +### + + # we need to supply the order for the supplements to be properly calculated + my $sq_attrs = $self->_subqueried_limit_attrs ( + $sql, { %$rs_attrs, order_by => \@new_order_by } + ); + + my $in_sel = $sq_attrs->{selection_inner}; # add the order supplement (if any) as this is what will be used for the outer WHERE - $in_sel .= ", $_" for keys %{$extra_order_sel||{}}; + $in_sel .= ", $_" for sort keys %{$sq_attrs->{order_supplement}}; + + my $group_having_sql = $self->_parse_rs_attrs($rs_attrs); - $sql = sprintf (<{selection_outer} FROM ( - SELECT $in_sel ${sql}${group_having_sql} + SELECT $in_sel $sq_attrs->{query_leftover}${group_having_sql} ) %s -WHERE ( SELECT COUNT(*) FROM %s %s WHERE %s $cmp_op %s ) %s -$order_sql -EOS - ( map { $self->_quote ($_) } ( - $rs_attrs->{alias}, - $root_tbl_name, - $count_tbl_alias, - "$count_tbl_alias.$unq_sort_col", - $order_by, - )), - $offset - ? sprintf ('BETWEEN %u AND %u', $offset, $offset + $rows - 1) - : sprintf ('< %u', $rows ) - , - ); - - return $sql; +WHERE ( SELECT COUNT(*) FROM %s %s $counted_where ) $rownum_cond +$inner_order_sql + ", map { $self->_quote ($_) } ( + $rs_attrs->{alias}, + $main_tbl_name, + $count_tbl_alias, + )); } @@ -579,14 +698,14 @@ EOS # # Generates inner/outer select lists for various limit dialects # which result in one or more subqueries (e.g. RNO, Top, RowNum) -# Any non-root-table columns need to have their table qualifier +# Any non-main-table columns need to have their table qualifier # turned into a column alias (otherwise names in subqueries clash # and/or lose their source table) # -# Returns inner/outer strings of SQL QUOTED selectors with aliases -# (to be used in whatever select statement), and an alias index hashref -# of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used for string-subst -# higher up). +# Returns mangled proto-sql, inner/outer strings of SQL QUOTED selectors +# with aliases (to be used in whatever select statement), and an alias +# index hashref of QUOTED SEL => QUOTED ALIAS pairs (to maybe be used +# for string-subst higher up). # If an order_by is supplied, the inner select needs to bring out columns # used in implicit (non-selected) orders, and the order condition itself # needs to be realiased to the proper names in the outer query. Thus we @@ -594,12 +713,21 @@ EOS # QUOTED ALIAS pairs, which is a list of extra selectors that do *not* # exist in the original select list sub _subqueried_limit_attrs { - my ($self, $rs_attrs) = @_; + my ($self, $proto_sql, $rs_attrs) = @_; $self->throw_exception( 'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)' ) unless ref ($rs_attrs) eq 'HASH'; + # mangle the input sql as we will be replacing the selector entirely + unless ( + $rs_attrs->{_selector_sql} + and + $proto_sql =~ s/^ \s* SELECT \s* \Q$rs_attrs->{_selector_sql}//ix + ) { + $self->throw_exception("Unrecognizable SELECT: $proto_sql"); + } + my ($re_sep, $re_alias) = map { quotemeta $_ } ( $self->{name_sep}, $rs_attrs->{alias} ); # correlate select and as, build selection index @@ -607,12 +735,24 @@ sub _subqueried_limit_attrs { for my $i (0 .. $#{$rs_attrs->{select}}) { my $s = $rs_attrs->{select}[$i]; - my $sql_sel = $self->_recurse_fields ($s); my $sql_alias = (ref $s) eq 'HASH' ? $s->{-as} : undef; + my ($sql_sel) = length ref $s + # we throw away the @bind here deliberately + ? $self->_recurse_fields( $s ) + : $self->_quote( $s ) + ; + push @sel, { + arg => $s, sql => $sql_sel, - unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) }, + unquoted_sql => ( length ref $s + ? do { + local $self->{quote_char}; + ($self->_recurse_fields ($s))[0]; # ignore binds again + } + : $s + ), as => $sql_alias || @@ -622,7 +762,9 @@ sub _subqueried_limit_attrs { , }; - $in_sel_index->{$sql_sel}++; + # anything with a placeholder in it needs re-selection + $in_sel_index->{$sql_sel}++ unless $sql_sel =~ / (?: ^ | \W ) \? (?: \W | $ ) /x; + $in_sel_index->{$self->_quote ($sql_alias)}++ if $sql_alias; # record unqualified versions too, so we do not have @@ -638,47 +780,50 @@ sub _subqueried_limit_attrs { # unless we are dealing with the current source alias # (which will transcend the subqueries as it is necessary # for possible further chaining) - my (@in_sel, @out_sel, %renamed); + # same for anything we do not recognize + my ($sel, $renamed); for my $node (@sel) { + push @{$sel->{original}}, $node->{sql}; + if ( + ! $in_sel_index->{$node->{sql}} + or $node->{as} =~ / (?{unquoted_sql} =~ / (?{as} = $self->_unqualify_colname($node->{as}); my $quoted_as = $self->_quote($node->{as}); - push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as; - push @out_sel, $quoted_as; - $renamed{$node->{sql}} = $quoted_as; + push @{$sel->{inner}}, sprintf '%s AS %s', $node->{sql}, $quoted_as; + push @{$sel->{outer}}, $quoted_as; + $renamed->{$node->{sql}} = $quoted_as; } else { - push @in_sel, $node->{sql}; - push @out_sel, $self->_quote ($node->{as}); + push @{$sel->{inner}}, $node->{sql}; + push @{$sel->{outer}}, $self->_quote (ref $node->{arg} ? $node->{as} : $node->{arg}); } } # see if the order gives us anything - my %extra_order_sel; + my $extra_order_sel; for my $chunk ($self->_order_by_chunks ($rs_attrs->{order_by})) { # order with bind $chunk = $chunk->[0] if (ref $chunk) eq 'ARRAY'; - $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix; + ($chunk) = $self->_split_order_chunk($chunk); next if $in_sel_index->{$chunk}; - $extra_order_sel{$chunk} ||= $self->_quote ( - 'ORDER__BY__' . scalar keys %extra_order_sel + $extra_order_sel->{$chunk} ||= $self->_quote ( + 'ORDER__BY__' . sprintf '%03d', scalar keys %{$extra_order_sel||{}} ); } - return ( - (map { join (', ', @$_ ) } ( - \@in_sel, - \@out_sel) - ), - \%renamed, - keys %extra_order_sel ? \%extra_order_sel : (), - ); + return { + query_leftover => $proto_sql, + (map {( "selection_$_" => join (', ', @{$sel->{$_}} ) )} keys %$sel ), + outer_renames => $renamed, + order_supplement => $extra_order_sel, + }; } sub _unqualify_colname { @@ -687,14 +832,17 @@ sub _unqualify_colname { return $fqcn; } -1; - -=head1 AUTHORS +=head1 FURTHER QUESTIONS? -See L. +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut + +1;