X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLAHacks.pm;h=4da469e14432e7771586b73ccc3408b6c8f464ac;hb=d7d38bef89def12f80ec81d8baede83de6913cd5;hp=f44ed4f462572398842fca02bfd8e8db08968ecc;hpb=aa82ce29dcf525f22133a0c6bc9cd9c611767792;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm index f44ed4f..4da469e 100644 --- a/lib/DBIx/Class/SQLAHacks.pm +++ b/lib/DBIx/Class/SQLAHacks.pm @@ -9,6 +9,7 @@ use base qw/SQL::Abstract::Limit/; 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 @@ -18,17 +19,15 @@ BEGIN { 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; + } + }; } } @@ -47,78 +46,81 @@ sub new { $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 (<_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 ) = @_; @@ -358,7 +360,13 @@ sub insert { # 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 $ret = ($_[1]||{})->{returning} ) { + $sql .= $self->_insert_returning ($ret); + } + + return $sql; } $self->SUPER::insert($table, @_); @@ -423,7 +431,7 @@ sub _recurse_fields { $self->_sqlcase($func), $self->_recurse_fields($args), $as - ? sprintf (' %s %s', $self->_sqlcase('as'), $as) + ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) ) : '' ); @@ -501,6 +509,14 @@ sub _table { } } +sub _generate_join_clause { + my ($self, $join_type) = @_; + + return sprintf ('%s JOIN ', + $join_type ? ' ' . uc($join_type) : '' + ); +} + sub _recurse_from { my ($self, $from, @join) = @_; my @sqlf; @@ -517,12 +533,9 @@ sub _recurse_from { $join_type =~ s/^\s+ | \s+$//xg; } - $join_type ||= $self->_default_jointype; + $join_type = $self->{_default_jointype} if not defined $join_type; - my $join_clause = sprintf ('%s JOIN ', - $join_type ? ' ' . uc($join_type) : '' - ); - push @sqlf, $join_clause; + push @sqlf, $self->_generate_join_clause( $join_type ); if (ref $to eq 'ARRAY') { push(@sqlf, '(', $self->_recurse_from(@$to), ')'); @@ -534,8 +547,6 @@ sub _recurse_from { return join('', @sqlf); } -sub _default_jointype {}; - sub _fold_sqlbind { my ($self, $sqlbind) = @_;