'==' => '=',
'!=' => '!=',
# LIKE is always "field LIKE <value>"
- '-like' => 'LIKE',
- '-not_like' => 'NOT LIKE',
+ 'like' => 'LIKE',
+ 'not_like' => 'NOT LIKE',
);
has expr_dispatch_table => (
+++ /dev/null
-use MooseX::Declare;
-
-class SQL::Abstract::AST::Compat {
-
- use MooseX::Types::Moose qw/ArrayRef HashRef Str ScalarRef/;
- use SQL::Abstract::Types qw/AST/;
- use SQL::Abstract::Types::Compat ':all';
- use Devel::PartialDump qw/dump/;
- use Carp qw/croak/;
-
- clean;
-
- has logic => (
- is => 'rw',
- isa => LogicEnum,
- default => 'AND'
- );
-
- method generate(WhereType $ast) returns (AST) {
- return $self->recurse_where($ast);
- }
-
- method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
- return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
- return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
- croak "Unknown where clause type " . dump($ast);
- }
-
- method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
- my @args;
- my $ret = {
- -type => 'expr',
- op => lc $logic,
- args => \@args
- };
-
- while (my ($key,$value) = each %$ast) {
- if ($key =~ /^-(or|and)$/) {
- my $val = $self->recurse_where($value, uc $1);
- if ($val->{op} eq $ret->{op}) {
- push @args, @{$val->{args}};
- }
- else {
- push @args, $val;
- }
- next;
- }
-
- push @args, $self->field($key, $value);
- }
-
- return $args[0] if @args == 1;
-
- return $ret;
- }
-
- method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
- my @args;
- my $ret = {
- -type => 'expr',
- op => lc $logic,
- args => \@args
- };
- my @nodes = @$ast;
-
- while (my $key = shift @nodes) {
- if ($key =~ /^-(or|and)$/) {
- my $value = shift @nodes
- or confess "missing value after $key at " . dump($ast);
-
- my $val = $self->recurse_where($value, uc $1);
- if ($val->{op} eq $ret->{op}) {
- push @args, @{$val->{args}};
- }
- else {
- push @args, $val;
- }
- next;
- }
-
- push @args, $self->recurse_where($key);
- }
-
- return $args[0] if @args == 1;
-
- return $ret;
- }
-
- method field(Str $key, $value) returns (AST) {
- my $ret = {
- -type => 'expr',
- op => '==',
- args => [
- { -type => 'name', args => [$key] }
- ],
- };
-
- if (is_Str($value)) {
- push @{$ret->{args}}, { -type => 'value', value => $value };
- }
-
- return $ret;
- }
-
-
-};
-
-1;
-
-=head1 NAME
-
-SQL::Abstract::AST::Compat - v1.xx AST -> v2 AST visitor
-
-=head1 DESCRIPTION
-
-The purpose of this module is to take the where clause arguments from version
-1.x of SQL::Abstract, and turn it into a proper, explicit AST, suitable for use
-in the rest of the code.
-
-Please note that this module does not have the same interface as other
-SQL::Abstract ASTs.
-
-=head1 AUTHOR
-
-Ash Berlin C<< <ash@cpan.org> >>
-
-=cut
%{super()},
in => $self->can('_in'),
not_in => $self->can('_in'),
+ between => $self->can('_between'),
+ not_between => $self->can('_between'),
and => $self->can('_recurse_where'),
or => $self->can('_recurse_where'),
map { +"$_" => $self->can("_$_") } qw/
my $post;
$post = pop @names if $names[-1] eq '*';
- my $ret =
- $quote->[0] .
- join( $join, @names ) .
- $quote->[-1];
+ my $ret;
+ $ret = $quote->[0] .
+ join( $join, @names ) .
+ $quote->[-1]
+ if @names;
+
+ $ret = $ret
+ ? $ret . $sep . $post
+ : $post
+ if defined $post;
+
- $ret .= $sep . $post if defined $post;
return $ret;
}
method _list(AST $ast) {
+ return "" unless $ast->{args};
+
my @items = is_ArrayRef($ast->{args})
? @{$ast->{args}}
: $ast->{args};
croak "'$op' is not a valid AST type in an expression with " . dump($ast)
if $ast->{-type} ne 'expr';
- croak "'$op' is not a valid operator in an expression with " . dump($ast);
+ # This is an attempt to do some form of validation on function names. This
+ # might end up being a bad thing.
+ croak "'$op' is not a valid operator in an expression with " . dump($ast)
+ if $op =~ /\W/;
+
+ return $self->_generic_function_op($ast);
}
);
}
+ method _generic_function_op(AST $ast) {
+ my $op = $ast->{op};
+
+ return "$op(" . $self->_list($ast) . ")";
+ }
+
method _in(AST $ast) {
my ($field,@values) = @{$ast->{args}};
")";
}
- method _generic_func(ArrayRef $ast) {
+ method _between(AST $ast) {
+
+ my ($field,@values) = @{$ast->{args}};
+
+ my $not = ($ast->{op} =~ /^not_/) ? " NOT" : "";
+ croak "between requires 3 arguments: " . dump($ast)
+ unless @values == 2;
+
+ return $self->_expr($field) .
+ $not .
+ " BETWEEN " .
+ join(" AND ", map { $self->dispatch($_) } @values );
}
# 'constants' that are portable across DBs
use Moose::Util::TypeConstraints;
use MooseX::Types::Moose qw/Str ScalarRef ArrayRef HashRef/;
- use MooseX::Types -declare => [qw/LogicEnum WhereType/];
-
- enum LogicEnum, qw(OR AND);
-
- subtype WhereType, as Str;
+ use SQL::Abstract::Types::Compat ':all';
+ use SQL::Abstract::Types qw/AST/;
+ use SQL::Abstract::AST::v1;
+ use Data::Dump qw/pp/;
+ use Devel::PartialDump qw/dump/;
+ use Carp qw/croak/;
+ class_type 'SQL::Abstract';
clean;
has logic => (
is => 'rw',
isa => LogicEnum,
- default => 'AND'
+ default => 'AND',
+ coerce => 1,
+ required => 1,
+ );
+
+ has visitor => (
+ is => 'rw',
+ isa => 'SQL::Abstract',
+ clearer => 'clear_visitor',
+ lazy => 1,
+ builder => '_build_visitor',
);
+ has cmp => (
+ is => 'rw',
+ isa => 'Str',
+ default => '=',
+ required => 1,
+ );
+ our %CMP_MAP = (
+ '=' => '==',
+ );
+
+ has convert => (
+ is => 'rw',
+ isa => 'Str',
+ predicate => 'has_field_convertor'
+ );
method select(Str|ArrayRef|ScalarRef $from, ArrayRef|Str $fields,
- Str|ScalarRef|ArrayRef|HashRef $where?,
- Str|ScalarRef|ArrayRef|HashRef $order?) {
- return ("", );
+ WhereType $where?,
+ WhereType $order?)
+ {
+ my $ast = {
+ -type => 'select',
+ columns => [
+ map {
+ $self->mk_name(0, $_)
+ } ( is_Str($fields) ? $fields : @$fields )
+ ],
+ tablespec => $self->tablespec($from)
+ };
+
+
+ $ast->{where} = $self->recurse_where($where)
+ if defined $where;
+
+ return ($self->visitor->dispatch($ast), $self->visitor->binds);
}
- method where(Str|ScalarRef|ArrayRef|HashRef $where,
- Str|ScalarRef|ArrayRef|HashRef $order?) {
+ method where(WhereType $where,
+ WhereType $order?)
+ {
+ my $ret = "";
+
+ if ($where) {
+ my $ast = $self->recurse_where($where);
+ $ret .= "WHERE " . $self->visitor->_expr($ast);
+ }
- my $ast = {
+ return $ret;
+ }
+
+ method _build_visitor() {
+ return SQL::Abstract->create(1);
+ }
+
+ sub mk_name {
+ my ($self, $use_convert) = (shift,shift);
+ my $ast = { -type => 'name', args => [ @_ ] };
+
+ return $ast
+ unless $use_convert && $self->has_field_convertor;
+
+ return $self->apply_convert($ast);
+ }
+
+ method tablespec(Str|ArrayRef|ScalarRef $from) {
+ return $self->mk_name(0, $from)
+ if is_Str($from);
+ }
+
+ method recurse_where(WhereType $ast, LogicEnum $logic?) returns (AST) {
+ return $self->recurse_where_hash($logic || 'AND', $ast) if is_HashRef($ast);
+ return $self->recurse_where_array($logic || 'OR', $ast) if is_ArrayRef($ast);
+ croak "Unknown where clause type " . dump($ast);
+ }
+
+ method recurse_where_hash(LogicEnum $logic, HashRef $ast) returns (AST) {
+ my @args;
+ my $ret = {
+ -type => 'expr',
+ op => lc $logic,
+ args => \@args
+ };
+
+ while (my ($key,$value) = each %$ast) {
+ if ($key =~ /^-(or|and)$/) {
+ my $val = $self->recurse_where($value, uc $1);
+ if ($val->{op} eq $ret->{op}) {
+ push @args, @{$val->{args}};
+ }
+ else {
+ push @args, $val;
+ }
+ next;
+ }
+
+ push @args, $self->field($key, $value);
+ }
+
+ return $args[0] if @args == 1;
+
+ return $ret;
+ }
+
+ method recurse_where_array(LogicEnum $logic, ArrayRef $ast) returns (AST) {
+ my @args;
+ my $ret = {
-type => 'expr',
+ op => lc $logic,
+ args => \@args
};
+ my @nodes = @$ast;
+
+ while (my $key = shift @nodes) {
+ if ($key =~ /^-(or|and)$/) {
+ my $value = shift @nodes
+ or confess "missing value after $key at " . dump($ast);
+
+ my $val = $self->recurse_where($value, uc $1);
+ if ($val->{op} eq $ret->{op}) {
+ push @args, @{$val->{args}};
+ }
+ else {
+ push @args, $val;
+ }
+ next;
+ }
+
+ push @args, $self->recurse_where($key);
+ }
+
+ return $args[0] if @args == 1;
+
+ return $ret;
}
- method recurse_where(LogicEsnum $where) {
-
+ method field(Str $key, $value) returns (AST) {
+ my $op = $CMP_MAP{$self->cmp} || $self->cmp;
+ my $ret = {
+ -type => 'expr',
+ op => $op,
+ args => [
+ $self->mk_name(1, $key)
+ ],
+ };
+
+ if (is_HashRef($value)) {
+ my ($op, @rest) = keys %$value;
+ confess "Don't know how to handle " . dump($value) . " (too many keys)"
+ if @rest;
+
+ # TODO: Validate the op?
+ if ($op =~ /^-([a-z_]+)$/i) {
+ $ret->{op} = lc $1;
+
+ if (is_ArrayRef($value->{$op})) {
+ push @{$ret->{args}}, $self->value($_)
+ for @{$value->{$op}};
+ return $ret;
+ }
+ }
+ else {
+ $ret->{op} = $op;
+ }
+
+ push @{$ret->{args}}, $self->value($value->{$op});
+
+ }
+ elsif (is_ArrayRef($value)) {
+ # Return an or clause, sort of.
+ return {
+ -type => 'expr',
+ op => 'or',
+ args => [ map {
+ {
+ -type => 'expr',
+ op => $op,
+ args => [
+ { -type => 'name', args => [$key] },
+ $self->value($_)
+ ],
+ }
+ } @$value ]
+ };
+ }
+ else {
+ push @{$ret->{args}}, $self->value($value);
+ }
+
+ return $ret;
+ }
+
+ method value($value) returns (AST) {
+ return $self->apply_convert( { -type => 'value', value => $value })
+ if is_Str($value);
+
+ confess "Don't know how to handle terminal value " . dump($value);
}
+ method apply_convert(AST $ast) {
+ return $ast unless $self->has_field_convertor;
+
+ return {
+ -type => 'expr',
+ op => $self->convert,
+ args => [ $ast ]
+ };
+ }
+
+
}
=head1 NAME
enum LogicEnum, qw(OR AND);
+ coerce LogicEnum, from Str, via { uc $_ };
+
subtype WhereType, as Str|ArrayRef|HashRef|ScalarRef;
}
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 10;
use Test::Differences;
use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
is $sqla->dispatch( { -type => 'name', args => [qw/me id/] }), "me.id",
"Simple name generator";
+is $sqla->dispatch( { -type => 'name', args => ['*'] } ),
+ "*",
+ "* name generator";
+
is $sqla->dispatch( { -type => 'name', args => [qw/me */]}),
"me.*",
"Simple name generator";
use strict;
use warnings;
-use Test::More tests => 2;
+use Test::More tests => 5;
use Test::Exception;
use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
lives_ok {
$sqla->quote_chars('[]');
} "coercion of quote_chars from Str works";
+
+
+is $sqla->dispatch( { -type => 'name', args => [qw/me id/] }),
+ "[me].[id]",
+ "me.id";
+
+
+is $sqla->dispatch( { -type => 'name', args => [qw/me */] }),
+ "[me].*",
+ "me.*";
+
+
+is $sqla->dispatch( { -type => 'name', args => [qw/*/] }),
+ "*",
+ "*";
use strict;
use warnings;
-use Test::More tests => 13;
+use Test::More tests => 14;
use Test::Differences;
use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
],
"NOT IN clause");
+
+
+is $sqla->dispatch(
+ { -type => 'expr',
+ op => 'like',
+ args => [
+ {-type => name => args => [qw/me id/] },
+ { -type => 'value', value => 500 }
+ ]
+ }
+), "me.id LIKE ?",
+ "LIKE expr clause";
--- /dev/null
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Differences;
+
+use_ok('SQL::Abstract') or BAIL_OUT( "$@" );
+
+my $sqla = SQL::Abstract->create(1);
+
+is $sqla->dispatch(
+ { -type => 'expr',
+ op => '==',
+ args => [
+ { -type => 'expr',
+ op => 'ROUND',
+ args => [
+ {-type => name => args => [qw/me id/] },
+ ]
+ },
+ { -type => 'expr',
+ op => 'ROUND',
+ args => [
+ { -type => 'value', value => 500 }
+ ]
+ },
+ ]
+ }
+), "ROUND(me.id) = ROUND(?)",
+ "simple expr clause";
+
+is $sqla->dispatch(
+ { -type => 'expr',
+ op => 'last_insert_id',
+ }
+), "last_insert_id()",
+ "last_insert_id";
+
+is $sqla->dispatch(
+ { -type => 'expr',
+ op => 'between',
+ args => [
+ {-type => name => args => [qw/me id/] },
+ { -type => 'value', value => 500 },
+ { -type => 'value', value => 599 },
+ ],
+ }
+), "me.id BETWEEN ? AND ?",
+ "between";
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use SQL::Abstract::Test import => ['is_same_sql_bind'];
+
+#LDNOTE: renamed all "bind" into "where" because that's what they are
+
+my @handle_tests = (
+ #1
+ {
+ args => {logic => 'OR'},
+# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
+# LDNOTE: modified the line above (changing the test suite!!!) because
+# the test was not consistent with the doc: hashrefs should not be
+# influenced by the current logic, they always mean 'AND'. So
+# { a => 4, b => 0} should ALWAYS mean ( a = ? AND b = ? ).
+#
+# acked by RIBASUSHI
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+
+ #2
+ {
+ args => {},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #3
+ {
+ args => {case => "upper"},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #4
+ {
+ args => {case => "upper", cmp => "="},
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #5
+ {
+ args => {cmp => "=", logic => 'or'},
+# LDNOTE idem
+# stmt => 'SELECT * FROM test WHERE ( a = ? OR b = ? )'
+# acked by RIBASUSHI
+ stmt => 'SELECT * FROM test WHERE ( a = ? AND b = ? )'
+ },
+ #6
+ {
+ args => {cmp => "like"},
+ stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
+ },
+ #7
+ {
+ args => {logic => "or", cmp => "like"},
+# LDNOTE idem
+# stmt => 'SELECT * FROM test WHERE ( a LIKE ? OR b LIKE ? )'
+# acked by RIBASUSHI
+ stmt => 'SELECT * FROM test WHERE ( a LIKE ? AND b LIKE ? )'
+ },
+ #8
+ {
+ todo => 'lower',
+ args => {case => "lower"},
+ stmt => 'select * from test where ( a = ? and b = ? )'
+ },
+ #9
+ {
+ todo => 'lower',
+ args => {case => "lower", cmp => "="},
+ stmt => 'select * from test where ( a = ? and b = ? )'
+ },
+ #10
+ {
+ todo => 'lower',
+ args => {case => "lower", cmp => "like"},
+ stmt => 'select * from test where ( a like ? and b like ? )'
+ },
+ #11
+ {
+ todo => 'lower',
+ args => {case => "lower", convert => "lower", cmp => "like"},
+ stmt => 'select * from test where ( lower(a) like lower(?) and lower(b) like lower(?) )'
+ },
+ #12
+ {
+ args => {convert => "Round"},
+ stmt => 'SELECT * FROM test WHERE ( ROUND(a) = ROUND(?) AND ROUND(b) = ROUND(?) )',
+ },
+ #13
+ {
+ todo => 'lower',
+ args => {convert => "lower"},
+ stmt => 'SELECT * FROM test WHERE ( ( LOWER(ticket) = LOWER(?) ) OR ( LOWER(hostname) = LOWER(?) ) OR ( LOWER(taco) = LOWER(?) ) OR ( LOWER(salami) = LOWER(?) ) )',
+ where => [ { ticket => 11 }, { hostname => 11 }, { taco => 'salad' }, { salami => 'punch' } ],
+ },
+ #14
+ {
+ args => {convert => "upper"},
+ stmt => 'SELECT * FROM test WHERE ( ( UPPER(hostname) IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) AND ( ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) OR ( UPPER(ticket) = UPPER(?) ) ) ) OR ( UPPER(tack) BETWEEN UPPER(?) AND UPPER(?) ) OR ( ( ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) OR ( UPPER(a) = UPPER(?) ) ) AND ( ( UPPER(e) != UPPER(?) ) OR ( UPPER(e) != UPPER(?) ) ) AND UPPER(q) NOT IN ( UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?), UPPER(?) ) ) )',
+ where => [ { ticket => [11, 12, 13],
+ hostname => { in => ['ntf', 'avd', 'bvd', '123'] } },
+ { tack => { between => [qw/tick tock/] } },
+ { a => [qw/b c d/],
+ e => { '!=', [qw(f g)] },
+ q => { 'not in', [14..20] } } ],
+ },
+
+);
+
+plan tests => (1 + scalar(@handle_tests));
+
+use_ok('SQL::Abstract::Compat');
+
+for (@handle_tests) {
+ my $sql = SQL::Abstract::Compat->new($_->{args});
+ my $where = $_->{where} || { a => 4, b => 0};
+ my($stmt, @bind) = $sql->select('test', '*', $where);
+
+ local $TODO = $_->{todo};
+
+ # LDNOTE: this original test suite from NWIGER did no comparisons
+ # on @bind values, just checking if @bind is nonempty.
+ # So here we just fake a [1] bind value for the comparison.
+ is_same_sql_bind($stmt, [@bind ? 1 : 0], $_->{stmt}, [1]);
+}
use strict;
use warnings;
-use SQL::Abstract::AST::Compat;
+use SQL::Abstract::Compat;
-use Test::More tests => 6;
+use Test::More tests => 12;
use Test::Differences;
-ok(my $visitor = SQL::Abstract::AST::Compat->new);
+ok(my $visitor = SQL::Abstract::Compat->new);
-my $foo_eq_1 = {
- -type => 'expr',
- op => '==',
- args => [
- { -type => 'name', args => [qw/foo/] },
- { -type => 'value', value => 1 }
- ]
-};
+
+my $foo_id = { -type => 'name', args => [qw/foo/] };
+my $bar_id = { -type => 'name', args => [qw/bar/] };
+
+my $foo_eq_1 = field_op_value($foo_id, '==', 1);
+my $bar_eq_str = field_op_value($bar_id, '==', 'some str');
eq_or_diff
- $visitor->generate({ foo => 1 }),
+ $visitor->recurse_where({ foo => 1 }),
$foo_eq_1,
"Single value hash";
-my $bar_eq_str = {
- -type => 'expr',
- op => '==',
- args => [
- { -type => 'name', args => [qw/bar/] },
- { -type => 'value', value => 'some str' }
- ]
-};
eq_or_diff
- $visitor->generate({ foo => 1, bar => 'some str' }),
+ $visitor->recurse_where({ foo => 1, bar => 'some str' }),
{ -type => 'expr',
op => 'and',
args => [
"two keys in hash";
eq_or_diff
- $visitor->generate({ -or => { foo => 1, bar => 'some str' } }),
+ $visitor->recurse_where({ -or => { foo => 1, bar => 'some str' } }),
{ -type => 'expr',
op => 'or',
args => [
eq_or_diff
- $visitor->generate([ -and => { foo => 1, bar => 'some str' } ]),
+ $visitor->recurse_where([ -and => { foo => 1, bar => 'some str' } ]),
{ -type => 'expr',
op => 'and',
args => [
eq_or_diff
- $visitor->generate([ -and => { foo => 1, bar => 'some str' }, { foo => 1} ]),
+ $visitor->recurse_where([ -and => { foo => 1, bar => 'some str' }, { foo => 1} ]),
{ -type => 'expr',
op => 'or',
args => [
$foo_eq_1,
]
},
- "-and as first element of array";
+ "-and as first element of array + hash";
+
+eq_or_diff
+ $visitor->recurse_where({ foo => { '!=' => 'bar' } }),
+ field_op_value($foo_id, '!=', 'bar'),
+ "foo => { '!=' => 'bar' }";
+
+eq_or_diff
+ $visitor->recurse_where({ foo => [ 1, 'bar' ] }),
+ { -type => 'expr',
+ op => 'or',
+ args => [
+ $foo_eq_1,
+ field_op_value($foo_id, '==', 'bar'),
+ ],
+ },
+ "foo => [ 1, 'bar' ]";
+
+eq_or_diff
+ $visitor->recurse_where({ foo => { -in => [ 1, 'bar' ] } }),
+ { -type => 'expr',
+ op => 'in',
+ args => [
+ $foo_id,
+ { -type => 'value', value => 1 },
+ { -type => 'value', value => 'bar' },
+ ]
+ },
+ "foo => { -in => [ 1, 'bar' ] }";
+
+eq_or_diff
+ $visitor->recurse_where({ foo => { -not_in => [ 1, 'bar' ] } }),
+ { -type => 'expr',
+ op => 'not_in',
+ args => [
+ $foo_id,
+ { -type => 'value', value => 1 },
+ { -type => 'value', value => 'bar' },
+ ]
+ },
+ "foo => { -not_in => [ 1, 'bar' ] }";
+
+eq_or_diff
+ $visitor->recurse_where({ foo => { -in => [ ] } }),
+ { -type => 'expr',
+ op => 'in',
+ args => [
+ $foo_id,
+ ]
+ },
+ "foo => { -in => [ ] }";
+
+my $worker_eq = sub {
+ return {
+ -type => 'expr',
+ op => '==',
+ args => [
+ { -type => 'name', args => ['worker'] },
+ { -type => 'value', value => $_[0] },
+ ],
+ }
+};
+eq_or_diff
+ $visitor->recurse_where( {
+ requestor => 'inna',
+ worker => ['nwiger', 'rcwe', 'sfz'],
+ status => { '!=', 'completed' }
+ } ),
+ { -type => 'expr',
+ op => 'and',
+ args => [
+ field_op_value(qw/status != completed/),
+ { -type => 'expr',
+ op => 'or',
+ args => [
+ field_op_value(qw/worker == nwiger/),
+ field_op_value(qw/worker == rcwe/),
+ field_op_value(qw/worker == sfz/),
+ ]
+ },
+ field_op_value(qw/requestor == inna/),
+ ]
+ },
+ "complex expr #1";
+
+
+
+sub field_op_value {
+ my ($field, $op, $value) = @_;
+
+ $field = ref $field eq 'HASH'
+ ? $field
+ : ref $field eq 'ARRAY'
+ ? { -type => 'name', args => $field }
+ : { -type => 'name', args => [$field] };
+
+ $value = ref $value eq 'HASH'
+ ? $value
+ : { -type => 'value', value => $value };
+
+ return {
+ -type => 'expr',
+ op => $op,
+ args => [
+ $field,
+ $value
+ ]
+ };
+}
projects / dbsrgits/SQL-Abstract-2.0-ish.git / commitdiff