use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util();
sub new {
my $self = shift->SUPER::new(@_);
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 ) = @_;
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
-use Scalar::Util 'blessed';
sub _find_syntax {
my ($self, $syntax) = @_;
-
- # 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
- my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
- if(ref($self) && $dbhname && $dbhname eq 'DB2') {
- return 'RowNumberOver';
- }
-
- $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
+ return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
}
sub select {
if ($func eq 'distinct') {
my $_fields = $fields->{$func};
if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
- croak "Unsupported syntax, please use " .
- "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
- " or " .
- "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
+ croak (
+ 'The select => { distinct => ... } syntax is not supported for multiple columns.'
+ .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
+ .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
+ );
}
else {
$_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
- carp "This syntax will be deprecated in 09, please use " .
- "{ group_by => '${_fields}' }" .
- " or " .
- "{ select => '${_fields}', distinct => 1 }";
+ carp (
+ 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
+ ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
+ );
}
}
-
return $self->_sqlcase($func)
.'( '.$self->_recurse_fields($fields->{$func}).' )';
}
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(@_);
}
sub _order_directions {
my ($self, $order) = @_;
- $order = $order->{order_by} if ref $order eq 'HASH';
+ return $self->SUPER::_order_directions( $self->_resolve_order($order) );
+}
+
+sub _resolve_order {
+ my ($self, $order) = @_;
+
if (ref $order eq 'HASH') {
- $order = [$self->_order_directions_hash($order)];
- } elsif (ref $order eq 'ARRAY') {
+ $order = [$self->_resolve_order_hash($order)];
+ }
+ elsif (ref $order eq 'ARRAY') {
$order = [map {
- if (ref $_ eq 'HASH') {
- $self->_order_directions_hash($_);
- } else {
- $_;
+ if (ref ($_) eq 'SCALAR') {
+ $$_
+ }
+ elsif (ref ($_) eq 'HASH') {
+ $self->_resolve_order_hash($_)
+ }
+ else {
+ $_
}
- } @{ $order }];
+ } @$order];
}
- return $self->SUPER::_order_directions($order);
+
+ return $order;
}
-sub _order_directions_hash {
+sub _resolve_order_hash {
my ($self, $order) = @_;
my @new_order;
foreach my $key (keys %{ $order }) {
croak "$key is not a valid direction, use -asc or -desc";
}
}
+
return @new_order;
}
sub _fold_sqlbind {
my ($self, $sqlbind) = @_;
- my $sql = shift @$$sqlbind;
- push @{$self->{from_bind}}, @$$sqlbind;
+
+ my @sqlbind = @$$sqlbind; # copy
+ my $sql = shift @sqlbind;
+ push @{$self->{from_bind}}, @sqlbind;
+
return $sql;
}
projects / dbsrgits/DBIx-Class.git / blobdiff