[Bast-commits] r6961 - in DBIx-Class/0.08/branches/mssql_top_fixes:
lib/DBIx/Class lib/DBIx/Class/SQLAHacks
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Jul 3 10:06:57 GMT 2009
Author: ribasushi
Date: 2009-07-03 10:06:57 +0000 (Fri, 03 Jul 2009)
New Revision: 6961
Added:
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks/MSSQL.pm
Modified:
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/branches/mssql_top_fixes/t/03podcoverage.t
DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t
Log:
Fix some mssql shortcommings when confronted with the new subequeried prefetch sql
Added: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks/MSSQL.pm (rev 0)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks/MSSQL.pm 2009-07-03 10:06:57 UTC (rev 6961)
@@ -0,0 +1,33 @@
+package # Hide from PAUSE
+ DBIx::Class::SQLAHacks::MSSQL;
+
+use base qw( DBIx::Class::SQLAHacks );
+use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+
+#
+# MSSQL is retarded wrt TOP (crappy limit) and ordering.
+# One needs to add a TOP to *all* ordered subqueries, if
+# TOP has been used in the statement at least once.
+# Do it here.
+#
+sub select {
+ my $self = shift;
+
+ my ($sql, @bind) = $self->SUPER::select (@_);
+
+ # ordering was requested and there are at least 2 SELECT/FROM pairs
+ # (thus subquery), and there is no TOP specified
+ if (
+ $sql =~ /\bSELECT\b .+? \bFROM\b .+? \bSELECT\b .+? \bFROM\b/isx
+ &&
+ $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ /xi
+ &&
+ scalar $self->_order_by_chunks ($_[3]->{order_by})
+ ) {
+ $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi;
+ }
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+1;
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm 2009-07-03 04:34:33 UTC (rev 6960)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm 2009-07-03 10:06:57 UTC (rev 6961)
@@ -135,9 +135,12 @@
}
my $name_sep = $self->name_sep || '.';
- $name_sep = "\Q$name_sep\E";
- my $col_re = qr/ ^ (?: (.+) $name_sep )? ([^$name_sep]+) $ /x;
+ my $esc_name_sep = "\Q$name_sep\E";
+ my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x;
+ my $rs_alias = $self->{_dbic_rs_attrs}{alias};
+ my $quoted_rs_alias = $self->_quote ($rs_alias);
+
# construct the new select lists, rename(alias) some columns if necessary
my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases);
@@ -219,7 +222,6 @@
$limit_order = $req_order;
}
else {
- my $rs_alias = $self->{_dbic_rs_attrs}{alias};
$limit_order = [ map
{ join ('', $rs_alias, $name_sep, $_ ) }
( $self->{_dbic_rs_attrs}{_source_handle}->resolve->primary_columns )
@@ -260,7 +262,7 @@
SELECT TOP $rows $outer_select FROM
(
$sql
- ) AS me
+ ) $quoted_rs_alias
$order_by_outer
SQL
@@ -270,12 +272,13 @@
$sql = <<"SQL";
SELECT $outer_select FROM
- ( $sql ) AS me
- $order_by_requested;
+ ( $sql ) $quoted_rs_alias
+ $order_by_requested
SQL
}
+ $sql =~ s/\s*\n\s*/ /g; # parsing out multiline statements is harder than a single line
return $sql;
}
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-07-03 04:34:33 UTC (rev 6960)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-07-03 10:06:57 UTC (rev 6961)
@@ -5,6 +5,8 @@
use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
my ($id) = $dbh->selectrow_array('SELECT SCOPE_IDENTITY()');
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm 2009-07-03 04:34:33 UTC (rev 6960)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm 2009-07-03 10:06:57 UTC (rev 6961)
@@ -1376,7 +1376,7 @@
sub _select_args {
my ($self, $ident, $select, $where, $attrs) = @_;
- my ($alias2source, $root_alias) = $self->_resolve_ident_sources ($ident);
+ my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident);
my $sql_maker = $self->sql_maker;
$sql_maker->{_dbic_rs_attrs} = {
@@ -1384,7 +1384,10 @@
select => $select,
from => $ident,
where => $where,
- _source_handle => $alias2source->{$root_alias}->handle,
+ $rs_alias
+ ? ( _source_handle => $alias2source->{$rs_alias}->handle )
+ : ()
+ ,
};
# calculate bind_attrs before possible $ident mangling
@@ -1397,7 +1400,7 @@
$bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
# so that unqualified searches can be bound too
- $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $root_alias;
+ $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $rs_alias;
}
}
@@ -1452,23 +1455,28 @@
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
+#
+# This is the code producing joined subqueries like:
+# 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');
+
# copies for mangling
$from = [ @$from ];
$select = [ @$select ];
$attrs = { %$attrs };
- $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 group_by having/;
delete $sub_attrs->{$_} for qw/for collapse prefetch_select _collapse_order_by select as/;
my $alias = $attrs->{alias};
+ my $sql_maker = $self->sql_maker;
# create subquery select list - loop only over primary columns
my $sub_select = [];
@@ -1495,7 +1503,7 @@
}
# mangle {from}
- my $select_root = shift @$from;
+ my $join_root = shift @$from;
my @outer_from = @$from;
my %inner_joins;
@@ -1505,7 +1513,7 @@
# 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) {
+ if ($join_root->{-alias} ne $alias) {
$inner_joins{$alias} = 1;
while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
@@ -1536,7 +1544,6 @@
# It may not be very efficient, but it's a reasonable stop-gap
{
# produce stuff unquoted, so it can be scanned
- my $sql_maker = $self->sql_maker;
local $sql_maker->{quote_char};
my @order_by = (map
@@ -1576,14 +1583,13 @@
}
# construct the inner $from for the subquery
- my $inner_from = [ $select_root ];
+ my $inner_from = [ $join_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) {
# the dot comes from some weirdness in collapse
@@ -1605,7 +1611,7 @@
# put it in the new {from}
unshift @outer_from, {
-alias => $alias,
- -source_handle => $select_root->{-source_handle},
+ -source_handle => $join_root->{-source_handle},
$alias => $subq,
};
@@ -1623,14 +1629,14 @@
my ($self, $ident) = @_;
my $alias2source = {};
- my $root_alias;
+ my $rs_alias;
# the reason this is so contrived is that $ident may be a {from}
# structure, specifying multiple tables to join
if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
# this is compat mode for insert/update/delete which do not deal with aliases
$alias2source->{me} = $ident;
- $root_alias = 'me';
+ $rs_alias = 'me';
}
elsif (ref $ident eq 'ARRAY') {
@@ -1638,7 +1644,7 @@
my $tabinfo;
if (ref $_ eq 'HASH') {
$tabinfo = $_;
- $root_alias = $tabinfo->{-alias};
+ $rs_alias = $tabinfo->{-alias};
}
if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
$tabinfo = $_->[0];
@@ -1649,7 +1655,7 @@
}
}
- return ($alias2source, $root_alias);
+ return ($alias2source, $rs_alias);
}
# Takes $ident, \@column_names
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/t/03podcoverage.t 2009-07-03 04:34:33 UTC (rev 6960)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/t/03podcoverage.t 2009-07-03 10:06:57 UTC (rev 6961)
@@ -117,6 +117,7 @@
'DBIx::Class::Storage::DBI::SQLite' => { skip => 1 },
'DBIx::Class::Storage::DBI::mysql' => { skip => 1 },
'DBIx::Class::SQLAHacks::MySQL' => { skip => 1 },
+ 'DBIx::Class::SQLAHacks::MSSQL' => { skip => 1 },
'SQL::Translator::Parser::DBIx::Class' => { skip => 1 },
'SQL::Translator::Producer::DBIx::Class::File' => { skip => 1 },
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t 2009-07-03 04:34:33 UTC (rev 6960)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t 2009-07-03 10:06:57 UTC (rev 6961)
@@ -190,8 +190,10 @@
}, {
distinct => 1,
prefetch => 'owner',
- order_by => 'name',
rows => 2, # 3 results total
+ order_by => { -desc => 'owner' },
+ # there is no sane way to order by the right side of a grouped prefetch currently :(
+ #order_by => { -desc => 'owner.name' },
});
More information about the Bast-commits
mailing list