}
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 ] };
}
# top level special ops are illegal in general
puke "Illegal use of top-level '-$op'"
- if !(defined $self->{_nested_func_lhs})
- and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
+ if List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
}
if ($k eq '-value' and my $m = our $Cur_Col_Meta) {
return +{ -bind => [ $m, $v ] };
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
my ($op, @args) = @$v;
$op =~ s/^-// if length($op) > 1;
$op = lc($op);
- local $self->{_nested_func_lhs};
if (my $h = $special{$op}) {
return $self->$h(\@args);
}
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)
#======================================================================