$opt{expand_unary} = {};
$opt{expand} = {
- '-ident' => '_expand_ident',
- '-fffvalue' => sub { +{ -bind => [ our $Cur_Col_Meta, $_[2] ] } },
+ -ident => '_expand_ident',
+ -value => '_expand_value',
+ -not => '_expand_not',
+ -bool => sub {
+ my ($self, undef, $v) = @_;
+ if (ref($v)) {
+ return $self->_expand_expr($v);
+ }
+ puke "-bool => undef not supported" unless defined($v);
+ return $self->_expand_ident(-ident => $v);
+ },
};
return bless \%opt, $class;
}
my ($key, $value) = %$expr;
if (my $exp = $self->{expand}{$key}) {
- $self->$exp($key, $value);
+ return $self->$exp($key, $value);
}
return $self->_expand_expr_hashpair($key, $value, $logic);
}
}
return $self->_expand_expr($v);
}
- if ($k eq '-bool') {
- if (ref($v)) {
- return $self->_expand_expr($v);
- }
- puke "-bool => undef not supported" unless defined($v);
- return $self->_expand_ident(-ident => $v);
- }
- if ($k eq '-not') {
- return { -op => [ 'not', $self->_expand_expr($v) ] };
- }
if (my ($rest) = $k =~/^-not[_ ](.*)$/) {
return +{ -op => [
'not',
return { -op => [ $op, $v ] };
}
}
- if ($k eq '-value') {
- return +{ -bind => [ our $Cur_Col_Meta, $v ] };
- }
-# if ($k eq '-ident') {
-# return $self->_expand_ident(-ident => $v);
-# }
if (my $custom = $self->{expand_unary}{$k}) {
return $self->$custom($v);
}
] };
}
if ($op eq 'value') {
- return $self->_expand_expr_hashpair($k, undef) unless defined($vv);
+ return $self->_expand_expr({ $k, undef }) unless defined($vv);
return +{ -op => [
$self->{cmp},
$self->_expand_ident(-ident => $k),
if (ref($vv) eq 'HASH') {
return +{ -op => [
$op,
- map $self->_expand_expr_hashpair($k, { $_ => $vv->{$_} }),
+ map $self->_expand_expr({ $k, { $_ => $vv->{$_} } }),
sort keys %$vv
] };
}
}
return +{ -op => [
$logic =~ /^-(.*)$/,
- map $self->_expand_expr_hashpair($k => { $vk => $_ }),
+ map $self->_expand_expr({ $k => { $vk => $_ } }),
@values
] };
}
return +{ -ident => \@parts };
}
+sub _expand_value {
+ +{ -bind => [ our $Cur_Col_Meta, $_[2] ] };
+}
+
+sub _expand_not {
+ +{ -op => [ 'not', $_[0]->_expand_expr($_[2]) ] };
+}
+
sub _recurse_where {
my ($self, $where, $logic) = @_;