2 package # Hide from PAUSE
3 DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
6 use base qw/SQL::Abstract::Limit/;
9 my $self = shift->SUPER::new(@_);
11 # This prevents the caching of $dbh in S::A::L, I believe
12 # If limit_dialect is a ref (like a $dbh), go ahead and replace
13 # it with what it resolves to:
14 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
15 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 if (ref $table eq 'SCALAR') {
120 elsif (not ref $table) {
121 $table = $self->_quote($table);
123 local $self->{rownum_hack_count} = 1
124 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
125 @rest = (-1) unless defined $rest[0];
126 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
127 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
128 local $self->{having_bind} = [];
129 my ($sql, @ret) = $self->SUPER::select(
130 $table, $self->_recurse_fields($fields), $where, $order, @rest
135 $self->{for} eq 'update' ? ' FOR UPDATE' :
136 $self->{for} eq 'shared' ? ' FOR SHARE' :
141 return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
147 $table = $self->_quote($table) unless ref($table);
148 $self->SUPER::insert($table, @_);
154 $table = $self->_quote($table) unless ref($table);
155 $self->SUPER::update($table, @_);
161 $table = $self->_quote($table) unless ref($table);
162 $self->SUPER::delete($table, @_);
168 return $_[1].$self->_order_by($_[2]);
170 return $self->SUPER::_emulate_limit(@_);
174 sub _recurse_fields {
175 my ($self, $fields, $params) = @_;
176 my $ref = ref $fields;
177 return $self->_quote($fields) unless $ref;
178 return $$fields if $ref eq 'SCALAR';
180 if ($ref eq 'ARRAY') {
181 return join(', ', map {
182 $self->_recurse_fields($_)
183 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
184 ? ' AS col'.$self->{rownum_hack_count}++
187 } elsif ($ref eq 'HASH') {
188 foreach my $func (keys %$fields) {
189 return $self->_sqlcase($func)
190 .'( '.$self->_recurse_fields($fields->{$func}).' )';
193 # Is the second check absolutely necessary?
194 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
195 return $self->_bind_to_sql( $fields );
198 Carp::croak($ref . qq{ unexpected in _recurse_fields()})
206 if (ref $_[0] eq 'HASH') {
207 if (defined $_[0]->{group_by}) {
208 $ret = $self->_sqlcase(' group by ')
209 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
211 if (defined $_[0]->{having}) {
213 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
214 push(@{$self->{having_bind}}, @extra);
215 $ret .= $self->_sqlcase(' having ').$frag;
217 if (defined $_[0]->{order_by}) {
218 $ret .= $self->_order_by($_[0]->{order_by});
220 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
221 return $self->SUPER::_order_by($_[0]);
223 } elsif (ref $_[0] eq 'SCALAR') {
224 $ret = $self->_sqlcase(' order by ').${ $_[0] };
225 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
226 my @order = @{+shift};
227 $ret = $self->_sqlcase(' order by ')
229 my $r = $self->_order_by($_, @_);
230 $r =~ s/^ ?ORDER BY //i;
234 $ret = $self->SUPER::_order_by(@_);
239 sub _order_directions {
240 my ($self, $order) = @_;
241 $order = $order->{order_by} if ref $order eq 'HASH';
242 return $self->SUPER::_order_directions($order);
246 my ($self, $from) = @_;
247 if (ref $from eq 'ARRAY') {
248 return $self->_recurse_from(@$from);
249 } elsif (ref $from eq 'HASH') {
250 return $self->_make_as($from);
252 return $from; # would love to quote here but _table ends up getting called
253 # twice during an ->select without a limit clause due to
254 # the way S::A::Limit->select works. should maybe consider
255 # bypassing this and doing S::A::select($self, ...) in
256 # our select method above. meantime, quoting shims have
257 # been added to select/insert/update/delete here
262 my ($self, $from, @join) = @_;
264 push(@sqlf, $self->_make_as($from));
265 foreach my $j (@join) {
268 # check whether a join type exists
269 my $join_clause = '';
270 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
271 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
272 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
274 $join_clause = ' JOIN ';
276 push(@sqlf, $join_clause);
278 if (ref $to eq 'ARRAY') {
279 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
281 push(@sqlf, $self->_make_as($to));
283 push(@sqlf, ' ON ', $self->_join_condition($on));
285 return join('', @sqlf);
291 my $sql = shift @$$arr;
292 $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
297 my ($self, $from) = @_;
298 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
299 : ref $_ eq 'REF' ? $self->_bind_to_sql($_)
301 } reverse each %{$self->_skip_options($from)});
305 my ($self, $hash) = @_;
307 $clean_hash->{$_} = $hash->{$_}
308 for grep {!/^-/} keys %$hash;
312 sub _join_condition {
313 my ($self, $cond) = @_;
314 if (ref $cond eq 'HASH') {
319 # XXX no throw_exception() in this package and croak() fails with strange results
320 Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
321 if ref($v) ne 'SCALAR';
325 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
328 return scalar($self->_recurse_where(\%j));
329 } elsif (ref $cond eq 'ARRAY') {
330 return join(' OR ', map { $self->_join_condition($_) } @$cond);
332 die "Can't handle this yet!";
337 my ($self, $label) = @_;
338 return '' unless defined $label;
339 return "*" if $label eq '*';
340 return $label unless $self->{quote_char};
341 if(ref $self->{quote_char} eq "ARRAY"){
342 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
343 if !defined $self->{name_sep};
344 my $sep = $self->{name_sep};
345 return join($self->{name_sep},
346 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
347 split(/\Q$sep\E/,$label));
349 return $self->SUPER::_quote($label);
354 $self->{limit_dialect} = shift if @_;
355 return $self->{limit_dialect};
360 $self->{quote_char} = shift if @_;
361 return $self->{quote_char};
366 $self->{name_sep} = shift if @_;
367 return $self->{name_sep};
378 DBIx::Class::SQLAHacks - Things desired to be merged into SQL::Abstract
384 Tries to determine limit dialect.
388 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
389 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
391 =head2 insert update delete
393 Just quotes table names.
397 Specifies the dialect of used for implementing an SQL "limit" clause for
398 restricting the number of query results returned. Valid values are: RowNum.
400 See L<DBIx::Class::Storage::DBI/connect_info> for details.
404 Character separating quoted table names.
406 See L<DBIx::Class::Storage::DBI/connect_info> for details.
410 Set to an array-ref to specify separate left and right quotes for table names.
412 See L<DBIx::Class::Storage::DBI/connect_info> for details.