identifier expr builder

diff --git a/lib/Data/Query/Constants.pm b/lib/Data/Query/Constants.pm
new file mode 100644 (file)
index 0000000..d6e58ae
--- /dev/null
+++ b/lib/Data/Query/Constants.pm
@@ -0,0 +1,14 @@
+package Data::Query::Constants;
+
+use strictures 1;
+use Exporter 'import';
+
+use constant +{
+  (our %CONST = (
+    DQ_IDENTIFIER => 'Identifier',
+  ))
+};
+
+our @EXPORT_OK = keys our %CONST;
+
+1;

diff --git a/lib/Data/Query/ExprBuilder.pm b/lib/Data/Query/ExprBuilder.pm
new file mode 100644 (file)
index 0000000..a1767f1
--- /dev/null
+++ b/lib/Data/Query/ExprBuilder.pm
@@ -0,0 +1,9 @@
+package Data::Query::ExprBuilder;
+
+use strictures 1;
+
+sub new {
+  bless({ %{$_[1]} }, (ref($_[0])||$_[0]));
+}
+
+1;

diff --git a/lib/Data/Query/ExprBuilder/Identifier.pm b/lib/Data/Query/ExprBuilder/Identifier.pm
new file mode 100644 (file)
index 0000000..b62875f
--- /dev/null
+++ b/lib/Data/Query/ExprBuilder/Identifier.pm
@@ -0,0 +1,32 @@
+package Data::Query::ExprBuilder::Identifier;
+
+use strictures 1;
+
+use base qw(Data::Query::ExprBuilder);
+use Data::Query::Constants qw(DQ_IDENTIFIER);
+
+sub DESTROY { }
+
+sub can { 
+  my $name = $_[1];
+  sub {
+    return (ref($_[0])||$_[0])->new({
+      expr => {
+        type => DQ_IDENTIFIER,
+        elements => [ @{$_[0]->{expr}{elements}}, $name ]
+      },
+    });
+  };
+}
+
+sub AUTOLOAD {
+  (my $auto = our $AUTOLOAD) =~ s/.*:://;
+  return (ref($_[0])||$_[0])->new({
+    expr => {
+      type => DQ_IDENTIFIER,
+      elements => [ @{$_[0]->{expr}{elements}}, $auto ]
+    },
+  });
+}
+
+1;

diff --git a/t/expr.t b/t/expr.t
new file mode 100644 (file)
index 0000000..d408e42
--- /dev/null
+++ b/t/expr.t
@@ -0,0 +1,34 @@
+use strictures 1;
+use Test::More qw(no_plan);
+use Data::Query::ExprBuilder::Identifier;
+use Data::Query::Constants qw(DQ_IDENTIFIER);
+
+sub mk_expr {
+  local $_ = Data::Query::ExprBuilder::Identifier->new({
+    expr => {
+      type => DQ_IDENTIFIER,
+      elements => [],
+    },
+  });
+  $_[0]->()->{expr};
+}
+
+sub expr_is (&;@) {
+  my $sub = shift;
+  is_deeply(mk_expr($sub), @_);
+}
+
+expr_is { $_->foo }
+  {
+    type => DQ_IDENTIFIER,
+    elements => [ 'foo' ]
+  },
+  'Simple identifier ok';
+
+
+expr_is { $_->foo->bar }
+  {
+    type => DQ_IDENTIFIER,
+    elements => [ 'foo', 'bar' ]
+  },
+  'Nested identifier ok';