1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks;
4 use base qw/SQL::Abstract::Limit/;
7 use Carp::Clan qw/^DBIx::Class/;
10 my $self = shift->SUPER::new(@_);
12 # This prevents the caching of $dbh in S::A::L, I believe
13 # If limit_dialect is a ref (like a $dbh), go ahead and replace
14 # it with what it resolves to:
15 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
16 if ref $self->{limit_dialect};
22 # Some databases (sqlite) do not handle multiple parenthesis
23 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
24 # is interpreted as x IN 1 or something similar.
26 # Since we currently do not have access to the SQLA AST, resort
27 # to barbaric mutilation of any SQL supplied in literal form
29 sub _strip_outer_paren {
30 my ($self, $arg) = @_;
32 return $self->_SWITCH_refkind ($arg, {
34 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
38 return \__strip_outer_paren( $$arg );
46 sub __strip_outer_paren {
49 if ($sql and not ref $sql) {
50 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
59 my ($self, $lhs, $op, $rhs) = @_;
60 $rhs = $self->_strip_outer_paren ($rhs);
61 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
64 sub _where_field_BETWEEN {
65 my ($self, $lhs, $op, $rhs) = @_;
66 $rhs = $self->_strip_outer_paren ($rhs);
67 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
70 # Slow but ANSI standard Limit/Offset support. DB2 uses this
72 my ($self, $sql, $order, $rows, $offset ) = @_;
75 my $last = $rows + $offset - 1;
76 my ( $order_by ) = $self->_order_by( $order );
81 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
86 WHERE ROW_NUM BETWEEN $offset AND $last
93 # Crappy Top based Limit/Offset support. MSSQL uses this currently,
94 # but may have to switch to RowNumberOver one day
96 my ( $self, $sql, $order, $rows, $offset ) = @_;
98 croak '$order supplied to SQLAHacks limit emulators must be a hash'
99 if (ref $order ne 'HASH');
101 $order = { %$order }; #copy
103 my $last = $rows + $offset;
105 my $req_order = $self->_order_by ($order->{order_by});
106 my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by};
108 delete $order->{$_} for qw/order_by _virtual_order_by/;
109 my $grpby_having = $self->_order_by ($order);
111 my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
113 $sql =~ s/^\s*(SELECT|select)//;
118 SELECT TOP $rows * FROM
120 SELECT TOP $last $sql $grpby_having $order_by_inner
132 # While we're at it, this should make LIMIT queries more efficient,
133 # without digging into things too deeply
135 my ($self, $syntax) = @_;
136 return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
140 my ($self, $table, $fields, $where, $order, @rest) = @_;
141 local $self->{having_bind} = [];
142 local $self->{from_bind} = [];
144 if (ref $table eq 'SCALAR') {
147 elsif (not ref $table) {
148 $table = $self->_quote($table);
150 local $self->{rownum_hack_count} = 1
151 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
152 @rest = (-1) unless defined $rest[0];
153 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
154 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
155 my ($sql, @where_bind) = $self->SUPER::select(
156 $table, $self->_recurse_fields($fields), $where, $order, @rest
161 $self->{for} eq 'update' ? ' FOR UPDATE' :
162 $self->{for} eq 'shared' ? ' FOR SHARE' :
167 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
173 $table = $self->_quote($table) unless ref($table);
174 $self->SUPER::insert($table, @_);
180 $table = $self->_quote($table) unless ref($table);
181 $self->SUPER::update($table, @_);
187 $table = $self->_quote($table) unless ref($table);
188 $self->SUPER::delete($table, @_);
194 return $_[1].$self->_order_by($_[2]);
196 return $self->SUPER::_emulate_limit(@_);
200 sub _recurse_fields {
201 my ($self, $fields, $params) = @_;
202 my $ref = ref $fields;
203 return $self->_quote($fields) unless $ref;
204 return $$fields if $ref eq 'SCALAR';
206 if ($ref eq 'ARRAY') {
207 return join(', ', map {
208 $self->_recurse_fields($_)
209 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
210 ? ' AS col'.$self->{rownum_hack_count}++
213 } elsif ($ref eq 'HASH') {
214 foreach my $func (keys %$fields) {
215 if ($func eq 'distinct') {
216 my $_fields = $fields->{$func};
217 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
219 'The select => { distinct => ... } syntax is not supported for multiple columns.'
220 .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
221 .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
225 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
227 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
228 ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
232 return $self->_sqlcase($func)
233 .'( '.$self->_recurse_fields($fields->{$func}).' )';
236 # Is the second check absolutely necessary?
237 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
238 return $self->_fold_sqlbind( $fields );
241 croak($ref . qq{ unexpected in _recurse_fields()})
249 if (ref $_[0] eq 'HASH') {
251 if (defined $_[0]->{group_by}) {
252 $ret = $self->_sqlcase(' group by ')
253 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
256 if (defined $_[0]->{having}) {
258 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
259 push(@{$self->{having_bind}}, @extra);
260 $ret .= $self->_sqlcase(' having ').$frag;
263 if (defined $_[0]->{order_by}) {
264 $ret .= $self->_order_by($_[0]->{order_by});
267 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
268 return $self->SUPER::_order_by($_[0]);
271 } elsif (ref $_[0] eq 'SCALAR') {
272 $ret = $self->_sqlcase(' order by ').${ $_[0] };
273 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
275 my $r = $self->_order_by($_, @_);
276 $r =~ s/^ ?ORDER BY //i;
280 $ret = $self->_sqlcase(' order by ') . join(', ', @order) if @order;
283 $ret = $self->SUPER::_order_by(@_);
288 sub _order_directions {
289 my ($self, $order) = @_;
290 return $self->SUPER::_order_directions( $self->_resolve_order($order) );
294 my ($self, $order) = @_;
296 if (ref $order eq 'HASH') {
297 $order = [$self->_resolve_order_hash($order)];
299 elsif (ref $order eq 'ARRAY') {
301 if (ref ($_) eq 'SCALAR') {
304 elsif (ref ($_) eq 'HASH') {
305 $self->_resolve_order_hash($_)
316 sub _resolve_order_hash {
317 my ($self, $order) = @_;
319 foreach my $key (keys %{ $order }) {
320 if ($key =~ /^-(desc|asc)/i ) {
322 my $type = ref $order->{ $key };
323 if ($type eq 'ARRAY') {
324 push @new_order, map( "$_ $direction", @{ $order->{ $key } } );
326 push @new_order, "$order->{$key} $direction";
328 croak "hash order_by can only contain Scalar or Array, not $type";
331 croak "$key is not a valid direction, use -asc or -desc";
339 my ($self, $from) = @_;
340 if (ref $from eq 'ARRAY') {
341 return $self->_recurse_from(@$from);
342 } elsif (ref $from eq 'HASH') {
343 return $self->_make_as($from);
345 return $from; # would love to quote here but _table ends up getting called
346 # twice during an ->select without a limit clause due to
347 # the way S::A::Limit->select works. should maybe consider
348 # bypassing this and doing S::A::select($self, ...) in
349 # our select method above. meantime, quoting shims have
350 # been added to select/insert/update/delete here
355 my ($self, $from, @join) = @_;
357 push(@sqlf, $self->_make_as($from));
358 foreach my $j (@join) {
361 # check whether a join type exists
362 my $join_clause = '';
363 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
364 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
365 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
367 $join_clause = ' JOIN ';
369 push(@sqlf, $join_clause);
371 if (ref $to eq 'ARRAY') {
372 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
374 push(@sqlf, $self->_make_as($to));
376 push(@sqlf, ' ON ', $self->_join_condition($on));
378 return join('', @sqlf);
382 my ($self, $sqlbind) = @_;
384 my @sqlbind = @$$sqlbind; # copy
385 my $sql = shift @sqlbind;
386 push @{$self->{from_bind}}, @sqlbind;
392 my ($self, $from) = @_;
393 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
394 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
396 } reverse each %{$self->_skip_options($from)});
400 my ($self, $hash) = @_;
402 $clean_hash->{$_} = $hash->{$_}
403 for grep {!/^-/} keys %$hash;
407 sub _join_condition {
408 my ($self, $cond) = @_;
409 if (ref $cond eq 'HASH') {
414 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
415 if ref($v) ne 'SCALAR';
419 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
422 return scalar($self->_recurse_where(\%j));
423 } elsif (ref $cond eq 'ARRAY') {
424 return join(' OR ', map { $self->_join_condition($_) } @$cond);
426 die "Can't handle this yet!";
431 my ($self, $label) = @_;
432 return '' unless defined $label;
433 return "*" if $label eq '*';
434 return $label unless $self->{quote_char};
435 if(ref $self->{quote_char} eq "ARRAY"){
436 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
437 if !defined $self->{name_sep};
438 my $sep = $self->{name_sep};
439 return join($self->{name_sep},
440 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
441 split(/\Q$sep\E/,$label));
443 return $self->SUPER::_quote($label);
448 $self->{limit_dialect} = shift if @_;
449 return $self->{limit_dialect};
454 $self->{quote_char} = shift if @_;
455 return $self->{quote_char};
460 $self->{name_sep} = shift if @_;
461 return $self->{name_sep};
472 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
473 and includes a number of DBIC-specific workarounds, not yet suitable for
474 inclusion into SQLA proper.
480 Tries to determine limit dialect.
484 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
485 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
487 =head2 insert update delete
489 Just quotes table names.
493 Specifies the dialect of used for implementing an SQL "limit" clause for
494 restricting the number of query results returned. Valid values are: RowNum.
496 See L<DBIx::Class::Storage::DBI/connect_info> for details.
500 Character separating quoted table names.
502 See L<DBIx::Class::Storage::DBI/connect_info> for details.
506 Set to an array-ref to specify separate left and right quotes for table names.
508 See L<DBIx::Class::Storage::DBI/connect_info> for details.