return bless \%opt, $class;
}
+sub sqltrue { +{ -literal => [ $_[0]->{sqltrue} ] } }
+sub sqlfalse { +{ -literal => [ $_[0]->{sqlfalse} ] } }
sub _assert_pass_injection_guard {
if ($_[1] =~ $_[0]->{injection_guard}) {
my ($self, $where, $order) = @_;
# where ?
- my ($sql, @bind) = $self->_recurse_where($where);
+ my ($sql, @bind) = defined($where)
+ ? $self->_recurse_where($where)
+ : (undef);
$sql = (defined $sql and length $sql) ? $self->_sqlcase(' where ') . "( $sql )" : '';
# order by?
push(@res, $self->_expand_expr({ $el, shift(@expr) }));
} elsif ($elref eq 'ARRAY') {
push(@res, $self->_expand_expr($el)) if @$el;
- } elsif (is_literal_value($el)) {
- push @res, $el;
+ } elsif (my $l = is_literal_value($el)) {
+ push @res, { -literal => $l };
} elsif ($elref eq 'HASH') {
push @res, $self->_expand_expr($el);
} else {
}
if (ref($v) eq 'HASH') {
if (keys %$v > 1) {
- return { -and => [
+ return { -op => [
+ 'and',
map $self->_expand_expr_hashpair($k => { $_ => $v->{$_} }),
sort keys %$v
] };
map { ref($_) ? $_ : { -bind => [ $k, $_ ] } }
map { defined($_) ? $_: puke($undef_err) }
(ref($vv) eq 'ARRAY' ? @$vv : $vv);
- return +{
- -literal => [ $self->{$vk =~ /^not/ ? 'sqltrue' : 'sqlfalse'} ]
- } unless @rhs;
+ return $self->${\($vk =~ /^not/ ? 'sqltrue' : 'sqlfalse')} unless @rhs;
return +{ -op => [
join(' ', split '_', $vk),
# try to DWIM on equality operators
my $op = join ' ', split '_', $vk;
return
- $op =~ $self->{equality_op} ? $self->{sqlfalse}
- : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqlfalse}
- : $op =~ $self->{inequality_op} ? $self->{sqltrue}
- : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->{sqltrue}
+ $op =~ $self->{equality_op} ? $self->sqlfalse
+ : $op =~ $self->{like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqlfalse
+ : $op =~ $self->{inequality_op} ? $self->sqltrue
+ : $op =~ $self->{not_like_op} ? belch("Supplying an empty arrayref to '@{[ uc $op]}' is deprecated") && $self->sqltrue
: puke "operator '$op' applied on an empty array (field '$k')";
}
return +{ -op => [
] };
}
if (ref($v) eq 'ARRAY') {
- return $self->{sqlfalse} unless @$v;
+ return $self->sqlfalse unless @$v;
$self->_debug("ARRAY($k) means distribute over elements");
my $this_logic = (
$v->[0] =~ /^-((?:and|or))$/i
? ($v = [ @{$v}[1..$#$v] ], $1)
: ($self->{logic} || 'or')
);
- return +{ "-${this_logic}" => [ map $self->_expand_expr({ $k => $_ }, $this_logic), @$v ] };
+ return +{ -op => [
+ $this_logic,
+ map $self->_expand_expr({ $k => $_ }, $this_logic), @$v
+ ] };
}
if (my $literal = is_literal_value($v)) {
unless (length $k) {
die "notreached";
}
+sub _render_expr {
+ my ($self, $expr) = @_;
+ my ($k, $v, @rest) = %$expr;
+ die "No" if @rest;
+ my %op = map +("-$_" => '_where_op_'.uc($_)),
+ qw(op func value bind ident literal);
+ if (my $meth = $op{$k}) {
+ return $self->$meth(undef, $v);
+ }
+ die "notreached: $k";
+}
+
sub _recurse_where {
my ($self, $where, $logic) = @_;
#print STDERR Data::Dumper::Concise::Dumper([ EXP => $where_exp ]);
# dispatch on appropriate method according to refkind of $where
- my $method = $self->_METHOD_FOR_refkind("_where", $where_exp);
+# my $method = $self->_METHOD_FOR_refkind("_where", $where_exp);
+
+# my ($sql, @bind) = $self->$method($where_exp, $logic);
- my ($sql, @bind) = $self->$method($where_exp, $logic);
+ my ($sql, @bind) = defined($where_exp) ? $self->_render_expr($where_exp) : (undef);
# DBIx::Class used to call _recurse_where in scalar context
# something else might too...
return ($sql, @bind);
}
-sub _where_op_ANDOR {
- my ($self, $op, $v) = @_;
-
- $self->_SWITCH_refkind($v, {
- ARRAYREF => sub {
- return $self->_where_ARRAYREF($v, $op);
- },
-
- HASHREF => sub {
- return ($op =~ /^or/i)
- ? $self->_where_ARRAYREF([ map { $_ => $v->{$_} } (sort keys %$v) ], $op)
- : $self->_where_HASHREF($v);
- },
-
- SCALARREF => sub {
- puke "-$op => \\\$scalar makes little sense, use " .
- ($op =~ /^or/i
- ? '[ \$scalar, \%rest_of_conditions ] instead'
- : '-and => [ \$scalar, \%rest_of_conditions ] instead'
- );
- },
-
- ARRAYREFREF => sub {
- puke "-$op => \\[...] makes little sense, use " .
- ($op =~ /^or/i
- ? '[ \[...], \%rest_of_conditions ] instead'
- : '-and => [ \[...], \%rest_of_conditions ] instead'
- );
- },
-
- SCALAR => sub { # permissively interpreted as SQL
- puke "-$op => \$value makes little sense, use -bool => \$value instead";
- },
-
- UNDEF => sub {
- puke "-$op => undef not supported";
- },
- });
-}
-
sub _where_op_NEST {
my ($self, $op, $v) = @_;
my ($lhs, $rhs) = @$args;
my @in_bind;
my @in_sql = map {
- local $self->{_nested_func_lhs} = $lhs->{-ident}
- if ref($lhs) eq 'HASH' and $lhs->{-ident};
- my ($sql, @bind) = $self->_where_unary_op(%$_);
+ my ($sql, @bind) = $self->_render_expr($_);
push @in_bind, @bind;
$sql;
} @$rhs;
- my ($lhsql, @lbind) = $self->_recurse_where($lhs);
+ my ($lhsql, @lbind) = $self->_render_expr($lhs);
return (
$lhsql.' '.$self->_sqlcase($op).' ( '
.join(', ', @in_sql)
my ($self, undef, $v) = @_;
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);
}
my $final_op = $op =~ /^(?:is|not)_/ ? join(' ', split '_', $op) : $op;
if (@args == 1 and $op !~ /^(and|or)$/) {
- my ($expr_sql, @bind) = $self->_recurse_where($args[0]);
+ my ($expr_sql, @bind) = $self->_render_expr($args[0]);
my $op_sql = $self->_sqlcase($final_op);
my $final_sql = (
$unop_postfix{lc($final_op)}
);
return (($op eq 'not' ? '('.$final_sql.')' : $final_sql), @bind);
} else {
- my @parts = map [ $self->_recurse_where($_) ], @args;
+ my @parts = map [ $self->_render_expr($_) ], @args;
my ($final_sql) = map +($op =~ /^(and|or)$/ ? "(${_})" : $_), join(
' '.$self->_sqlcase($final_op).' ',
map $_->[0], @parts
my @x = @$_;
push @arg_sql, shift @x;
@x
- } map [ $self->_recurse_where($_) ], @args;
+ } map [ $self->_render_expr($_) ], @args;
return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
}
projects / dbsrgits/SQL-Abstract.git / blobdiff