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);
72 # DB2 is the only remaining DB using this. Even though we are not sure if
73 # RowNumberOver is still needed here (should be part of SQLA) leave the
76 my ($self, $sql, $order, $rows, $offset ) = @_;
79 my $last = $rows + $offset - 1;
80 my ( $order_by ) = $self->_order_by( $order );
85 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
90 WHERE ROW_NUM BETWEEN $offset AND $last
98 # While we're at it, this should make LIMIT queries more efficient,
99 # without digging into things too deeply
101 my ($self, $syntax) = @_;
102 return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
106 my ($self, $table, $fields, $where, $order, @rest) = @_;
107 local $self->{having_bind} = [];
108 local $self->{from_bind} = [];
110 if (ref $table eq 'SCALAR') {
113 elsif (not ref $table) {
114 $table = $self->_quote($table);
116 local $self->{rownum_hack_count} = 1
117 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
118 @rest = (-1) unless defined $rest[0];
119 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
120 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
121 my ($sql, @where_bind) = $self->SUPER::select(
122 $table, $self->_recurse_fields($fields), $where, $order, @rest
127 $self->{for} eq 'update' ? ' FOR UPDATE' :
128 $self->{for} eq 'shared' ? ' FOR SHARE' :
133 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
139 $table = $self->_quote($table) unless ref($table);
140 $self->SUPER::insert($table, @_);
146 $table = $self->_quote($table) unless ref($table);
147 $self->SUPER::update($table, @_);
153 $table = $self->_quote($table) unless ref($table);
154 $self->SUPER::delete($table, @_);
160 return $_[1].$self->_order_by($_[2]);
162 return $self->SUPER::_emulate_limit(@_);
166 sub _recurse_fields {
167 my ($self, $fields, $params) = @_;
168 my $ref = ref $fields;
169 return $self->_quote($fields) unless $ref;
170 return $$fields if $ref eq 'SCALAR';
172 if ($ref eq 'ARRAY') {
173 return join(', ', map {
174 $self->_recurse_fields($_)
175 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
176 ? ' AS col'.$self->{rownum_hack_count}++
179 } elsif ($ref eq 'HASH') {
180 foreach my $func (keys %$fields) {
181 if ($func eq 'distinct') {
182 my $_fields = $fields->{$func};
183 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
185 'The select => { distinct => ... } syntax is not supported for multiple columns.'
186 .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
187 .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
191 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
193 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
194 ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
198 return $self->_sqlcase($func)
199 .'( '.$self->_recurse_fields($fields->{$func}).' )';
202 # Is the second check absolutely necessary?
203 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
204 return $self->_fold_sqlbind( $fields );
207 croak($ref . qq{ unexpected in _recurse_fields()})
215 if (ref $_[0] eq 'HASH') {
216 if (defined $_[0]->{group_by}) {
217 $ret = $self->_sqlcase(' group by ')
218 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
220 if (defined $_[0]->{having}) {
222 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
223 push(@{$self->{having_bind}}, @extra);
224 $ret .= $self->_sqlcase(' having ').$frag;
226 if (defined $_[0]->{order_by}) {
227 $ret .= $self->_order_by($_[0]->{order_by});
229 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
230 return $self->SUPER::_order_by($_[0]);
232 } elsif (ref $_[0] eq 'SCALAR') {
233 $ret = $self->_sqlcase(' order by ').${ $_[0] };
234 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
235 my @order = @{+shift};
236 $ret = $self->_sqlcase(' order by ')
238 my $r = $self->_order_by($_, @_);
239 $r =~ s/^ ?ORDER BY //i;
243 $ret = $self->SUPER::_order_by(@_);
248 sub _order_directions {
249 my ($self, $order) = @_;
250 return $self->SUPER::_order_directions( $self->_resolve_order($order) );
254 my ($self, $order) = @_;
255 $order = $order->{order_by} if (ref $order eq 'HASH' and $order->{order_by});
257 if (ref $order eq 'HASH') {
258 $order = [$self->_resolve_order_hash($order)];
260 elsif (ref $order eq 'ARRAY') {
262 if (ref ($_) eq 'SCALAR') {
265 elsif (ref ($_) eq 'HASH') {
266 $self->_resolve_order_hash($_)
277 sub _resolve_order_hash {
278 my ($self, $order) = @_;
280 foreach my $key (keys %{ $order }) {
281 if ($key =~ /^-(desc|asc)/i ) {
283 my $type = ref $order->{ $key };
284 if ($type eq 'ARRAY') {
285 push @new_order, map( "$_ $direction", @{ $order->{ $key } } );
287 push @new_order, "$order->{$key} $direction";
289 croak "hash order_by can only contain Scalar or Array, not $type";
292 croak "$key is not a valid direction, use -asc or -desc";
299 my ($self, $from) = @_;
300 if (ref $from eq 'ARRAY') {
301 return $self->_recurse_from(@$from);
302 } elsif (ref $from eq 'HASH') {
303 return $self->_make_as($from);
305 return $from; # would love to quote here but _table ends up getting called
306 # twice during an ->select without a limit clause due to
307 # the way S::A::Limit->select works. should maybe consider
308 # bypassing this and doing S::A::select($self, ...) in
309 # our select method above. meantime, quoting shims have
310 # been added to select/insert/update/delete here
315 my ($self, $from, @join) = @_;
317 push(@sqlf, $self->_make_as($from));
318 foreach my $j (@join) {
321 # check whether a join type exists
322 my $join_clause = '';
323 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
324 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
325 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
327 $join_clause = ' JOIN ';
329 push(@sqlf, $join_clause);
331 if (ref $to eq 'ARRAY') {
332 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
334 push(@sqlf, $self->_make_as($to));
336 push(@sqlf, ' ON ', $self->_join_condition($on));
338 return join('', @sqlf);
342 my ($self, $sqlbind) = @_;
344 my @sqlbind = @$$sqlbind; # copy
345 my $sql = shift @sqlbind;
346 push @{$self->{from_bind}}, @sqlbind;
352 my ($self, $from) = @_;
353 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
354 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
356 } reverse each %{$self->_skip_options($from)});
360 my ($self, $hash) = @_;
362 $clean_hash->{$_} = $hash->{$_}
363 for grep {!/^-/} keys %$hash;
367 sub _join_condition {
368 my ($self, $cond) = @_;
369 if (ref $cond eq 'HASH') {
374 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
375 if ref($v) ne 'SCALAR';
379 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
382 return scalar($self->_recurse_where(\%j));
383 } elsif (ref $cond eq 'ARRAY') {
384 return join(' OR ', map { $self->_join_condition($_) } @$cond);
386 die "Can't handle this yet!";
391 my ($self, $label) = @_;
392 return '' unless defined $label;
393 return "*" if $label eq '*';
394 return $label unless $self->{quote_char};
395 if(ref $self->{quote_char} eq "ARRAY"){
396 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
397 if !defined $self->{name_sep};
398 my $sep = $self->{name_sep};
399 return join($self->{name_sep},
400 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
401 split(/\Q$sep\E/,$label));
403 return $self->SUPER::_quote($label);
408 $self->{limit_dialect} = shift if @_;
409 return $self->{limit_dialect};
414 $self->{quote_char} = shift if @_;
415 return $self->{quote_char};
420 $self->{name_sep} = shift if @_;
421 return $self->{name_sep};
432 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
433 and includes a number of DBIC-specific workarounds, not yet suitable for
434 inclusion into SQLA proper.
440 Tries to determine limit dialect.
444 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
445 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
447 =head2 insert update delete
449 Just quotes table names.
453 Specifies the dialect of used for implementing an SQL "limit" clause for
454 restricting the number of query results returned. Valid values are: RowNum.
456 See L<DBIx::Class::Storage::DBI/connect_info> for details.
460 Character separating quoted table names.
462 See L<DBIx::Class::Storage::DBI/connect_info> for details.
466 Set to an array-ref to specify separate left and right quotes for table names.
468 See L<DBIx::Class::Storage::DBI/connect_info> for details.