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;
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
100 use Scalar::Util 'blessed';
102 my ($self, $syntax) = @_;
104 # DB2 is the only remaining DB using this. Even though we are not sure if
105 # RowNumberOver is still needed here (should be part of SQLA) leave the
107 my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
108 if(ref($self) && $dbhname && $dbhname eq 'DB2') {
109 return 'RowNumberOver';
112 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
116 my ($self, $table, $fields, $where, $order, @rest) = @_;
117 local $self->{having_bind} = [];
118 local $self->{from_bind} = [];
120 if (ref $table eq 'SCALAR') {
123 elsif (not ref $table) {
124 $table = $self->_quote($table);
126 local $self->{rownum_hack_count} = 1
127 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
128 @rest = (-1) unless defined $rest[0];
129 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
130 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
131 my ($sql, @where_bind) = $self->SUPER::select(
132 $table, $self->_recurse_fields($fields), $where, $order, @rest
137 $self->{for} eq 'update' ? ' FOR UPDATE' :
138 $self->{for} eq 'shared' ? ' FOR SHARE' :
143 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
149 $table = $self->_quote($table) unless ref($table);
150 $self->SUPER::insert($table, @_);
156 $table = $self->_quote($table) unless ref($table);
157 $self->SUPER::update($table, @_);
163 $table = $self->_quote($table) unless ref($table);
164 $self->SUPER::delete($table, @_);
170 return $_[1].$self->_order_by($_[2]);
172 return $self->SUPER::_emulate_limit(@_);
176 sub _recurse_fields {
177 my ($self, $fields, $params) = @_;
178 my $ref = ref $fields;
179 return $self->_quote($fields) unless $ref;
180 return $$fields if $ref eq 'SCALAR';
182 if ($ref eq 'ARRAY') {
183 return join(', ', map {
184 $self->_recurse_fields($_)
185 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
186 ? ' AS col'.$self->{rownum_hack_count}++
189 } elsif ($ref eq 'HASH') {
190 foreach my $func (keys %$fields) {
191 if ($func eq 'distinct') {
192 my $_fields = $fields->{$func};
193 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
194 croak "Unsupported syntax, please use " .
195 "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
197 "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
200 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
201 carp "This syntax will be deprecated in 09, please use " .
202 "{ group_by => '${_fields}' }" .
204 "{ select => '${_fields}', distinct => 1 }";
208 return $self->_sqlcase($func)
209 .'( '.$self->_recurse_fields($fields->{$func}).' )';
212 # Is the second check absolutely necessary?
213 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
214 return $self->_fold_sqlbind( $fields );
217 croak($ref . qq{ unexpected in _recurse_fields()})
225 if (ref $_[0] eq 'HASH') {
226 if (defined $_[0]->{group_by}) {
227 $ret = $self->_sqlcase(' group by ')
228 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
230 if (defined $_[0]->{having}) {
232 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
233 push(@{$self->{having_bind}}, @extra);
234 $ret .= $self->_sqlcase(' having ').$frag;
236 if (defined $_[0]->{order_by}) {
237 $ret .= $self->_order_by($_[0]->{order_by});
239 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
240 return $self->SUPER::_order_by($_[0]);
242 } elsif (ref $_[0] eq 'SCALAR') {
243 $ret = $self->_sqlcase(' order by ').${ $_[0] };
244 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
245 my @order = @{+shift};
246 $ret = $self->_sqlcase(' order by ')
248 my $r = $self->_order_by($_, @_);
249 $r =~ s/^ ?ORDER BY //i;
253 $ret = $self->SUPER::_order_by(@_);
258 sub _order_directions {
259 my ($self, $order) = @_;
260 $order = $order->{order_by} if ref $order eq 'HASH';
261 if (ref $order eq 'HASH') {
262 $order = [$self->_order_directions_hash($order)];
263 } elsif (ref $order eq 'ARRAY') {
265 if (ref $_ eq 'HASH') {
266 $self->_order_directions_hash($_);
272 return $self->SUPER::_order_directions($order);
275 sub _order_directions_hash {
276 my ($self, $order) = @_;
278 foreach my $key (keys %{ $order }) {
279 if ($key =~ /^-(desc|asc)/i ) {
281 my $type = ref $order->{ $key };
282 if ($type eq 'ARRAY') {
283 push @new_order, map( "$_ $direction", @{ $order->{ $key } } );
285 push @new_order, "$order->{$key} $direction";
287 croak "hash order_by can only contain Scalar or Array, not $type";
290 croak "$key is not a valid direction, use -asc or -desc";
297 my ($self, $from) = @_;
298 if (ref $from eq 'ARRAY') {
299 return $self->_recurse_from(@$from);
300 } elsif (ref $from eq 'HASH') {
301 return $self->_make_as($from);
303 return $from; # would love to quote here but _table ends up getting called
304 # twice during an ->select without a limit clause due to
305 # the way S::A::Limit->select works. should maybe consider
306 # bypassing this and doing S::A::select($self, ...) in
307 # our select method above. meantime, quoting shims have
308 # been added to select/insert/update/delete here
313 my ($self, $from, @join) = @_;
315 push(@sqlf, $self->_make_as($from));
316 foreach my $j (@join) {
319 # check whether a join type exists
320 my $join_clause = '';
321 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
322 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
323 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
325 $join_clause = ' JOIN ';
327 push(@sqlf, $join_clause);
329 if (ref $to eq 'ARRAY') {
330 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
332 push(@sqlf, $self->_make_as($to));
334 push(@sqlf, ' ON ', $self->_join_condition($on));
336 return join('', @sqlf);
340 my ($self, $sqlbind) = @_;
341 my $sql = shift @$$sqlbind;
342 push @{$self->{from_bind}}, @$$sqlbind;
347 my ($self, $from) = @_;
348 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
349 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
351 } reverse each %{$self->_skip_options($from)});
355 my ($self, $hash) = @_;
357 $clean_hash->{$_} = $hash->{$_}
358 for grep {!/^-/} keys %$hash;
362 sub _join_condition {
363 my ($self, $cond) = @_;
364 if (ref $cond eq 'HASH') {
369 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
370 if ref($v) ne 'SCALAR';
374 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
377 return scalar($self->_recurse_where(\%j));
378 } elsif (ref $cond eq 'ARRAY') {
379 return join(' OR ', map { $self->_join_condition($_) } @$cond);
381 die "Can't handle this yet!";
386 my ($self, $label) = @_;
387 return '' unless defined $label;
388 return "*" if $label eq '*';
389 return $label unless $self->{quote_char};
390 if(ref $self->{quote_char} eq "ARRAY"){
391 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
392 if !defined $self->{name_sep};
393 my $sep = $self->{name_sep};
394 return join($self->{name_sep},
395 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
396 split(/\Q$sep\E/,$label));
398 return $self->SUPER::_quote($label);
403 $self->{limit_dialect} = shift if @_;
404 return $self->{limit_dialect};
409 $self->{quote_char} = shift if @_;
410 return $self->{quote_char};
415 $self->{name_sep} = shift if @_;
416 return $self->{name_sep};
427 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
428 and includes a number of DBIC-specific workarounds, not yet suitable for
429 inclusion into SQLA proper.
435 Tries to determine limit dialect.
439 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
440 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
442 =head2 insert update delete
444 Just quotes table names.
448 Specifies the dialect of used for implementing an SQL "limit" clause for
449 restricting the number of query results returned. Valid values are: RowNum.
451 See L<DBIx::Class::Storage::DBI/connect_info> for details.
455 Character separating quoted table names.
457 See L<DBIx::Class::Storage::DBI/connect_info> for details.
461 Set to an array-ref to specify separate left and right quotes for table names.
463 See L<DBIx::Class::Storage::DBI/connect_info> for details.