use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+use Sub::Name();
BEGIN {
# reinstall the carp()/croak() functions imported into SQL::Abstract
for my $f (qw/carp croak/) {
my $orig = \&{"SQL::Abstract::$f"};
- *{"SQL::Abstract::$f"} = sub {
-
- local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not
-
- if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
- __PACKAGE__->can($f)->(@_);
- }
- else {
- $orig->(@_);
- }
- }
+ *{"SQL::Abstract::$f"} = Sub::Name::subname "SQL::Abstract::$f" =>
+ sub {
+ if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
+ __PACKAGE__->can($f)->(@_);
+ }
+ else {
+ goto $orig;
+ }
+ };
}
}
$self;
}
-# Some databases (sqlite) do not handle multiple parenthesis
-# around in/between arguments. A tentative x IN ( (1, 2 ,3) )
-# is interpreted as x IN 1 or something similar.
-#
-# Since we currently do not have access to the SQLA AST, resort
-# to barbaric mutilation of any SQL supplied in literal form
-sub _strip_outer_paren {
- my ($self, $arg) = @_;
- return $self->_SWITCH_refkind ($arg, {
- ARRAYREFREF => sub {
- $$arg->[0] = __strip_outer_paren ($$arg->[0]);
- return $arg;
- },
- SCALARREF => sub {
- return \__strip_outer_paren( $$arg );
- },
- FALLBACK => sub {
- return $arg
- },
- });
-}
+# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
+sub _RowNumberOver {
+ my ($self, $sql, $order, $rows, $offset ) = @_;
-sub __strip_outer_paren {
- my $sql = shift;
+ # get the select to make the final amount of columns equal the original one
+ my ($select) = $sql =~ /^ \s* SELECT \s+ (.+?) \s+ FROM/ix
+ or croak "Unrecognizable SELECT: $sql";
- if ($sql and not ref $sql) {
- while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
- $sql = $1;
- }
- }
+ # get the order_by only (or make up an order if none exists)
+ my $order_by = $self->_order_by(
+ (delete $order->{order_by}) || $self->_rno_default_order
+ );
+
+ # whatever is left of the order_by
+ my $group_having = $self->_order_by($order);
+
+ my $qalias = $self->_quote ($self->{_dbic_rs_attrs}{alias});
+
+ $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}
+ ) $qalias
+) $qalias WHERE rno__row__index BETWEEN %d AND %d
+
+EOS
+
+ $sql =~ s/\s*\n\s*/ /g; # easier to read in the debugger
return $sql;
}
-sub _where_field_IN {
- my ($self, $lhs, $op, $rhs) = @_;
- $rhs = $self->_strip_outer_paren ($rhs);
- return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+# some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) )
+sub _rno_default_order {
+ return undef;
}
-sub _where_field_BETWEEN {
- my ($self, $lhs, $op, $rhs) = @_;
- $rhs = $self->_strip_outer_paren ($rhs);
- return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
-}
+# Informix specific limit, almost like LIMIT/OFFSET
+sub _SkipFirst {
+ my ($self, $sql, $order, $rows, $offset) = @_;
-# Slow but ANSI standard Limit/Offset support. DB2 uses this
-sub _RowNumberOver {
- my ($self, $sql, $order, $rows, $offset ) = @_;
+ $sql =~ s/^ \s* SELECT \s+ //ix
+ or croak "Unrecognizable SELECT: $sql";
- $offset += 1;
- my $last = $rows + $offset - 1;
- my ( $order_by ) = $self->_order_by( $order );
+ return sprintf ('SELECT %s%s%s%s',
+ $offset
+ ? sprintf ('SKIP %d ', $offset)
+ : ''
+ ,
+ sprintf ('FIRST %d ', $rows),
+ $sql,
+ $self->_order_by ($order),
+ );
+}
- $sql = <<"SQL";
-SELECT * FROM
-(
- SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
- $sql
- $order_by
- ) Q1
-) Q2
-WHERE ROW_NUM BETWEEN $offset AND $last
+# Firebird specific limit, reverse of _SkipFirst for Informix
+sub _FirstSkip {
+ my ($self, $sql, $order, $rows, $offset) = @_;
-SQL
+ $sql =~ s/^ \s* SELECT \s+ //ix
+ or croak "Unrecognizable SELECT: $sql";
- return $sql;
+ return sprintf ('SELECT %s%s%s%s',
+ sprintf ('FIRST %d ', $rows),
+ $offset
+ ? sprintf ('SKIP %d ', $offset)
+ : ''
+ ,
+ $sql,
+ $self->_order_by ($order),
+ );
}
-# Crappy Top based Limit/Offset support. MSSQL uses this currently,
-# but may have to switch to RowNumberOver one day
+# Crappy Top based Limit/Offset support. Legacy from MSSQL.
sub _Top {
my ( $self, $sql, $order, $rows, $offset ) = @_;
# which is sadly understood only by MySQL. Change default behavior here,
# until SQLA2 comes with proper dialect support
if (! $_[0] or (ref $_[0] eq 'HASH' and !keys %{$_[0]} ) ) {
- return "INSERT INTO ${table} DEFAULT VALUES"
+ my $sql = "INSERT INTO ${table} DEFAULT VALUES";
+
+ if (my @returning = @{ ($_[1]||{})->{returning} || [] }) {
+ $sql .= ' RETURNING (' . (join ', ' => map $self->_quote($_), @returning)
+ . ')';
+ }
+
+ return $sql;
}
$self->SUPER::insert($table, @_);
$self->_sqlcase($func),
$self->_recurse_fields($args),
$as
- ? sprintf (' %s %s', $self->_sqlcase('as'), $as)
+ ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
: ''
);