[Bast-commits] r6415 - in
DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class: . Storage
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Mon May 25 09:24:32 GMT 2009
Author: ribasushi
Date: 2009-05-25 09:24:32 +0000 (Mon, 25 May 2009)
New Revision: 6415
Modified:
DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/Storage/DBI.pm
Log:
The Top limit emulation bundled with SQLA::Limit assumes that the limited resultset will be _always_ sorted. In order to fix this, I reimplemented _Top in SQLAHacks with a slight modification. Now the original order_by is passed to the outside of the nested select block, while order_up/down are calculated either based on the original order_by, or if one is not present an order by all PKs is attempted.
Since I do not have access to $rsrc in SQLA, I pass the list of PKs as an extra group_by hash entry. This appears to be rather safe, and besides we already pollute order_by with group_by and having (which seems to work rather well).
The only thing I am unsure about is the need for _gen_virtual_order(). Initially I was going to generate the pk list, only if we use the Top limit. Then it turned out there is no limit dialect before we connect, so I commented it out. Now all it does is check for a limit condition and returns the PK list. Is this necessary at all?
Modified: DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/ResultSet.pm 2009-05-25 09:18:05 UTC (rev 6414)
+++ DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/ResultSet.pm 2009-05-25 09:24:32 UTC (rev 6415)
@@ -661,6 +661,8 @@
my ($self) = @_;
my $attrs = $self->_resolved_attrs_copy;
+ $attrs->{_virtual_order_by} = $self->_gen_virtual_order;
+
return $self->{cursor}
||= $self->result_source->storage->select($attrs->{from}, $attrs->{select},
$attrs->{where},$attrs);
@@ -712,6 +714,8 @@
}
my $attrs = $self->_resolved_attrs_copy;
+ $attrs->{_virtual_order_by} = $self->_gen_virtual_order;
+
if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
@@ -738,6 +742,32 @@
return (@data ? ($self->_construct_object(@data))[0] : undef);
}
+# _gen_virtual_order
+#
+# This is a horrble hack, but seems like the best we can do at this point
+# Some limit emulations (Top) require an ordered resultset in order to
+# function at all. So supply a PK order if such a condition is detected
+
+sub _gen_virtual_order {
+ my $self = shift;
+ my $attrs = $self->_resolved_attrs_copy;
+
+ if ($attrs->{rows} or $attrs->{offset} ) {
+
+# This check requires ensure_connected, so probably cheaper to just calculate all the time
+
+# my $sm = $self->result_source->storage->_sql_maker;
+#
+# if ($sm->_default_limit_syntax eq 'Top' and not @{$sm->_resolve_order ($attrs->{order_by}) }) {
+
+ return [ $self->result_source->primary_columns ];
+
+# }
+ }
+
+ return undef;
+}
+
# _is_unique_query
#
# Try to determine if the specified query is guaranteed to be unique, based on
Modified: DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/SQLAHacks.pm 2009-05-25 09:18:05 UTC (rev 6414)
+++ DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/SQLAHacks.pm 2009-05-25 09:24:32 UTC (rev 6415)
@@ -68,11 +68,7 @@
return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
}
-
-
-# DB2 is the only remaining DB using this. Even though we are not sure if
-# RowNumberOver is still needed here (should be part of SQLA) leave the
-# code in place
+# Slow but ANSI standard Limit/Offset support. DB2 uses this
sub _RowNumberOver {
my ($self, $sql, $order, $rows, $offset ) = @_;
@@ -95,7 +91,40 @@
return $sql;
}
+# Crappy Top based Limit/Offset support. MSSQL uses this currently,
+# but may have to switch to RowNumberOver one day
+sub _Top {
+ my ( $self, $sql, $order, $rows, $offset ) = @_;
+ croak '$order supplied to SQLAHacks limit emulators must be a hash'
+ if (ref $order ne 'HASH');
+
+ my $last = $rows + $offset;
+
+ my $req_order = $self->_order_by ($order->{order_by});
+ my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by};
+
+ my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
+
+ $sql =~ s/^\s*(SELECT|select)//;
+
+ $sql = <<"SQL";
+ SELECT * FROM
+ (
+ SELECT TOP $rows * FROM
+ (
+ SELECT TOP $last $sql $order_by_inner
+ ) AS foo
+ $order_by_outer
+ ) AS bar
+ $req_order
+
+SQL
+ return $sql;
+}
+
+
+
# While we're at it, this should make LIMIT queries more efficient,
# without digging into things too deeply
sub _find_syntax {
@@ -214,32 +243,38 @@
my $ret = '';
my @extra;
if (ref $_[0] eq 'HASH') {
+
if (defined $_[0]->{group_by}) {
$ret = $self->_sqlcase(' group by ')
.$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
}
+
if (defined $_[0]->{having}) {
my $frag;
($frag, @extra) = $self->_recurse_where($_[0]->{having});
push(@{$self->{having_bind}}, @extra);
$ret .= $self->_sqlcase(' having ').$frag;
}
+
if (defined $_[0]->{order_by}) {
$ret .= $self->_order_by($_[0]->{order_by});
}
+
if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
return $self->SUPER::_order_by($_[0]);
}
+
} elsif (ref $_[0] eq 'SCALAR') {
$ret = $self->_sqlcase(' order by ').${ $_[0] };
} elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
- my @order = @{+shift};
- $ret = $self->_sqlcase(' order by ')
- .join(', ', map {
- my $r = $self->_order_by($_, @_);
- $r =~ s/^ ?ORDER BY //i;
- $r;
- } @order);
+ my @order = map {
+ my $r = $self->_order_by($_, @_);
+ $r =~ s/^ ?ORDER BY //i;
+ $r || ();
+ } @{+shift};
+
+ $ret = $self->_sqlcase(' order by ') . join(', ', @order) if @order;
+
} else {
$ret = $self->SUPER::_order_by(@_);
}
@@ -253,7 +288,6 @@
sub _resolve_order {
my ($self, $order) = @_;
- $order = $order->{order_by} if (ref $order eq 'HASH' and $order->{order_by});
if (ref $order eq 'HASH') {
$order = [$self->_resolve_order_hash($order)];
@@ -293,6 +327,7 @@
croak "$key is not a valid direction, use -asc or -desc";
}
}
+
return @new_order;
}
Modified: DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/Storage/DBI.pm 2009-05-25 09:18:05 UTC (rev 6414)
+++ DBIx-Class/0.08/branches/top_limit_altfix/lib/DBIx/Class/Storage/DBI.pm 2009-05-25 09:24:32 UTC (rev 6415)
@@ -11,6 +11,7 @@
use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use Scalar::Util qw/blessed weaken/;
+use List::Util();
__PACKAGE__->mk_group_accessors('simple' =>
qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
@@ -1177,11 +1178,14 @@
my $sql_maker = $self->sql_maker;
$sql_maker->{for} = $for;
- if (exists $attrs->{group_by} || $attrs->{having}) {
+ my @in_order_attrs = qw/group_by having _virtual_order_by/;
+ if (List::Util::first { exists $attrs->{$_} } (@in_order_attrs) ) {
$order = {
- group_by => $attrs->{group_by},
- having => $attrs->{having},
- ($order ? (order_by => $order) : ())
+ ($order
+ ? (order_by => $order)
+ : ()
+ ),
+ ( map { $_ => $attrs->{$_} } (@in_order_attrs) )
};
}
my $bind_attrs = {}; ## Future support
More information about the Bast-commits
mailing list