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 my ($self, $table, $fields, $where, $order, @rest) = @_;
164 $self->{"${_}_bind"} = [] for (qw/having from order/);
166 if (ref $table eq 'SCALAR') {
169 elsif (not ref $table) {
170 $table = $self->_quote($table);
172 local $self->{rownum_hack_count} = 1
173 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
174 @rest = (-1) unless defined $rest[0];
175 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
176 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
177 my ($sql, @where_bind) = $self->SUPER::select(
178 $table, $self->_recurse_fields($fields), $where, $order, @rest
183 $self->{for} eq 'update' ? ' FOR UPDATE' :
184 $self->{for} eq 'shared' ? ' FOR SHARE' :
189 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql;
195 $table = $self->_quote($table) unless ref($table);
197 # SQLA will emit INSERT INTO $table ( ) VALUES ( )
198 # which is sadly understood only by MySQL. Change default behavior here,
199 # until SQLA2 comes with proper dialect support
200 if (! $_[0] or (ref $_[0] eq 'HASH' and !keys %{$_[0]} ) ) {
201 return "INSERT INTO ${table} DEFAULT VALUES"
204 $self->SUPER::insert($table, @_);
210 $table = $self->_quote($table) unless ref($table);
211 $self->SUPER::update($table, @_);
217 $table = $self->_quote($table) unless ref($table);
218 $self->SUPER::delete($table, @_);
224 return $_[1].$self->_order_by($_[2]);
226 return $self->SUPER::_emulate_limit(@_);
230 sub _recurse_fields {
231 my ($self, $fields, $params) = @_;
232 my $ref = ref $fields;
233 return $self->_quote($fields) unless $ref;
234 return $$fields if $ref eq 'SCALAR';
236 if ($ref eq 'ARRAY') {
237 return join(', ', map {
238 $self->_recurse_fields($_)
239 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
240 ? ' AS col'.$self->{rownum_hack_count}++
243 } elsif ($ref eq 'HASH') {
244 foreach my $func (keys %$fields) {
245 if ($func eq 'distinct') {
246 my $_fields = $fields->{$func};
247 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
249 'The select => { distinct => ... } syntax is not supported for multiple columns.'
250 .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
251 .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
255 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
257 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
258 ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
262 return $self->_sqlcase($func)
263 .'( '.$self->_recurse_fields($fields->{$func}).' )';
266 # Is the second check absolutely necessary?
267 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
268 return $self->_fold_sqlbind( $fields );
271 croak($ref . qq{ unexpected in _recurse_fields()})
276 my ($self, $arg) = @_;
278 if (ref $arg eq 'HASH' and keys %$arg and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
282 if (defined $arg->{group_by}) {
283 $ret = $self->_sqlcase(' group by ')
284 .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 });
287 if (defined $arg->{having}) {
288 my ($frag, @bind) = $self->_recurse_where($arg->{having});
289 push(@{$self->{having_bind}}, @bind);
290 $ret .= $self->_sqlcase(' having ').$frag;
293 if (defined $arg->{order_by}) {
294 my ($frag, @bind) = $self->SUPER::_order_by($arg->{order_by});
295 push(@{$self->{order_bind}}, @bind);
302 my ($sql, @bind) = $self->SUPER::_order_by ($arg);
303 push(@{$self->{order_bind}}, @bind);
308 sub _order_directions {
309 my ($self, $order) = @_;
311 # strip bind values - none of the current _order_directions users support them
312 return $self->SUPER::_order_directions( [ map
313 { ref $_ ? $_->[0] : $_ }
314 $self->_order_by_chunks ($order)
319 my ($self, $from) = @_;
320 if (ref $from eq 'ARRAY') {
321 return $self->_recurse_from(@$from);
322 } elsif (ref $from eq 'HASH') {
323 return $self->_make_as($from);
325 return $from; # would love to quote here but _table ends up getting called
326 # twice during an ->select without a limit clause due to
327 # the way S::A::Limit->select works. should maybe consider
328 # bypassing this and doing S::A::select($self, ...) in
329 # our select method above. meantime, quoting shims have
330 # been added to select/insert/update/delete here
335 my ($self, $from, @join) = @_;
337 push(@sqlf, $self->_make_as($from));
338 foreach my $j (@join) {
341 # check whether a join type exists
342 my $join_clause = '';
343 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
344 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
345 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
347 $join_clause = ' JOIN ';
349 push(@sqlf, $join_clause);
351 if (ref $to eq 'ARRAY') {
352 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
354 push(@sqlf, $self->_make_as($to));
356 push(@sqlf, ' ON ', $self->_join_condition($on));
358 return join('', @sqlf);
362 my ($self, $sqlbind) = @_;
364 my @sqlbind = @$$sqlbind; # copy
365 my $sql = shift @sqlbind;
366 push @{$self->{from_bind}}, @sqlbind;
372 my ($self, $from) = @_;
373 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
374 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
376 } reverse each %{$self->_skip_options($from)});
380 my ($self, $hash) = @_;
382 $clean_hash->{$_} = $hash->{$_}
383 for grep {!/^-/} keys %$hash;
387 sub _join_condition {
388 my ($self, $cond) = @_;
389 if (ref $cond eq 'HASH') {
394 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
395 if ref($v) ne 'SCALAR';
399 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
402 return scalar($self->_recurse_where(\%j));
403 } elsif (ref $cond eq 'ARRAY') {
404 return join(' OR ', map { $self->_join_condition($_) } @$cond);
406 die "Can't handle this yet!";
411 my ($self, $label) = @_;
412 return '' unless defined $label;
413 return "*" if $label eq '*';
414 return $label unless $self->{quote_char};
415 if(ref $self->{quote_char} eq "ARRAY"){
416 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
417 if !defined $self->{name_sep};
418 my $sep = $self->{name_sep};
419 return join($self->{name_sep},
420 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
421 split(/\Q$sep\E/,$label));
423 return $self->SUPER::_quote($label);
428 $self->{limit_dialect} = shift if @_;
429 return $self->{limit_dialect};
434 $self->{quote_char} = shift if @_;
435 return $self->{quote_char};
440 $self->{name_sep} = shift if @_;
441 return $self->{name_sep};
452 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
453 and includes a number of DBIC-specific workarounds, not yet suitable for
454 inclusion into SQLA proper.
460 Tries to determine limit dialect.
464 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
465 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
467 =head2 insert update delete
469 Just quotes table names.
473 Specifies the dialect of used for implementing an SQL "limit" clause for
474 restricting the number of query results returned. Valid values are: RowNum.
476 See L<DBIx::Class::Storage::DBI/connect_info> for details.
480 Character separating quoted table names.
482 See L<DBIx::Class::Storage::DBI/connect_info> for details.
486 Set to an array-ref to specify separate left and right quotes for table names.
488 See L<DBIx::Class::Storage::DBI/connect_info> for details.