$opt{expand_unary} = {};
$opt{expand} = {
- -not => '_expand_not',
- -bool => '_expand_bool',
- -and => '_expand_op_andor',
- -or => '_expand_op_andor',
- -nest => '_expand_nest',
- -bind => '_expand_bind',
- -in => '_expand_in',
- -not_in => '_expand_in',
- -row => '_expand_row',
- -between => '_expand_between',
- -not_between => '_expand_between',
- -op => '_expand_op',
- (map +($_ => '_expand_op_is'), ('-is', '-is_not')),
- -ident => '_expand_ident',
- -value => '_expand_value',
+ not => '_expand_not',
+ bool => '_expand_bool',
+ and => '_expand_op_andor',
+ or => '_expand_op_andor',
+ nest => '_expand_nest',
+ bind => '_expand_bind',
+ in => '_expand_in',
+ not_in => '_expand_in',
+ row => '_expand_row',
+ between => '_expand_between',
+ not_between => '_expand_between',
+ op => '_expand_op',
+ (map +($_ => '_expand_op_is'), ('is', 'is_not')),
+ ident => '_expand_ident',
+ value => '_expand_value',
};
$opt{expand_op} = {
};
$opt{render} = {
- (map +("-$_", "_render_$_"), qw(op func bind ident literal row)),
+ (map +($_, "_render_$_"), qw(op func bind ident literal row)),
%{$opt{render}||{}}
};
my ($self, $aqt) = @_;
my ($k, $v, @rest) = %$aqt;
die "No" if @rest;
+ die "Not a node type: $k" unless $k =~ s/^-//;
if (my $meth = $self->{render}{$k}) {
return $self->$meth($v);
}
if (ref($expr) eq 'HASH') {
return undef unless my $kc = keys %$expr;
if ($kc > 1) {
- return $self->_expand_op_andor(-and => $expr);
+ return $self->_expand_op_andor(and => $expr);
}
my ($key, $value) = %$expr;
if ($key =~ /^-/ and $key =~ s/ [_\s]? \d+ $//x ) {
belch 'Use of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0. '
. "You probably wanted ...-and => [ $key => COND1, $key => COND2 ... ]";
}
- if (my $exp = $self->{expand}{$key}) {
- return $self->$exp($key, $value);
- }
return $self->_expand_hashpair($key, $value);
}
if (ref($expr) eq 'ARRAY') {
- my $logic = '-'.lc($self->{logic});
- return $self->_expand_op_andor($logic, $expr);
+ return $self->_expand_op_andor(lc($self->{logic}), $expr);
}
if (my $literal = is_literal_value($expr)) {
return +{ -literal => $literal };
# hash with multiple or no elements is andor
if (ref($v) eq 'HASH' and keys %$v != 1) {
- return $self->_expand_op_andor(-and => $v, $k);
+ return $self->_expand_op_andor(and => $v, $k);
}
# undef needs to be re-sent with cmp to achieve IS/IS NOT NULL
$self->_debug("ARRAY($k) means distribute over elements");
my $logic = lc(
$v->[0] =~ /^-(and|or)$/i
- ? shift(@{$v = [ @$v ]})
- : '-'.lc($self->{logic} || 'OR')
+ ? (shift(@{$v = [ @$v ]}), $1)
+ : lc($self->{logic} || 'OR')
);
return $self->_expand_op_andor(
$logic => $v, $k
my $op = $self->_normalize_op($k);
+ if (my $exp = $self->{expand}{$op}) {
+ return $self->$exp($op, $v);
+ }
+
# Ops prefixed with -not_ get converted
if (my ($rest) = $op =~/^not_(.*)$/) {
# an explicit node type is currently assumed to be expanded (this is almost
# certainly wrong and there should be expansion anyway)
- if ($self->{render}{$k}) {
+ if ($self->{render}{$op}) {
return { $k => $v };
}
if (ref($vv) eq 'ARRAY') {
my @raw = @$vv;
my $logic = (defined($raw[0]) and $raw[0] =~ /^-(and|or)$/i)
- ? shift @raw : '-or';
+ ? (shift(@raw), $1) : 'or';
my @values = map +{ $vk => $_ }, @raw;
if (
$op =~ $self->{inequality_op}
or $op =~ $self->{not_like_op}
) {
- if (lc($logic) eq '-or' and @values > 1) {
+ if (lc($logic) eq 'or' and @values > 1) {
belch "A multi-element arrayref as an argument to the inequality op '${\uc(join ' ', split '_', $op)}' "
. 'is technically equivalent to an always-true 1=1 (you probably wanted '
. "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)"
}
sub _expand_ident {
- my ($self, $op, $body, $k) = @_;
+ my ($self, undef, $body, $k) = @_;
return $self->_expand_hashpair_cmp(
$k, { -ident => $body }
) if defined($k);
unless (defined($body) or (ref($body) and ref($body) eq 'ARRAY')) {
- puke "$op requires a single plain scalar argument (a quotable identifier) or an arrayref of identifier parts";
+ puke "-ident requires a single plain scalar argument (a quotable identifier) or an arrayref of identifier parts";
}
my @parts = map split(/\Q${\($self->{name_sep}||'.')}\E/, $_),
ref($body) ? @$body : $body;
}
sub _expand_row {
- my ($self, $node, $args) = @_;
- +{ $node => [ map $self->expand_expr($_), @$args ] };
+ my ($self, undef, $args) = @_;
+ +{ -row => [ map $self->expand_expr($_), @$args ] };
}
sub _expand_op {
- my ($self, $node, $args) = @_;
+ my ($self, undef, $args) = @_;
my ($op, @opargs) = @$args;
- +{ $node => [ $op, map $self->expand_expr($_), @opargs ] };
+ +{ -op => [ $op, map $self->expand_expr($_), @opargs ] };
}
sub _expand_bool {
}
sub _expand_op_andor {
- my ($self, $logic, $v, $k) = @_;
+ my ($self, $logop, $v, $k) = @_;
if (defined $k) {
$v = [ map +{ $k, $_ },
(ref($v) eq 'HASH')
: @$v,
];
}
- my ($logop) = $logic =~ /^-?(.*)$/;
if (ref($v) eq 'HASH') {
return undef unless keys %$v;
return +{ -op => [
sub _expand_op_is {
my ($self, $op, $vv, $k) = @_;
- $op =~ s/^-//;
($k, $vv) = @$vv unless defined $k;
puke "$op can only take undef as argument"
if defined($vv)
sub _expand_between {
my ($self, $op, $vv, $k) = @_;
- $op =~ s/^-//;
$k = shift @{$vv = [ @$vv ]} unless defined $k;
my @rhs = map $self->_expand_expr($_),
ref($vv) eq 'ARRAY' ? @$vv : $vv;
}
sub _expand_nest {
- my ($self, $op, $v) = @_;
+ my ($self, undef, $v) = @_;
# DBIx::Class requires a nest warning to be emitted once but the private
# method it overrode to do so no longer exists
if ($self->{warn_once_on_nest}) {
}
sub _expand_bind {
- my ($self, $op, $bind) = @_;
- return { $op => $bind };
+ my ($self, undef, $bind) = @_;
+ return { -bind => $bind };
}
sub _recurse_where {
return +{ -op => [ ',', @exp ] };
};
- local @{$self->{expand}}{qw(-asc -desc)} = (($expander) x 2);
+ local @{$self->{expand}}{qw(asc desc)} = (($expander) x 2);
return $self->$expander(undef, $arg);
}