[Bast-commits] r9284 - in
DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class:
. Storage
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Sat May 1 09:55:04 GMT 2010
Author: ribasushi
Date: 2010-05-01 10:55:04 +0100 (Sat, 01 May 2010)
New Revision: 9284
Modified:
DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/Storage/DBI.pm
Log:
Preliminary version
Modified: DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/SQLAHacks.pm 2010-05-01 09:51:15 UTC (rev 9283)
+++ DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/SQLAHacks.pm 2010-05-01 09:55:04 UTC (rev 9284)
@@ -46,32 +46,89 @@
$self;
}
+# generate 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
+# turned into a column name (otherwise names in subqueries clash
+# and/or lose their source table)
+sub _subqueried_selection {
+ my ($self, $rs_attrs) = @_;
+ croak 'Limit usable only in the context of DBIC (missing $rs_attrs)' unless $rs_attrs;
+
+ # correlate select and as
+ my @sel;
+ for my $i (0 .. $#{$rs_attrs->{select}}) {
+ my $s = $rs_attrs->{select}[$i];
+ push @sel, {
+ sql => $self->_recurse_fields ($s),
+ unquoted_sql => do { local $self->{quote_char}; $self->_recurse_fields ($s) },
+ as =>
+ ( (ref $s) eq 'HASH' ? $s->{-as} : undef)
+ ||
+ $rs_attrs->{as}[$i]
+ ||
+ croak "Select argument $i ($s) without corresponding 'as'"
+ ,
+ };
+ }
+
+ my ($qsep, $qalias) = map { quotemeta $_ } (
+ $self->name_sep || '.',
+ $rs_attrs->{alias},
+ );
+
+ # re-alias and remove any name separators from aliases,
+ # unless we are dealing with the current source alias
+ # (which will transcend the subqueries and is necessary
+ # for possible further chaining)
+ my (@insel, @outsel);
+ for my $node (@sel) {
+ if (List::Util::first { $_ =~ / (?<! $qalias ) $qsep /x } ($node->{as}, $node->{unquoted_sql}) ) {
+ $node->{as} =~ s/ $qsep /__/xg;
+ push @insel, sprintf '%s AS %s', $node->{sql}, $self->_quote($node->{as});
+ push @outsel, $self->_quote ($node->{as});
+ }
+ else {
+ push @insel, $node->{sql};
+ push @outsel, $self->_quote ($node->{as});
+ }
+ }
+
+ return map { join (', ', @$_ ) } (\@insel, \@outsel);
+}
+
+
# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
sub _RowNumberOver {
my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;
- # get the select to make the final amount of columns equal the original one
- my ($select) = $sql =~ /^ \s* SELECT \s+ (.+?) \s+ FROM/ix
+ # mangle the input sql as we will be replacing the selector
+ $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
or croak "Unrecognizable SELECT: $sql";
+ # get selectors
+ my ($insel, $outsel) = $self->_subqueried_selection ($rs_attrs);
+
# make up an order if none exists
my $order_by = $self->_order_by(
(delete $rs_attrs->{order_by}) || $self->_rno_default_order
);
- # whatever is left of the order_by
+ # whatever is left of the order_by (only where is processed at this point)
my $group_having = $self->_parse_rs_attrs($rs_attrs);
my $qalias = $self->_quote ($rs_attrs->{alias});
+ my $idx_name = $self->_quote ('rno__row__index');
+
$sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
-SELECT $select FROM (
- SELECT $qalias.*, ROW_NUMBER() OVER($order_by ) AS rno__row__index FROM (
- ${sql}${group_having}
+SELECT $outsel FROM (
+ SELECT $outsel, ROW_NUMBER() OVER($order_by ) AS $idx_name FROM (
+ SELECT $insel ${sql}${group_having}
) $qalias
-) $qalias WHERE rno__row__index BETWEEN %d AND %d
+) $qalias WHERE $idx_name BETWEEN %d AND %d
EOS
@@ -120,32 +177,69 @@
);
}
+# WhOracle limits
+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 croak "Unrecognizable SELECT: $sql";
+
+ my ($insel, $outsel) = $self->_subqueried_selection ($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);
+
+ $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
+
+SELECT $outsel FROM (
+ SELECT $outsel, ROWNUM $idx_name FROM (
+ SELECT $insel ${sql}${order_group_having}
+ ) $qalias
+) $qalias WHERE $idx_name BETWEEN %d AND %d
+
+EOS
+
+ $sql =~ s/\s*\n\s*/ /g; # easier to read in the debugger
+ return $sql;
+}
+
+=begin
# Crappy Top based Limit/Offset support. Legacy from MSSQL.
sub _Top {
my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
- # mangle the input sql so it can be properly aliased in the outer queries
- $sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix
+ # mangle the input sql as we will be replacing the selector
+ $sql =~ s/^ \s* SELECT \s+ .+? \s+ (?= \b FROM \b )//ix
or croak "Unrecognizable SELECT: $sql";
- my $sql_select = $1;
- my @sql_select = split (/\s*,\s*/, $sql_select);
- # we can't support subqueries (in fact MSSQL can't) - croak
- if (@sql_select != @{$rs_attrs->{select}}) {
- croak (sprintf (
- 'SQL SELECT did not parse cleanly - retrieved %d comma separated elements, while '
- . 'the resultset select attribure contains %d elements: %s',
- scalar @sql_select,
- scalar @{$rs_attrs->{select}},
- $sql_select,
- ));
- }
+ # get selectors
+ my ($insel, $outsel) = $self->_subqueried_selection ($rs_attrs);
+ # deal with order
+ my $rs_alias = $rs_attrs->{alias};
+ my $req_order = delete $rs_attrs->{order_by};
my $name_sep = $self->name_sep || '.';
+
+ # examine normalized version, collapses nesting
+ my $limit_order = scalar $self->_order_by_chunks ($req_order)
+ ? $req_order
+ : [ map
+ { join ('', $rs_alias, $name_sep, $_ ) }
+ ( $rs_attrs->{_rsroot_source_handle}->resolve->primary_columns )
+ ]
+ ;
+
+ my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
+ my $order_by_requested = $self->_order_by ($req_order);
+
+
+
+
my $esc_name_sep = "\Q$name_sep\E";
my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x;
- my $rs_alias = $rs_attrs->{alias};
my $quoted_rs_alias = $self->_quote ($rs_alias);
# construct the new select lists, rename(alias) some columns if necessary
@@ -216,26 +310,10 @@
%outer_col_aliases = (%outer_col_aliases, %col_aliases);
- # deal with order
- croak '$order/attr container supplied to SQLAHacks limit emulators must be a hash'
- if (ref $rs_attrs ne 'HASH');
- my $req_order = $rs_attrs->{order_by};
- # examine normalized version, collapses nesting
- my $limit_order = scalar $self->_order_by_chunks ($req_order)
- ? $req_order
- : [ map
- { join ('', $rs_alias, $name_sep, $_ ) }
- ( $rs_attrs->{_rsroot_source_handle}->resolve->primary_columns )
- ]
- ;
- my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
- my $order_by_requested = $self->_order_by ($req_order);
-
# generate the rest
- delete $rs_attrs->{order_by};
my $grpby_having = $self->_parse_rs_attrs ($rs_attrs);
# short circuit for counts - the ordering complexity is needless
@@ -284,30 +362,8 @@
$sql =~ s/\s*\n\s*/ /g; # parsing out multiline statements is harder than a single line
return $sql;
}
+=cut
-# action at a distance to shorten Top code above
-sub __record_alias {
- my ($self, $register, $alias, $fqcol, $col) = @_;
-
- # record qualified name
- $register->{$fqcol} = $alias;
- $register->{$self->_quote($fqcol)} = $alias;
-
- return unless $col;
-
- # record unqualified name, undef (no adjustment) if a duplicate is found
- if (exists $register->{$col}) {
- $register->{$col} = undef;
- }
- else {
- $register->{$col} = $alias;
- }
-
- $register->{$self->_quote($col)} = $register->{$col};
-}
-
-
-
# While we're at it, this should make LIMIT queries more efficient,
# without digging into things too deeply
sub _find_syntax {
@@ -388,27 +444,26 @@
}
sub _recurse_fields {
- my ($self, $fields, $params) = @_;
+ my ($self, $fields) = @_;
my $ref = ref $fields;
return $self->_quote($fields) unless $ref;
return $$fields if $ref eq 'SCALAR';
if ($ref eq 'ARRAY') {
- return join(', ', map {
- $self->_recurse_fields($_)
- .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
- ? ' AS col'.$self->{rownum_hack_count}++
- : '')
- } @$fields);
+ return join(', ', map { $self->_recurse_fields($_) } @$fields);
}
elsif ($ref eq 'HASH') {
- my %hash = %$fields;
+ my %hash = %$fields; # shallow copy
my $as = delete $hash{-as}; # if supplied
- my ($func, $args) = each %hash;
- delete $hash{$func};
+ my ($func, $args, @toomany) = %hash;
+ # there should be only one pair
+ if (@toomany) {
+ croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ }
+
if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
croak (
'The select => { distinct => ... } syntax is not supported for multiple columns.'
@@ -425,11 +480,6 @@
: ''
);
- # there should be nothing left
- if (keys %hash) {
- croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
- }
-
return $select;
}
# Is the second check absolutely necessary?
Modified: DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/Storage/DBI.pm 2010-05-01 09:51:15 UTC (rev 9283)
+++ DBIx-Class/0.08/branches/subqueried_limit_fixes/lib/DBIx/Class/Storage/DBI.pm 2010-05-01 09:55:04 UTC (rev 9284)
@@ -1931,17 +1931,6 @@
#limited has_many
( $attrs->{rows} && keys %{$attrs->{collapse}} )
||
- # limited prefetch with RNO subqueries (otherwise a risk of column name clashes)
- (
- $attrs->{rows}
- &&
- $sql_maker->limit_dialect eq 'RowNumberOver'
- &&
- $attrs->{_prefetch_select}
- &&
- @{$attrs->{_prefetch_select}}
- )
- ||
# grouped prefetch (to satisfy group_by == select)
( $attrs->{group_by}
&&
@@ -1955,39 +1944,6 @@
($ident, $select, $where, $attrs)
= $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
}
-
- elsif (
- # the RNO limit dialect mangles the SQL such that the join gets lost
- # wrap a subquery here
- ($attrs->{rows} || $attrs->{offset})
- &&
- $sql_maker->limit_dialect eq 'RowNumberOver'
- &&
- (ref $ident eq 'ARRAY' && @$ident > 1) # indicates a join
- &&
- scalar $self->_parse_order_by ($attrs->{order_by})
- ) {
-
- push @limit, delete @{$attrs}{qw/rows offset/};
-
- my $subq = $self->_select_args_to_query (
- $ident,
- $select,
- $where,
- $attrs,
- );
-
- $ident = {
- -alias => $attrs->{alias},
- -source_handle => $ident->[0]{-source_handle},
- $attrs->{alias} => $subq,
- };
-
- # all part of the subquery now
- delete @{$attrs}{qw/order_by group_by having/};
- $where = undef;
- }
-
elsif (! $attrs->{software_limit} ) {
push @limit, $attrs->{rows}, $attrs->{offset};
}
More information about the Bast-commits
mailing list