From: Matt S Trout Date: Sat, 5 Jun 2010 18:05:50 +0000 (+0100) Subject: basic binary operator code X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b616bc41d387d47d66025ac257990059169105a7;p=dbsrgits%2FData-Query.git basic binary operator code --- diff --git a/lib/Data/Query/Constants.pm b/lib/Data/Query/Constants.pm index d6e58ae..1a9debc 100644 --- a/lib/Data/Query/Constants.pm +++ b/lib/Data/Query/Constants.pm @@ -6,6 +6,8 @@ use Exporter 'import'; use constant +{ (our %CONST = ( DQ_IDENTIFIER => 'Identifier', + DQ_OPERATOR => 'Operator', + DQ_VALUE => 'Value', )) }; diff --git a/lib/Data/Query/ExprBuilder.pm b/lib/Data/Query/ExprBuilder.pm index a1767f1..b1df317 100644 --- a/lib/Data/Query/ExprBuilder.pm +++ b/lib/Data/Query/ExprBuilder.pm @@ -1,6 +1,34 @@ package Data::Query::ExprBuilder; use strictures 1; +use Data::Query::Constants qw(DQ_OPERATOR DQ_VALUE); +use Scalar::Util (); + +use overload ( + (map { + my $op = $_; + $op => sub { + Data::Query::ExprBuilder->new({ + expr => { + type => DQ_OPERATOR, + operator => { perl => $op }, + args => [ + map { + (Scalar::Util::blessed($_) + && $_->isa('Data::Query::ExprBuilder')) + ? $_->{expr} + : { + type => DQ_VALUE, + subtype => { perl => 'Scalar' }, + value => $_ + } + } $_[2] ? @_[1,0] : @_[0,1] + ] + }, + }); + } + } qw(==)) +); sub new { bless({ %{$_[1]} }, (ref($_[0])||$_[0])); diff --git a/t/expr.t b/t/expr.t index d408e42..e52930d 100644 --- a/t/expr.t +++ b/t/expr.t @@ -1,9 +1,13 @@ use strictures 1; use Test::More qw(no_plan); use Data::Query::ExprBuilder::Identifier; -use Data::Query::Constants qw(DQ_IDENTIFIER); +use Data::Query::Constants qw(DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE); -sub mk_expr { +sub expr (&) { + _mk_expr($_[0]); +} + +sub _mk_expr { local $_ = Data::Query::ExprBuilder::Identifier->new({ expr => { type => DQ_IDENTIFIER, @@ -15,7 +19,7 @@ sub mk_expr { sub expr_is (&;@) { my $sub = shift; - is_deeply(mk_expr($sub), @_); + is_deeply(_mk_expr($sub), @_); } expr_is { $_->foo } @@ -32,3 +36,18 @@ expr_is { $_->foo->bar } elements => [ 'foo', 'bar' ] }, 'Nested identifier ok'; + +expr_is { $_->foo == 3 } + { + type => DQ_OPERATOR, + operator => { perl => '==' }, + args => [ + expr { $_->foo }, + { + type => DQ_VALUE, + subtype => { perl => 'Scalar' }, + value => 3, + }, + ], + }, + 'Simple equality ok';