1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks; # Would merge upstream, but nate doesn't reply :(
4 use base qw/SQL::Abstract::Limit/;
5 use Carp::Clan qw/^DBIx::Class/;
8 my $self = shift->SUPER::new(@_);
10 # This prevents the caching of $dbh in S::A::L, I believe
11 # If limit_dialect is a ref (like a $dbh), go ahead and replace
12 # it with what it resolves to:
13 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
14 if ref $self->{limit_dialect};
21 # Some databases (sqlite) do not handle multiple parenthesis
22 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
23 # is interpreted as x IN 1 or something similar.
25 # Since we currently do not have access to the SQLA AST, resort
26 # to barbaric mutilation of any SQL supplied in literal form
28 sub _strip_outer_paren {
29 my ($self, $arg) = @_;
31 return $self->_SWITCH_refkind ($arg, {
33 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
37 return \__strip_outer_paren( $$arg );
45 sub __strip_outer_paren {
48 if ($sql and not ref $sql) {
49 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
58 my ($self, $lhs, $op, $rhs) = @_;
59 $rhs = $self->_strip_outer_paren ($rhs);
60 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
63 sub _where_field_BETWEEN {
64 my ($self, $lhs, $op, $rhs) = @_;
65 $rhs = $self->_strip_outer_paren ($rhs);
66 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
71 # DB2 is the only remaining DB using this. Even though we are not sure if
72 # RowNumberOver is still needed here (should be part of SQLA) leave the
75 my ($self, $sql, $order, $rows, $offset ) = @_;
78 my $last = $rows + $offset;
79 my ( $order_by ) = $self->_order_by( $order );
84 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
89 WHERE ROW_NUM BETWEEN $offset AND $last
97 # While we're at it, this should make LIMIT queries more efficient,
98 # without digging into things too deeply
99 use Scalar::Util 'blessed';
101 my ($self, $syntax) = @_;
103 # DB2 is the only remaining DB using this. Even though we are not sure if
104 # RowNumberOver is still needed here (should be part of SQLA) leave the
106 my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
107 if(ref($self) && $dbhname && $dbhname eq 'DB2') {
108 return 'RowNumberOver';
111 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
115 my ($self, $table, $fields, $where, $order, @rest) = @_;
116 local $self->{having_bind} = [];
117 local $self->{from_bind} = [];
119 if (ref $table eq 'SCALAR') {
122 elsif (not ref $table) {
123 $table = $self->_quote($table);
125 local $self->{rownum_hack_count} = 1
126 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
127 @rest = (-1) unless defined $rest[0];
128 die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
129 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
130 my ($sql, @where_bind) = $self->SUPER::select(
131 $table, $self->_recurse_fields($fields), $where, $order, @rest
136 $self->{for} eq 'update' ? ' FOR UPDATE' :
137 $self->{for} eq 'shared' ? ' FOR SHARE' :
142 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
148 $table = $self->_quote($table) unless ref($table);
149 $self->SUPER::insert($table, @_);
155 $table = $self->_quote($table) unless ref($table);
156 $self->SUPER::update($table, @_);
162 $table = $self->_quote($table) unless ref($table);
163 $self->SUPER::delete($table, @_);
169 return $_[1].$self->_order_by($_[2]);
171 return $self->SUPER::_emulate_limit(@_);
175 sub _recurse_fields {
176 my ($self, $fields, $params) = @_;
177 my $ref = ref $fields;
178 return $self->_quote($fields) unless $ref;
179 return $$fields if $ref eq 'SCALAR';
181 if ($ref eq 'ARRAY') {
182 return join(', ', map {
183 $self->_recurse_fields($_)
184 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
185 ? ' AS col'.$self->{rownum_hack_count}++
188 } elsif ($ref eq 'HASH') {
189 foreach my $func (keys %$fields) {
190 if ($func eq 'distinct') {
191 my $_fields = $fields->{$func};
192 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
193 die "Unsupported syntax, please use " .
194 "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
196 "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
199 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
200 carp "This syntax will be deprecated in 09, please use " .
201 "{ group_by => '${_fields}' }" .
203 "{ select => '${_fields}', distinct => 1 }";
207 return $self->_sqlcase($func)
208 .'( '.$self->_recurse_fields($fields->{$func}).' )';
211 # Is the second check absolutely necessary?
212 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
213 return $self->_fold_sqlbind( $fields );
216 Carp::croak($ref . qq{ unexpected in _recurse_fields()})
224 if (ref $_[0] eq 'HASH') {
225 if (defined $_[0]->{group_by}) {
226 $ret = $self->_sqlcase(' group by ')
227 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
229 if (defined $_[0]->{having}) {
231 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
232 push(@{$self->{having_bind}}, @extra);
233 $ret .= $self->_sqlcase(' having ').$frag;
235 if (defined $_[0]->{order_by}) {
236 $ret .= $self->_order_by($_[0]->{order_by});
238 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
239 return $self->SUPER::_order_by($_[0]);
241 } elsif (ref $_[0] eq 'SCALAR') {
242 $ret = $self->_sqlcase(' order by ').${ $_[0] };
243 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
244 my @order = @{+shift};
245 $ret = $self->_sqlcase(' order by ')
247 my $r = $self->_order_by($_, @_);
248 $r =~ s/^ ?ORDER BY //i;
252 $ret = $self->SUPER::_order_by(@_);
257 sub _order_directions {
258 my ($self, $order) = @_;
259 $order = $order->{order_by} if ref $order eq 'HASH';
260 return $self->SUPER::_order_directions($order);
264 my ($self, $from) = @_;
265 if (ref $from eq 'ARRAY') {
266 return $self->_recurse_from(@$from);
267 } elsif (ref $from eq 'HASH') {
268 return $self->_make_as($from);
270 return $from; # would love to quote here but _table ends up getting called
271 # twice during an ->select without a limit clause due to
272 # the way S::A::Limit->select works. should maybe consider
273 # bypassing this and doing S::A::select($self, ...) in
274 # our select method above. meantime, quoting shims have
275 # been added to select/insert/update/delete here
280 my ($self, $from, @join) = @_;
282 push(@sqlf, $self->_make_as($from));
283 foreach my $j (@join) {
286 # check whether a join type exists
287 my $join_clause = '';
288 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
289 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
290 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
292 $join_clause = ' JOIN ';
294 push(@sqlf, $join_clause);
296 if (ref $to eq 'ARRAY') {
297 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
299 push(@sqlf, $self->_make_as($to));
301 push(@sqlf, ' ON ', $self->_join_condition($on));
303 return join('', @sqlf);
307 my ($self, $sqlbind) = @_;
308 my $sql = shift @$$sqlbind;
309 push @{$self->{from_bind}}, @$$sqlbind;
314 my ($self, $from) = @_;
315 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
316 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
318 } reverse each %{$self->_skip_options($from)});
322 my ($self, $hash) = @_;
324 $clean_hash->{$_} = $hash->{$_}
325 for grep {!/^-/} keys %$hash;
329 sub _join_condition {
330 my ($self, $cond) = @_;
331 if (ref $cond eq 'HASH') {
336 # XXX no throw_exception() in this package and croak() fails with strange results
337 Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
338 if ref($v) ne 'SCALAR';
342 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
345 return scalar($self->_recurse_where(\%j));
346 } elsif (ref $cond eq 'ARRAY') {
347 return join(' OR ', map { $self->_join_condition($_) } @$cond);
349 die "Can't handle this yet!";
354 my ($self, $label) = @_;
355 return '' unless defined $label;
356 return "*" if $label eq '*';
357 return $label unless $self->{quote_char};
358 if(ref $self->{quote_char} eq "ARRAY"){
359 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
360 if !defined $self->{name_sep};
361 my $sep = $self->{name_sep};
362 return join($self->{name_sep},
363 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
364 split(/\Q$sep\E/,$label));
366 return $self->SUPER::_quote($label);
371 $self->{limit_dialect} = shift if @_;
372 return $self->{limit_dialect};
377 $self->{quote_char} = shift if @_;
378 return $self->{quote_char};
383 $self->{name_sep} = shift if @_;
384 return $self->{name_sep};
395 DBIx::Class::SQLAHacks - Things desired to be merged into SQL::Abstract
401 Tries to determine limit dialect.
405 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
406 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
408 =head2 insert update delete
410 Just quotes table names.
414 Specifies the dialect of used for implementing an SQL "limit" clause for
415 restricting the number of query results returned. Valid values are: RowNum.
417 See L<DBIx::Class::Storage::DBI/connect_info> for details.
421 Character separating quoted table names.
423 See L<DBIx::Class::Storage::DBI/connect_info> for details.
427 Set to an array-ref to specify separate left and right quotes for table names.
429 See L<DBIx::Class::Storage::DBI/connect_info> for details.