From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 16 Oct 2010 01:15:58 +0000 (+0100)
Subject: factor construction of simple expressions out into ExprHelpers.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12e6eab8ff2e8bab91319d401dd2e984a5e781e5;hp=7f666d37cdb3d9b82eb8b8f28dc6adf85856e11d;p=dbsrgits%2FData-Query.git

factor construction of simple expressions out into ExprHelpers.pm
---

diff --git a/lib/Data/Query/ExprBuilder.pm b/lib/Data/Query/ExprBuilder.pm
index ee30702..0c8ee7b 100644
--- a/lib/Data/Query/ExprBuilder.pm
+++ b/lib/Data/Query/ExprBuilder.pm
@@ -1,8 +1,8 @@
 package Data::Query::ExprBuilder;
 
 use strictures 1;
-use Data::Query::Constants qw(DQ_OPERATOR DQ_VALUE);
 use Scalar::Util ();
+use Data::Query::ExprHelpers qw(perl_scalar_value perl_operator);
 
 use overload (
   # unary operators
@@ -10,11 +10,7 @@ use overload (
     my $op = $_;
     $op => sub {
       Data::Query::ExprBuilder->new({
-        expr => {
-          type => DQ_OPERATOR,
-          operator => { Perl => $op },
-          args => [ $_[0]->{expr} ]
-        }
+        expr => perl_operator($op => $_[0]->{expr})
       });
     }
   } qw(! neg)),
@@ -23,23 +19,16 @@ use overload (
     my ($overload, $as) = ref($_) ? @$_ : ($_, $_);
     $overload => sub {
       Data::Query::ExprBuilder->new({
-        expr => {
-          type => DQ_OPERATOR,
-          operator => { Perl => $as },
-          args => [
+        expr => perl_operator(
+           $as,
            map {
              (Scalar::Util::blessed($_)
              && $_->isa('Data::Query::ExprBuilder'))
                ? $_->{expr}
-               : {
-                   type => DQ_VALUE,
-                   subtype => { Perl => 'Scalar' },
-                   value => $_
-                 }
+               : perl_scalar_value($_)
               # we're called with ($left, $right, 0) or ($right, $left, 1)
             } $_[2] ? @_[1,0] : @_[0,1]
-          ]
-        },
+          )
       });
     }
   }
diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm
new file mode 100644
index 0000000..1ba349e
--- /dev/null
+++ b/lib/Data/Query/ExprHelpers.pm
@@ -0,0 +1,27 @@
+package Data::Query::ExprHelpers;
+
+use strictures 1;
+use Data::Query::Constants qw(DQ_VALUE DQ_OPERATOR);
+
+use base qw(Exporter);
+
+our @EXPORT_OK = qw(perl_scalar_value perl_operator);
+
+sub perl_scalar_value {
+  +{
+      type => DQ_VALUE,
+      subtype => { Perl => 'Scalar' },
+      value => $_[0]
+  }
+}
+
+sub perl_operator {
+  my ($op, @args) = @_;
+  +{
+    type => DQ_OPERATOR,
+    operator => { Perl => $op },
+    args => \@args
+  }
+}
+
+1;
diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm
index f44fb54..cbfc1e9 100644
--- a/lib/Data/Query/Renderer/SQL/Naive.pm
+++ b/lib/Data/Query/Renderer/SQL/Naive.pm
@@ -78,16 +78,18 @@ sub _render_value {
   [ '?', $_[1] ];
 }
 
+sub _operator_type { 'SQL.Naive' }
+
 sub _render_operator {
   my ($self, $dq) = @_;
   my $op = $dq->{operator};
-  unless (exists $op->{'SQL.Naive'}) {
-    $op->{'SQL.Naive'} = $self->_convert_op($dq);
+  unless (exists $op->{$self->_operator_type}) {
+    $op->{$self->_operator_type} = $self->_convert_op($dq);
   }
-  if (my $op_type = $self->{simple_ops}{my $op_name = $op->{'SQL.Naive'}}) {
+  if (my $op_type = $self->{simple_ops}{my $op_name = $op->{$self->_operator_type}}) {
     return $self->${\"_handle_op_type_${op_type}"}($op_name, $dq);
   }
-  die "Couldn't render operator ".$op->{'SQL.Naive'};
+  die "Couldn't render operator ".$op->{$self->_operator_type};
 }
 
 sub _handle_op_type_binop {
@@ -125,11 +127,11 @@ sub _handle_op_type_flatten {
     }
 
     my $op = $arg->{operator};
-    unless (exists $op->{'SQL.Naive'}) {
-      $op->{'SQL.Naive'} = $self->_convert_op($arg);
+    unless (exists $op->{$self->_operator_type}) {
+      $op->{$self->_operator_type} = $self->_convert_op($arg);
     }
   
-    if ($op->{'SQL.Naive'} eq $op_name) {
+    if ($op->{$self->_operator_type} eq $op_name) {
       unshift @argq, @{$arg->{args}};
     } else {
       push @arg_final, $arg;