Commit | Line | Data |
9ee33178 |
1 | package Data::Query::ExprBuilder; |
2 | |
3 | use strictures 1; |
b616bc41 |
4 | use Data::Query::Constants qw(DQ_OPERATOR DQ_VALUE); |
5 | use Scalar::Util (); |
6 | |
7 | use overload ( |
c3633a0e |
8 | # unary operators |
9 | (map { |
10 | my $op = $_; |
11 | $op => sub { |
12 | Data::Query::ExprBuilder->new({ |
13 | expr => { |
14 | type => DQ_OPERATOR, |
15 | operator => { perl => $op }, |
16 | args => [ $_[0]->{expr} ] |
17 | } |
18 | }); |
19 | } |
20 | } qw(! neg)), |
7e599929 |
21 | # binary operators |
b616bc41 |
22 | (map { |
7e599929 |
23 | my ($overload, $as) = ref($_) ? @$_ : ($_, $_); |
24 | $overload => sub { |
b616bc41 |
25 | Data::Query::ExprBuilder->new({ |
26 | expr => { |
27 | type => DQ_OPERATOR, |
7e599929 |
28 | operator => { perl => $as }, |
b616bc41 |
29 | args => [ |
30 | map { |
31 | (Scalar::Util::blessed($_) |
32 | && $_->isa('Data::Query::ExprBuilder')) |
33 | ? $_->{expr} |
34 | : { |
35 | type => DQ_VALUE, |
36 | subtype => { perl => 'Scalar' }, |
37 | value => $_ |
38 | } |
c3633a0e |
39 | # we're called with ($left, $right, 0) or ($right, $left, 1) |
b616bc41 |
40 | } $_[2] ? @_[1,0] : @_[0,1] |
41 | ] |
42 | }, |
43 | }); |
44 | } |
7e599929 |
45 | } |
46 | qw(+ - * / % ** << >> . < > == != lt le gt ge eq ne), |
47 | |
48 | # since 'and' and 'or' aren't operators we borrow the bitwise ops |
49 | [ '&' => 'and' ], [ '|' => 'or' ], |
50 | ), |
51 | # unsupported |
9e0200bc |
52 | (map { |
53 | my $op = $_; |
54 | $op => sub { die "Can't use operator $op on a ".ref($_[0]) } |
7e599929 |
55 | } qw(<=> cmp x ^ ~) |
9e0200bc |
56 | ), |
b616bc41 |
57 | ); |
9ee33178 |
58 | |
59 | sub new { |
60 | bless({ %{$_[1]} }, (ref($_[0])||$_[0])); |
61 | } |
62 | |
63 | 1; |