my $f = $options->{returning};
- my $fieldlist = $self->_SWITCH_refkind($f, {
- ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$f;},
- SCALAR => sub {$self->_quote($f)},
- SCALARREF => sub {$$f},
- });
- return $self->_sqlcase(' returning ') . $fieldlist;
+ my ($sql, @bind) = $self->_render_expr(
+ $self->_expand_maybe_list_expr($f, undef, -ident)
+ );
+ return wantarray
+ ? $self->_sqlcase(' returning ') . $sql
+ : ($self->_sqlcase(' returning ').$sql, @bind);
}
sub _insert_HASHREF { # explicit list of fields and then values
sub _insert_value {
my ($self, $column, $v) = @_;
- my (@values, @all_bind);
- $self->_SWITCH_refkind($v, {
-
- ARRAYREF => sub {
- if ($self->{array_datatypes}) { # if array datatype are activated
- push @values, '?';
- push @all_bind, $self->_bindtype($column, $v);
- }
- else { # else literal SQL with bind
- my ($sql, @bind) = @$v;
- $self->_assert_bindval_matches_bindtype(@bind);
- push @values, $sql;
- push @all_bind, @bind;
- }
- },
-
- ARRAYREFREF => sub { # literal SQL with bind
- my ($sql, @bind) = @${$v};
- $self->_assert_bindval_matches_bindtype(@bind);
- push @values, $sql;
- push @all_bind, @bind;
- },
-
- # THINK: anything useful to do with a HASHREF ?
- HASHREF => sub { # (nothing, but old SQLA passed it through)
- #TODO in SQLA >= 2.0 it will die instead
- belch "HASH ref as bind value in insert is not supported";
- push @values, '?';
- push @all_bind, $self->_bindtype($column, $v);
- },
-
- SCALARREF => sub { # literal SQL without bind
- push @values, $$v;
- },
-
- SCALAR_or_UNDEF => sub {
- push @values, '?';
- push @all_bind, $self->_bindtype($column, $v);
- },
+ return $self->_render_expr(
+ $self->_expand_insert_value($column, $v)
+ );
+}
- });
+sub _expand_insert_value {
+ my ($self, $column, $v) = @_;
- my $sql = join(", ", @values);
- return ($sql, @all_bind);
+ if (ref($v) eq 'ARRAY') {
+ if ($self->{array_datatypes}) {
+ return +{ -bind => [ $column, $v ] };
+ }
+ my ($sql, @bind) = @$v;
+ $self->_assert_bindval_matches_bindtype(@bind);
+ return +{ -literal => $v };
+ }
+ if (ref($v) eq 'HASH') {
+ if (grep !/^-/, keys %$v) {
+ belch "HASH ref as bind value in insert is not supported";
+ return +{ -bind => [ $column, $v ] };
+ }
+ }
+ if (!defined($v)) {
+ return +{ -bind => [ $column, undef ] };
+ }
+ local our $Cur_Col_Meta = $column;
+ return $self->_expand_expr($v);
}
sub _update_set_values {
my ($self, $data) = @_;
- my (@set, @all_bind);
- for my $k (sort keys %$data) {
- my $v = $data->{$k};
- my $r = ref $v;
- my $label = $self->_quote($k);
-
- $self->_SWITCH_refkind($v, {
- ARRAYREF => sub {
- if ($self->{array_datatypes}) { # array datatype
- push @set, "$label = ?";
- push @all_bind, $self->_bindtype($k, $v);
- }
- else { # literal SQL with bind
- my ($sql, @bind) = @$v;
- $self->_assert_bindval_matches_bindtype(@bind);
- push @set, "$label = $sql";
- push @all_bind, @bind;
- }
- },
- ARRAYREFREF => sub { # literal SQL with bind
- my ($sql, @bind) = @${$v};
- $self->_assert_bindval_matches_bindtype(@bind);
- push @set, "$label = $sql";
- push @all_bind, @bind;
- },
- SCALARREF => sub { # literal SQL without bind
- push @set, "$label = $$v";
- },
- HASHREF => sub {
- my ($op, $arg, @rest) = %$v;
-
- puke 'Operator calls in update must be in the form { -op => $arg }'
- if (@rest or not $op =~ /^\-(.+)/);
-
- local our $Cur_Col_Meta = $k;
- my ($sql, @bind) = $self->_render_expr(
- $self->_expand_expr_hashpair($op, $arg)
- );
-
- push @set, "$label = $sql";
- push @all_bind, @bind;
- },
- SCALAR_or_UNDEF => sub {
- push @set, "$label = ?";
- push @all_bind, $self->_bindtype($k, $v);
- },
- });
- }
-
- # generate sql
- my $sql = join ', ', @set;
+ return $self->_render_expr(
+ $self->_expand_update_set_values($data),
+ );
+}
- return ($sql, @all_bind);
+sub _expand_update_set_values {
+ my ($self, $data) = @_;
+ $self->_expand_maybe_list_expr( [
+ map {
+ my ($k, $set) = @$_;
+ +{ -op => [ '=', { -ident => $k }, $set ] };
+ }
+ map {
+ my $k = $_;
+ my $v = $data->{$k};
+ (ref($v) eq 'ARRAY'
+ ? ($self->{array_datatypes}
+ ? [ $k, +{ -bind => [ $k, $v ] } ]
+ : [ $k, +{ -literal => $v } ])
+ : do {
+ local our $Cur_Col_Meta = $k;
+ [ $k, $self->_expand_expr($v) ]
+ }
+ );
+ } sort keys %$data
+ ] );
}
# So that subclasses can override UPDATE ... RETURNING separately from
sub _select_fields {
my ($self, $fields) = @_;
- return ref $fields eq 'ARRAY' ? join ', ', map { $self->_quote($_) } @$fields
- : $fields;
+ return $self->_render_expr(
+ $self->_expand_maybe_list_expr($fields, undef, '-ident')
+ );
}
#======================================================================
sub where {
my ($self, $where, $order) = @_;
+ local $self->{convert_where} = $self->{convert};
+
# where ?
my ($sql, @bind) = defined($where)
? $self->_recurse_where($where)
}
sub _expand_expr {
- my ($self, $expr, $logic) = @_;
+ my ($self, $expr, $logic, $default_scalar_to) = @_;
+ local our $Default_Scalar_To = $default_scalar_to if $default_scalar_to;
return undef unless defined($expr);
if (ref($expr) eq 'HASH') {
if (keys %$expr > 1) {
return +{ -literal => $literal };
}
if (!ref($expr) or Scalar::Util::blessed($expr)) {
+ if (my $d = $Default_Scalar_To) {
+ return +{ $d => $expr };
+ }
if (my $m = our $Cur_Col_Meta) {
return +{ -bind => [ $m, $expr ] };
}
if ($k eq '-op' or $k eq '-ident' or $k eq '-value' or $k eq '-bind' or $k eq '-literal' or $k eq '-func') {
return { $k => $v };
}
+ if (my $custom = $self->{custom_expansions}{($k =~ /^-(.*)$/)[0]}) {
+ return $self->$custom($v);
+ }
if (
ref($v) eq 'HASH'
and keys %$v == 1
} else {
my @parts = map [ $self->_render_expr($_) ], @args;
my ($final_sql) = map +($op =~ /^(and|or)$/ ? "(${_})" : $_), join(
- ' '.$self->_sqlcase($final_op).' ',
+ ($final_op eq ',' ? '' : ' ').$self->_sqlcase($final_op).' ',
map $_->[0], @parts
);
return (
sub _order_by {
my ($self, $arg) = @_;
- return '' unless defined($arg);
-
- my @chunks = $self->_order_by_chunks($arg);
-
- my @sql;
- my @bind = map {
- my ($s, @b) = $self->_render_expr($_);
- push @sql, $s;
- @b;
- } @chunks;
-
- my $sql = @sql
- ? sprintf('%s %s',
- $self->_sqlcase(' order by'),
- join(', ', @sql)
- )
- : ''
- ;
-
- return wantarray ? ($sql, @bind) : $sql;
-}
+ return '' unless defined($arg) and not (ref($arg) eq 'ARRAY' and !@$arg);
-sub _order_by_chunks {
- my ($self, $arg) = @_;
+ my $expander = sub {
+ my ($self, $dir, $expr) = @_;
+ my @exp = map +(defined($dir) ? { -op => [ $dir => $_ ] } : $_),
+ map $self->_expand_expr($_, undef, -ident),
+ ref($expr) eq 'ARRAY' ? @$expr : $expr;
+ return (@exp > 1 ? { -op => [ ',', @exp ] } : $exp[0]);
+ };
- if (ref($arg) eq 'ARRAY') {
- return map $self->_order_by_chunks($_), @$arg;
- }
- if (my $l = is_literal_value($arg)) {
- return +{ -literal => $l };
- }
- if (!ref($arg)) {
- return +{ -ident => $arg };
- }
- if (ref($arg) eq 'HASH') {
- my ($key, $val, @rest) = %$arg;
+ local $self->{custom_expansions} = {
+ asc => sub { shift->$expander(asc => @_) },
+ desc => sub { shift->$expander(desc => @_) },
+ };
- return () unless $key;
+ my $expanded = $self->$expander(undef, $arg);
- if (@rest or not $key =~ /^-(desc|asc)/i) {
- puke "hash passed to _order_by must have exactly one key (-desc or -asc)";
- }
+ my ($sql, @bind) = $self->_render_expr($expanded);
- my $dir = $1;
+ my $final_sql = $self->_sqlcase(' order by ').$sql;
- map +{ -op => [ $dir, $_ ] }, $self->_order_by_chunks($val);
- };
+ return wantarray ? ($final_sql, @bind) : $final_sql;
}
-
#======================================================================
# DATASOURCE (FOR NOW, JUST PLAIN TABLE OR LIST OF TABLES)
#======================================================================
sub _table {
my $self = shift;
my $from = shift;
- $self->_SWITCH_refkind($from, {
- ARRAYREF => sub {join ', ', map { $self->_quote($_) } @$from;},
- SCALAR => sub {$self->_quote($from)},
- SCALARREF => sub {$$from},
- });
+ ($self->_render_expr(
+ $self->_expand_maybe_list_expr($from, undef, -ident)
+ ))[0];
}
# UTILITY FUNCTIONS
#======================================================================
+sub _expand_maybe_list_expr {
+ my ($self, $expr, $logic, $default) = @_;
+ my $e = do {
+ if (ref($expr) eq 'ARRAY') {
+ return { -op => [
+ ',', map $self->_expand_expr($_, $logic, $default), @$expr
+ ] } if @$expr > 1;
+ $expr->[0]
+ } else {
+ $expr
+ }
+ };
+ return $self->_expand_expr($e, $logic, $default);
+}
+
# highly optimized, as it's called way too often
sub _quote {
# my ($self, $label) = @_;
# Conversion, if applicable
sub _convert {
#my ($self, $arg) = @_;
- if ($_[0]->{convert}) {
- return $_[0]->_sqlcase($_[0]->{convert}) .'(' . $_[1] . ')';
+ if ($_[0]->{convert_where}) {
+ return $_[0]->_sqlcase($_[0]->{convert_where}) .'(' . $_[1] . ')';
}
return $_[1];
}
projects / scpubgit/Q-Branch.git / blobdiff