1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks;
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};
20 # Some databases (sqlite) do not handle multiple parenthesis
21 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
22 # is interpreted as x IN 1 or something similar.
24 # Since we currently do not have access to the SQLA AST, resort
25 # to barbaric mutilation of any SQL supplied in literal form
27 sub _strip_outer_paren {
28 my ($self, $arg) = @_;
30 return $self->_SWITCH_refkind ($arg, {
32 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
36 return \__strip_outer_paren( $$arg );
44 sub __strip_outer_paren {
47 if ($sql and not ref $sql) {
48 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
57 my ($self, $lhs, $op, $rhs) = @_;
58 $rhs = $self->_strip_outer_paren ($rhs);
59 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
62 sub _where_field_BETWEEN {
63 my ($self, $lhs, $op, $rhs) = @_;
64 $rhs = $self->_strip_outer_paren ($rhs);
65 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
70 # DB2 is the only remaining DB using this. Even though we are not sure if
71 # RowNumberOver is still needed here (should be part of SQLA) leave the
74 my ($self, $sql, $order, $rows, $offset ) = @_;
77 my $last = $rows + $offset;
78 my ( $order_by ) = $self->_order_by( $order );
83 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
88 WHERE ROW_NUM BETWEEN $offset AND $last
96 # While we're at it, this should make LIMIT queries more efficient,
97 # without digging into things too deeply
98 use Scalar::Util 'blessed';
100 my ($self, $syntax) = @_;
102 # DB2 is the only remaining DB using this. Even though we are not sure if
103 # RowNumberOver is still needed here (should be part of SQLA) leave the
105 my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
106 if(ref($self) && $dbhname && $dbhname eq 'DB2') {
107 return 'RowNumberOver';
110 $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
114 my ($self, $table, $fields, $where, $order, @rest) = @_;
115 local $self->{having_bind} = [];
116 local $self->{from_bind} = [];
118 if (ref $table eq 'SCALAR') {
121 elsif (not ref $table) {
122 $table = $self->_quote($table);
124 local $self->{rownum_hack_count} = 1
125 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
126 @rest = (-1) unless defined $rest[0];
127 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
128 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
129 my ($sql, @where_bind) = $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, @{$self->{from_bind}}, @where_bind, @{$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 if ($func eq 'distinct') {
190 my $_fields = $fields->{$func};
191 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
192 croak "Unsupported syntax, please use " .
193 "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
195 "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
198 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
199 carp "This syntax will be deprecated in 09, please use " .
200 "{ group_by => '${_fields}' }" .
202 "{ select => '${_fields}', distinct => 1 }";
206 return $self->_sqlcase($func)
207 .'( '.$self->_recurse_fields($fields->{$func}).' )';
210 # Is the second check absolutely necessary?
211 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
212 return $self->_fold_sqlbind( $fields );
215 croak($ref . qq{ unexpected in _recurse_fields()})
223 if (ref $_[0] eq 'HASH') {
224 if (defined $_[0]->{group_by}) {
225 $ret = $self->_sqlcase(' group by ')
226 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
228 if (defined $_[0]->{having}) {
230 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
231 push(@{$self->{having_bind}}, @extra);
232 $ret .= $self->_sqlcase(' having ').$frag;
234 if (defined $_[0]->{order_by}) {
235 $ret .= $self->_order_by($_[0]->{order_by});
237 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
238 return $self->SUPER::_order_by($_[0]);
240 } elsif (ref $_[0] eq 'SCALAR') {
241 $ret = $self->_sqlcase(' order by ').${ $_[0] };
242 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
243 my @order = @{+shift};
244 $ret = $self->_sqlcase(' order by ')
246 my $r = $self->_order_by($_, @_);
247 $r =~ s/^ ?ORDER BY //i;
251 $ret = $self->SUPER::_order_by(@_);
256 sub _order_directions {
257 my ($self, $order) = @_;
258 $order = $order->{order_by} if ref $order eq 'HASH';
259 return $self->SUPER::_order_directions($order);
263 my ($self, $from) = @_;
264 if (ref $from eq 'ARRAY') {
265 return $self->_recurse_from(@$from);
266 } elsif (ref $from eq 'HASH') {
267 return $self->_make_as($from);
269 return $from; # would love to quote here but _table ends up getting called
270 # twice during an ->select without a limit clause due to
271 # the way S::A::Limit->select works. should maybe consider
272 # bypassing this and doing S::A::select($self, ...) in
273 # our select method above. meantime, quoting shims have
274 # been added to select/insert/update/delete here
279 my ($self, $from, @join) = @_;
281 push(@sqlf, $self->_make_as($from));
282 foreach my $j (@join) {
285 # check whether a join type exists
286 my $join_clause = '';
287 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
288 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
289 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
291 $join_clause = ' JOIN ';
293 push(@sqlf, $join_clause);
295 if (ref $to eq 'ARRAY') {
296 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
298 push(@sqlf, $self->_make_as($to));
300 push(@sqlf, ' ON ', $self->_join_condition($on));
302 return join('', @sqlf);
306 my ($self, $sqlbind) = @_;
307 my $sql = shift @$$sqlbind;
308 push @{$self->{from_bind}}, @$$sqlbind;
313 my ($self, $from) = @_;
314 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
315 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
317 } reverse each %{$self->_skip_options($from)});
321 my ($self, $hash) = @_;
323 $clean_hash->{$_} = $hash->{$_}
324 for grep {!/^-/} keys %$hash;
328 sub _join_condition {
329 my ($self, $cond) = @_;
330 if (ref $cond eq 'HASH') {
335 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
336 if ref($v) ne 'SCALAR';
340 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
343 return scalar($self->_recurse_where(\%j));
344 } elsif (ref $cond eq 'ARRAY') {
345 return join(' OR ', map { $self->_join_condition($_) } @$cond);
347 die "Can't handle this yet!";
352 my ($self, $label) = @_;
353 return '' unless defined $label;
354 return "*" if $label eq '*';
355 return $label unless $self->{quote_char};
356 if(ref $self->{quote_char} eq "ARRAY"){
357 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
358 if !defined $self->{name_sep};
359 my $sep = $self->{name_sep};
360 return join($self->{name_sep},
361 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
362 split(/\Q$sep\E/,$label));
364 return $self->SUPER::_quote($label);
369 $self->{limit_dialect} = shift if @_;
370 return $self->{limit_dialect};
375 $self->{quote_char} = shift if @_;
376 return $self->{quote_char};
381 $self->{name_sep} = shift if @_;
382 return $self->{name_sep};
393 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
394 and includes a number of DBIC-specific workarounds, not yet suitable for
395 inclusion into SQLA proper.
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.