1 package # Hide from PAUSE
2 DBIx::Class::SQLAHacks;
4 use base qw/SQL::Abstract::Limit/;
7 use Carp::Clan qw/^DBIx::Class/;
11 my $self = shift->SUPER::new(@_);
13 # This prevents the caching of $dbh in S::A::L, I believe
14 # If limit_dialect is a ref (like a $dbh), go ahead and replace
15 # it with what it resolves to:
16 $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
17 if ref $self->{limit_dialect};
23 # Some databases (sqlite) do not handle multiple parenthesis
24 # around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
25 # is interpreted as x IN 1 or something similar.
27 # Since we currently do not have access to the SQLA AST, resort
28 # to barbaric mutilation of any SQL supplied in literal form
30 sub _strip_outer_paren {
31 my ($self, $arg) = @_;
33 return $self->_SWITCH_refkind ($arg, {
35 $$arg->[0] = __strip_outer_paren ($$arg->[0]);
39 return \__strip_outer_paren( $$arg );
47 sub __strip_outer_paren {
50 if ($sql and not ref $sql) {
51 while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
60 my ($self, $lhs, $op, $rhs) = @_;
61 $rhs = $self->_strip_outer_paren ($rhs);
62 return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
65 sub _where_field_BETWEEN {
66 my ($self, $lhs, $op, $rhs) = @_;
67 $rhs = $self->_strip_outer_paren ($rhs);
68 return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
71 # Slow but ANSI standard Limit/Offset support. DB2 uses this
73 my ($self, $sql, $order, $rows, $offset ) = @_;
76 my $last = $rows + $offset - 1;
77 my ( $order_by ) = $self->_order_by( $order );
82 SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
87 WHERE ROW_NUM BETWEEN $offset AND $last
94 # Crappy Top based Limit/Offset support. MSSQL uses this currently,
95 # but may have to switch to RowNumberOver one day
97 my ( $self, $sql, $order, $rows, $offset ) = @_;
99 croak '$order supplied to SQLAHacks limit emulators must be a hash'
100 if (ref $order ne 'HASH');
102 $order = { %$order }; #copy
104 my $last = $rows + $offset;
106 my $req_order = $self->_order_by ($order->{order_by});
107 my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by};
109 delete $order->{$_} for qw/order_by _virtual_order_by/;
110 my $grpby_having = $self->_order_by ($order);
112 my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
114 $sql =~ s/^\s*(SELECT|select)//;
119 SELECT TOP $rows * FROM
121 SELECT TOP $last $sql $grpby_having $order_by_inner
133 # While we're at it, this should make LIMIT queries more efficient,
134 # without digging into things too deeply
136 my ($self, $syntax) = @_;
137 return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
141 my ($self, $table, $fields, $where, $order, @rest) = @_;
142 local $self->{having_bind} = [];
143 local $self->{from_bind} = [];
145 if (ref $table eq 'SCALAR') {
148 elsif (not ref $table) {
149 $table = $self->_quote($table);
151 local $self->{rownum_hack_count} = 1
152 if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
153 @rest = (-1) unless defined $rest[0];
154 croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
155 # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
156 my ($sql, @where_bind) = $self->SUPER::select(
157 $table, $self->_recurse_fields($fields), $where, $order, @rest
162 $self->{for} eq 'update' ? ' FOR UPDATE' :
163 $self->{for} eq 'shared' ? ' FOR SHARE' :
168 return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
174 $table = $self->_quote($table) unless ref($table);
175 $self->SUPER::insert($table, @_);
181 $table = $self->_quote($table) unless ref($table);
182 $self->SUPER::update($table, @_);
188 $table = $self->_quote($table) unless ref($table);
189 $self->SUPER::delete($table, @_);
195 return $_[1].$self->_order_by($_[2]);
197 return $self->SUPER::_emulate_limit(@_);
201 sub _recurse_fields {
202 my ($self, $fields, $params) = @_;
203 my $ref = ref $fields;
204 return $self->_quote($fields) unless $ref;
205 return $$fields if $ref eq 'SCALAR';
207 if ($ref eq 'ARRAY') {
208 return join(', ', map {
209 $self->_recurse_fields($_)
210 .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
211 ? ' AS col'.$self->{rownum_hack_count}++
214 } elsif ($ref eq 'HASH') {
215 foreach my $func (keys %$fields) {
216 if ($func eq 'distinct') {
217 my $_fields = $fields->{$func};
218 if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
220 'The select => { distinct => ... } syntax is not supported for multiple columns.'
221 .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
222 .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
226 $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
228 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
229 ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
233 return $self->_sqlcase($func)
234 .'( '.$self->_recurse_fields($fields->{$func}).' )';
237 # Is the second check absolutely necessary?
238 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
239 return $self->_fold_sqlbind( $fields );
242 croak($ref . qq{ unexpected in _recurse_fields()})
250 if (ref $_[0] eq 'HASH') {
252 if (defined $_[0]->{group_by}) {
253 $ret = $self->_sqlcase(' group by ')
254 .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
257 if (defined $_[0]->{having}) {
259 ($frag, @extra) = $self->_recurse_where($_[0]->{having});
260 push(@{$self->{having_bind}}, @extra);
261 $ret .= $self->_sqlcase(' having ').$frag;
264 if (defined $_[0]->{order_by}) {
265 $ret .= $self->_order_by($_[0]->{order_by});
268 if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
269 return $self->SUPER::_order_by($_[0]);
272 } elsif (ref $_[0] eq 'SCALAR') {
273 $ret = $self->_sqlcase(' order by ').${ $_[0] };
274 } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
276 my $r = $self->_order_by($_, @_);
277 $r =~ s/^ ?ORDER BY //i;
281 $ret = $self->_sqlcase(' order by ') . join(', ', @order) if @order;
284 $ret = $self->SUPER::_order_by(@_);
289 sub _order_directions {
290 my ($self, $order) = @_;
291 return $self->SUPER::_order_directions( $self->_resolve_order($order) );
295 my ($self, $order) = @_;
297 if (ref $order eq 'HASH') {
298 $order = [$self->_resolve_order_hash($order)];
300 elsif (ref $order eq 'ARRAY') {
302 if (ref ($_) eq 'SCALAR') {
305 elsif (ref ($_) eq 'HASH') {
306 $self->_resolve_order_hash($_)
317 sub _resolve_order_hash {
318 my ($self, $order) = @_;
320 foreach my $key (keys %{ $order }) {
321 if ($key =~ /^-(desc|asc)/i ) {
323 my $type = ref $order->{ $key };
324 if ($type eq 'ARRAY') {
325 push @new_order, map( "$_ $direction", @{ $order->{ $key } } );
327 push @new_order, "$order->{$key} $direction";
329 croak "hash order_by can only contain Scalar or Array, not $type";
332 croak "$key is not a valid direction, use -asc or -desc";
340 my ($self, $from) = @_;
341 if (ref $from eq 'ARRAY') {
342 return $self->_recurse_from(@$from);
343 } elsif (ref $from eq 'HASH') {
344 return $self->_make_as($from);
346 return $from; # would love to quote here but _table ends up getting called
347 # twice during an ->select without a limit clause due to
348 # the way S::A::Limit->select works. should maybe consider
349 # bypassing this and doing S::A::select($self, ...) in
350 # our select method above. meantime, quoting shims have
351 # been added to select/insert/update/delete here
356 my ($self, $from, @join) = @_;
358 push(@sqlf, $self->_make_as($from));
359 foreach my $j (@join) {
362 # check whether a join type exists
363 my $join_clause = '';
364 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
365 if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
366 $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
368 $join_clause = ' JOIN ';
370 push(@sqlf, $join_clause);
372 if (ref $to eq 'ARRAY') {
373 push(@sqlf, '(', $self->_recurse_from(@$to), ')');
375 push(@sqlf, $self->_make_as($to));
377 push(@sqlf, ' ON ', $self->_join_condition($on));
379 return join('', @sqlf);
383 my ($self, $sqlbind) = @_;
385 my @sqlbind = @$$sqlbind; # copy
386 my $sql = shift @sqlbind;
387 push @{$self->{from_bind}}, @sqlbind;
393 my ($self, $from) = @_;
394 return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
395 : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
397 } reverse each %{$self->_skip_options($from)});
401 my ($self, $hash) = @_;
403 $clean_hash->{$_} = $hash->{$_}
404 for grep {!/^-/} keys %$hash;
408 sub _join_condition {
409 my ($self, $cond) = @_;
410 if (ref $cond eq 'HASH') {
415 croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
416 if ref($v) ne 'SCALAR';
420 my $x = '= '.$self->_quote($v); $j{$_} = \$x;
423 return scalar($self->_recurse_where(\%j));
424 } elsif (ref $cond eq 'ARRAY') {
425 return join(' OR ', map { $self->_join_condition($_) } @$cond);
427 die "Can't handle this yet!";
432 my ($self, $label) = @_;
433 return '' unless defined $label;
434 return "*" if $label eq '*';
435 return $label unless $self->{quote_char};
436 if(ref $self->{quote_char} eq "ARRAY"){
437 return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
438 if !defined $self->{name_sep};
439 my $sep = $self->{name_sep};
440 return join($self->{name_sep},
441 map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
442 split(/\Q$sep\E/,$label));
444 return $self->SUPER::_quote($label);
449 $self->{limit_dialect} = shift if @_;
450 return $self->{limit_dialect};
455 $self->{quote_char} = shift if @_;
456 return $self->{quote_char};
461 $self->{name_sep} = shift if @_;
462 return $self->{name_sep};
473 DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
474 and includes a number of DBIC-specific workarounds, not yet suitable for
475 inclusion into SQLA proper.
481 Tries to determine limit dialect.
485 Quotes table names, handles "limit" dialects (e.g. where rownum between x and
486 y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
488 =head2 insert update delete
490 Just quotes table names.
494 Specifies the dialect of used for implementing an SQL "limit" clause for
495 restricting the number of query results returned. Valid values are: RowNum.
497 See L<DBIx::Class::Storage::DBI/connect_info> for details.
501 Character separating quoted table names.
503 See L<DBIx::Class::Storage::DBI/connect_info> for details.
507 Set to an array-ref to specify separate left and right quotes for table names.
509 See L<DBIx::Class::Storage::DBI/connect_info> for details.