1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks;
4 use base qw/SQL::Abstract::Limit/;
7 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
10 # reinstall the carp()/croak() functions imported into SQL::Abstract
11 # as Carp and Carp::Clan do not like each other much
12 no warnings qw/redefine/;
14 for my $f (qw/carp croak/) {
15 my $orig = \&{"SQL::Abstract::$f"};
16 *{"SQL::Abstract::$f"} = sub {
18 local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not
20 if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+\(\) called/) {
21 __PACKAGE__->can($f)->(@_);
31 my $self = shift->SUPER::new(@_);
33 # This prevents the caching of $dbh in S::A::L, I believe
34 # If limit_dialect is a ref (like a $dbh), go ahead and replace
35 # it with what it resolves to:
36 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
37 if ref $self->{limit_dialect};
43 # Some databases (sqlite) do not handle multiple parenthesis
44 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
45 # is interpreted as x IN 1 or something similar.
47 # Since we currently do not have access to the SQLA AST, resort
48 # to barbaric mutilation of any SQL supplied in literal form
50 sub _strip_outer_paren {
51 my ($self, $arg) = @_;
53 return $self->_SWITCH_refkind ($arg, {
55 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
59 return \__strip_outer_paren( $$arg );
67 sub __strip_outer_paren {
70 if ($sql and not ref $sql) {
71 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
80 my ($self, $lhs, $op, $rhs) = @_;
81 $rhs = $self->_strip_outer_paren ($rhs);
82 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
85 sub _where_field_BETWEEN {
86 my ($self, $lhs, $op, $rhs) = @_;
87 $rhs = $self->_strip_outer_paren ($rhs);
88 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
91 # Slow but ANSI standard Limit/Offset support. DB2 uses this
93 my ($self, $sql, $order, $rows, $offset ) = @_;
96 my $last = $rows + $offset - 1;
97 my ( $order_by ) = $self->_order_by( $order );
102 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
107 WHERE ROW_NUM BETWEEN $offset AND $last
114 # Crappy Top based Limit/Offset support. MSSQL uses this currently,
115 # but may have to switch to RowNumberOver one day
117 my ( $self, $sql, $order, $rows, $offset ) = @_;
119 croak '$order supplied to SQLAHacks limit emulators must be a hash'
120 if (ref $order ne 'HASH');
122 $order = { %$order }; #copy
124 my $last = $rows + $offset;
126 my $req_order = $self->_order_by ($order->{order_by});
128 my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by};
130 delete $order->{$_} for qw/order_by _virtual_order_by/;
131 my $grpby_having = $self->_order_by ($order);
133 my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
135 $sql =~ s/^\s*(SELECT|select)//;
140 SELECT TOP $rows * FROM
142 SELECT TOP $last $sql $grpby_having $order_by_inner
154 # While we're at it, this should make LIMIT queries more efficient,
155 # without digging into things too deeply
157 my ($self, $syntax) = @_;
158 return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
162 update => 'FOR UPDATE',
163 shared => 'FOR SHARE',
166 my ($self, $table, $fields, $where, $order, @rest) = @_;
168 $self->{"${_}_bind"} = [] for (qw/having from order/);
170 if (ref $table eq 'SCALAR') {
173 elsif (not ref $table) {
174 $table = $self->_quote($table);
176 local $self->{rownum_hack_count} = 1
177 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
178 @rest = (-1) unless defined $rest[0];
179 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
180 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
181 my ($sql, @where_bind) = $self->SUPER::select(
182 $table, $self->_recurse_fields($fields), $where, $order, @rest
184 if (my $for = delete $self->{_dbic_rs_attrs}{for}) {
185 $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
188 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql;
194 $table = $self->_quote($table) unless ref($table);
196 # SQLA will emit INSERT INTO $table ( ) VALUES ( )
197 # which is sadly understood only by MySQL. Change default behavior here,
198 # until SQLA2 comes with proper dialect support
199 if (! $_[0] or (ref $_[0] eq 'HASH' and !keys %{$_[0]} ) ) {
200 return "INSERT INTO ${table} DEFAULT VALUES"
203 $self->SUPER::insert($table, @_);
209 $table = $self->_quote($table) unless ref($table);
210 $self->SUPER::update($table, @_);
216 $table = $self->_quote($table) unless ref($table);
217 $self->SUPER::delete($table, @_);
223 return $_[1].$self->_order_by($_[2]);
225 return $self->SUPER::_emulate_limit(@_);
229 sub _recurse_fields {
230 my ($self, $fields, $params) = @_;
231 my $ref = ref $fields;
232 return $self->_quote($fields) unless $ref;
233 return $$fields if $ref eq 'SCALAR';
235 if ($ref eq 'ARRAY') {
236 return join(', ', map {
237 $self->_recurse_fields($_)
238 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
239 ? ' AS col'.$self->{rownum_hack_count}++
242 } elsif ($ref eq 'HASH') {
243 foreach my $func (keys %$fields) {
244 if ($func eq 'distinct') {
245 my $_fields = $fields->{$func};
246 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
248 'The select => { distinct => ... } syntax is not supported for multiple columns.'
249 .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
250 .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
254 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
256 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
257 ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
261 return $self->_sqlcase($func)
262 .'( '.$self->_recurse_fields($fields->{$func}).' )';
265 # Is the second check absolutely necessary?
266 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
267 return $self->_fold_sqlbind( $fields );
270 croak($ref . qq{ unexpected in _recurse_fields()})
275 my ($self, $arg) = @_;
277 if (ref $arg eq 'HASH' and keys %$arg and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
281 if (defined $arg->{group_by}) {
282 $ret = $self->_sqlcase(' group by ')
283 .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 });
286 if (defined $arg->{having}) {
287 my ($frag, @bind) = $self->_recurse_where($arg->{having});
288 push(@{$self->{having_bind}}, @bind);
289 $ret .= $self->_sqlcase(' having ').$frag;
292 if (defined $arg->{order_by}) {
293 my ($frag, @bind) = $self->SUPER::_order_by($arg->{order_by});
294 push(@{$self->{order_bind}}, @bind);
301 my ($sql, @bind) = $self->SUPER::_order_by ($arg);
302 push(@{$self->{order_bind}}, @bind);
307 sub _order_directions {
308 my ($self, $order) = @_;
310 # strip bind values - none of the current _order_directions users support them
311 return $self->SUPER::_order_directions( [ map
312 { ref $_ ? $_->[0] : $_ }
313 $self->_order_by_chunks ($order)
318 my ($self, $from) = @_;
319 if (ref $from eq 'ARRAY') {
320 return $self->_recurse_from(@$from);
321 } elsif (ref $from eq 'HASH') {
322 return $self->_make_as($from);
324 return $from; # would love to quote here but _table ends up getting called
325 # twice during an ->select without a limit clause due to
326 # the way S::A::Limit->select works. should maybe consider
327 # bypassing this and doing S::A::select($self, ...) in
328 # our select method above. meantime, quoting shims have
329 # been added to select/insert/update/delete here
334 my ($self, $from, @join) = @_;
336 push(@sqlf, $self->_make_as($from));
337 foreach my $j (@join) {
340 # check whether a join type exists
341 my $join_clause = '';
342 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
343 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
344 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
346 $join_clause = ' JOIN ';
348 push(@sqlf, $join_clause);
350 if (ref $to eq 'ARRAY') {
351 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
353 push(@sqlf, $self->_make_as($to));
355 push(@sqlf, ' ON ', $self->_join_condition($on));
357 return join('', @sqlf);
361 my ($self, $sqlbind) = @_;
363 my @sqlbind = @$$sqlbind; # copy
364 my $sql = shift @sqlbind;
365 push @{$self->{from_bind}}, @sqlbind;
371 my ($self, $from) = @_;
372 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
373 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
375 } reverse each %{$self->_skip_options($from)});
379 my ($self, $hash) = @_;
381 $clean_hash->{$_} = $hash->{$_}
382 for grep {!/^-/} keys %$hash;
386 sub _join_condition {
387 my ($self, $cond) = @_;
388 if (ref $cond eq 'HASH') {
393 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
394 if ref($v) ne 'SCALAR';
398 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
401 return scalar($self->_recurse_where(\%j));
402 } elsif (ref $cond eq 'ARRAY') {
403 return join(' OR ', map { $self->_join_condition($_) } @$cond);
405 die "Can't handle this yet!";
410 my ($self, $label) = @_;
411 return '' unless defined $label;
412 return "*" if $label eq '*';
413 return $label unless $self->{quote_char};
414 if(ref $self->{quote_char} eq "ARRAY"){
415 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
416 if !defined $self->{name_sep};
417 my $sep = $self->{name_sep};
418 return join($self->{name_sep},
419 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
420 split(/\Q$sep\E/,$label));
422 return $self->SUPER::_quote($label);
427 $self->{limit_dialect} = shift if @_;
428 return $self->{limit_dialect};
433 $self->{quote_char} = shift if @_;
434 return $self->{quote_char};
439 $self->{name_sep} = shift if @_;
440 return $self->{name_sep};
451 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
452 and includes a number of DBIC-specific workarounds, not yet suitable for
453 inclusion into SQLA proper.
459 Tries to determine limit dialect.
463 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
464 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
466 =head2 insert update delete
468 Just quotes table names.
472 Specifies the dialect of used for implementing an SQL "limit" clause for
473 restricting the number of query results returned. Valid values are: RowNum.
475 See L<DBIx::Class::Storage::DBI/connect_info> for details.
479 Character separating quoted table names.
481 See L<DBIx::Class::Storage::DBI/connect_info> for details.
485 Set to an array-ref to specify separate left and right quotes for table names.
487 See L<DBIx::Class::Storage::DBI/connect_info> for details.