};
}
-sub _recurse_fields {
- my ($self, $fields) = @_;
- my $ref = ref $fields;
- return $self->_quote($fields) unless $ref;
- return $$fields if $ref eq 'SCALAR';
-
- if ($ref eq 'ARRAY') {
- return join(', ', map { $self->_recurse_fields($_) } @$fields);
- }
- elsif ($ref eq 'HASH') {
- my %hash = %$fields; # shallow copy
-
- my $as = delete $hash{-as}; # if supplied
-
- my ($func, $args, @toomany) = %hash;
-
- # there should be only one pair
- if (@toomany) {
- $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
- }
-
- if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
- $self->throw_exception (
- 'The select => { distinct => ... } syntax is not supported for multiple columns.'
- .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
- .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
- );
- }
-
- my $select = sprintf ('%s( %s )%s',
- $self->_sqlcase($func),
- $self->_recurse_fields($args),
- $as
- ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
- : ''
- );
-
- return $select;
- }
- # Is the second check absolutely necessary?
- elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- push @{$self->{select_bind}}, @{$$fields}[1..$#$$fields];
- return $$fields->[0];
- }
- else {
- $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
- }
-}
-
-
-# this used to be a part of _order_by but is broken out for clarity.
-# What we have been doing forever is hijacking the $order arg of
-# SQLA::select to pass in arbitrary pieces of data (first the group_by,
-# then pretty much the entire resultset attr-hash, as more and more
-# things in the SQLA space need to have mopre info about the $rs they
-# create SQL for. The alternative would be to keep expanding the
-# signature of _select with more and more positional parameters, which
-# is just gross. All hail SQLA2!
-sub _parse_rs_attrs {
- my ($self, $arg) = @_;
-
- my $sql = '';
-
- if ($arg->{group_by}) {
- # horible horrible, waiting for refactor
- local $self->{select_bind};
- if (my $g = $self->_recurse_fields($arg->{group_by}) ) {
- $sql .= $self->_sqlcase(' group by ') . $g;
- push @{$self->{group_bind} ||= []}, @{$self->{select_bind}||[]};
- }
- }
-
- if (defined $arg->{having}) {
- my ($frag, @bind) = $self->_recurse_where($arg->{having});
- push(@{$self->{having_bind}}, @bind);
- $sql .= $self->_sqlcase(' having ') . $frag;
- }
-
- if (defined $arg->{order_by}) {
- $sql .= $self->_order_by ($arg->{order_by});
- }
-
- return $sql;
-}
-
-sub _order_by {
- my ($self, $arg) = @_;
-
- # check that we are not called in legacy mode (order_by as 4th argument)
- if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) {
- return $self->_parse_rs_attrs ($arg);
- }
- else {
- my ($sql, @bind) = $self->next::method($arg);
- push @{$self->{order_bind}}, @bind;
- return $sql;
- }
-}
-
sub _table_to_dq {
# optimized due to hotttnesss
# my ($self, $from) = @_;