From: Peter Rabbitson Date: Sat, 20 Jun 2009 08:34:42 +0000 (+0000) Subject: Maybe I've nailed it X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=42e5b103c09794bbe86eea1a464dae6b5276ff48;p=dbsrgits%2FDBIx-Class-Historic.git Maybe I've nailed it --- diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index 1498be1..e4ffce9 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -119,44 +119,90 @@ sub _Top { # mangle the input sql so it can be properly aliased in the outer queries $sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix or croak "Unrecognizable SELECT: $sql"; - my $select = $1; + 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 != @{$self->{_dbic_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 @{$self->{_dbic_rs_attrs}{select}}, + $sql_select, + )); + } - my (@outer_select, %col_index); - for my $selected_col (@{$self->{_dbic_rs_attrs}{select}}) { + my $name_sep = $self->name_sep || '.'; + $name_sep = "\Q$name_sep\E"; + my $col_re = qr/ ^ (?: (.+) $name_sep )? ([^$name_sep]+) $ /x; - my $new_colname; + # construct the new select lists, rename(alias) some columns if necessary + my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases); - if (ref $selected_col) { - $new_colname = $self->_quote ('column_' . (@outer_select + 1) ); - } - else { - my $quoted_col = $self->_quote ($selected_col); + for (@{$self->{_dbic_rs_attrs}{select}}) { + next if ref $_; + my ($table, $orig_colname) = ( $_ =~ $col_re ); + next unless $table; + $seen_names{$orig_colname}++; + } - my $name_sep = $self->name_sep || '.'; - $name_sep = "\Q$name_sep\E"; + for my $i (0 .. $#sql_select) { - my ($table, $orig_colname) = ( $selected_col =~ / (?: (.+) $name_sep )? ([^$name_sep]+) $ /x ); - $new_colname = $self->_quote ("${table}__${orig_colname}"); + my $colsel_arg = $self->{_dbic_rs_attrs}{select}[$i]; + my $colsel_sql = $sql_select[$i]; - $select =~ s/(\Q$quoted_col\E|\Q$selected_col\E)/"$1 AS $new_colname"/e; + # this may or may not work (in case of a scalarref or something) + my ($table, $orig_colname) = ( $colsel_arg =~ $col_re ); - # record qualified name if available (should be) - $col_index{$selected_col} = $new_colname if $table; + my $quoted_alias; + # do not attempt to understand non-scalar selects - alias numerically + if (ref $colsel_arg) { + $quoted_alias = $self->_quote ('column_' . (@inner_select + 1) ); + } + # column name seen more than once - alias it + elsif ($orig_colname && ($seen_names{$orig_colname} > 1) ) { + $quoted_alias = $self->_quote ("${table}__${orig_colname}"); + } - # record unqialified name, undef if a duplicate is found - if (exists $col_index{$orig_colname}) { - $col_index{$orig_colname} = undef; - } - else { - $col_index{$orig_colname} = $new_colname; - } + # we did rename - make a record and adjust + if ($quoted_alias) { + # alias inner + push @inner_select, "$colsel_sql AS $quoted_alias"; + + # push alias to outer + push @outer_select, $quoted_alias; + + # Any aliasing accumulated here will be considered + # both for inner and outer adjustments of ORDER BY + $self->__record_alias ( + \%col_aliases, + $quoted_alias, + $colsel_arg, + $table ? $orig_colname : undef, + ); } - push @outer_select, $new_colname; + # otherwise just leave things intact inside, and use the abbreviated one outside + # (as we do not have table names anymore) + else { + push @inner_select, $colsel_sql; + + my $outer_quoted = $self->_quote ($orig_colname); # it was not a duplicate so should just work + push @outer_select, $outer_quoted; + $self->__record_alias ( + \%outer_col_aliases, + $outer_quoted, + $colsel_arg, + $table ? $orig_colname : undef, + ); + } } my $outer_select = join (', ', @outer_select ); + my $inner_select = join (', ', @inner_select ); + %outer_col_aliases = (%outer_col_aliases, %col_aliases); # deal with order croak '$order supplied to SQLAHacks limit emulators must be a hash' @@ -167,41 +213,48 @@ sub _Top { my $req_order = [ $self->_order_by_chunks ($order->{order_by}) ]; my $limit_order = [ @$req_order ? @$req_order : $self->_order_by_chunks ($order->{_virtual_order_by}) ]; + my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order); + my $order_by_requested = $self->_order_by ($req_order); - # normalize all column names in order by - # no copies, just aliasing ($_) - for ($req_order, $limit_order) { - for ( @{$_ || []} ) { - $_ = $col_index{$_} if $col_index{$_}; + # we can't really adjust the order_by columns, as introspection is lacking + # resort to simple substitution + for my $col (keys %outer_col_aliases) { + for ($order_by_requested, $order_by_outer) { + $_ =~ s/\s+$col\s+/ $outer_col_aliases{$col} /g; } } + for my $col (keys %col_aliases) { + $order_by_inner =~ s/\s+$col\s+/$col_aliases{$col}/g; + } # generate the rest delete $order->{$_} for qw/order_by _virtual_order_by/; my $grpby_having = $self->_order_by ($order); - my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order); - my $last = $rows + $offset; + my $inner_lim = $rows + $offset; - $sql = <<"SQL"; + my $sql = "SELECT TOP $inner_lim $inner_select $sql $grpby_having $order_by_inner"; + + if ($offset) { + $sql = <<"SQL"; SELECT TOP $rows $outer_select FROM ( - SELECT TOP $last $select $sql $grpby_having $order_by_inner + $sql ) AS inner_sel $order_by_outer SQL - if (@$req_order) { - my $order_by_requested = $self->_order_by ($req_order); + } + if ($order_by_requested) { $sql = <<"SQL"; - SELECT $outer_select FROM - ( $sql ) AS outer_sel - $order_by_requested; + SELECT $outer_select FROM + ( $sql ) AS outer_sel + $order_by_requested; SQL } @@ -209,6 +262,27 @@ SQL return $sql; } +# 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 unqialified 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, diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 95260b0..f7298cf 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1229,7 +1229,12 @@ sub _select_args { my ($self, $ident, $select, $where, $attrs) = @_; my $sql_maker = $self->sql_maker; - $sql_maker->{_dbic_rs_attrs} = $attrs; + $sql_maker->{_dbic_rs_attrs} = { + %$attrs, + select => $select, + from => $ident, + where => $where, + }; my $alias2source = $self->_resolve_ident_sources ($ident); @@ -1289,17 +1294,17 @@ sub _select_args { sub _adjust_select_args_for_limited_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'); + if ($attrs->{group_by} && @{$attrs->{group_by}}) { + $self->throw_exception ('has_many prefetch with limit (rows/offset) is not supported on grouped resultsets'); } - $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute') + $self->throw_exception ('has_many prefetch with limit (rows/offset) is 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 $sub_attrs->{$_} for qw/for collapse select as order_by/; my $alias = $attrs->{alias}; @@ -1314,7 +1319,6 @@ sub _adjust_select_args_for_limited_prefetch { ]; } - # mangle the head of the {from} my $self_ident = shift @$from; diff --git a/t/746mssql.t b/t/746mssql.t index 2f17dde..a693949 100644 --- a/t/746mssql.t +++ b/t/746mssql.t @@ -12,7 +12,7 @@ plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this plan tests => 19; -my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1}); +my $schema = DBICTest::Schema->connect($dsn, $user, $pass); { no warnings 'redefine'; @@ -90,7 +90,7 @@ CREATE TABLE Books ( CREATE TABLE Owners ( id INT IDENTITY (1, 1) NOT NULL, - [name] VARCHAR(100), + name VARCHAR(100), ) SQL @@ -136,26 +136,25 @@ $schema->populate ('BooksInLibrary', [ # { - # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed) + # try a ->has_many direction (group_by is not possible on has_many with limit) my $owners = $schema->resultset ('Owners')->search ({ 'books.id' => { '!=', undef } }, { prefetch => 'books', - distinct => 1, order_by => 'name', page => 2, - rows => 5, + rows => 3, }); - is ($owners->all, 3, 'Prefetched grouped search returns correct number of rows'); - is ($owners->count, 3, 'Prefetched grouped search returns correct count'); + is ($owners->all, 3, 'has_many prefetch returns correct number of rows'); + is ($owners->count, 3, 'has-many prefetch returns correct count'); - # try a ->belongs_to direction (no select collapse) + # try a ->belongs_to direction (no select collapse, group_by should work) my $books = $schema->resultset ('BooksInLibrary')->search ({ 'owner.name' => 'wiggle' }, { - prefetch => 'owner', distinct => 1, + prefetch => 'owner', order_by => 'name', rows => 5, }); @@ -164,6 +163,7 @@ $schema->populate ('BooksInLibrary', [ is ($books->page(1)->all, 1, 'Prefetched grouped search returns correct number of rows'); is ($books->page(1)->count, 1, 'Prefetched grouped search returns correct count'); + # is ($books->page(2)->all, 0, 'Prefetched grouped search returns correct number of rows'); is ($books->page(2)->count, 0, 'Prefetched grouped search returns correct count');