Factor out binop construction
[dbsrgits/Data-Query.git] / lib / Data / Query / ExprBuilder.pm
index 3c62973..af3552a 100644 (file)
@@ -4,6 +4,19 @@ use strictures 1;
 use Scalar::Util ();
 use Data::Query::ExprHelpers qw(perl_scalar_value perl_operator);
 
+sub _perl_binop {
+  return perl_operator(
+    shift,
+    map {
+      (Scalar::Util::blessed($_)
+      && $_->isa('Data::Query::ExprBuilder'))
+        ? $_->{expr}
+        : perl_scalar_value($_)
+       # we're called with ($left, $right, 0) or ($right, $left, 1)
+    } $_[2] ? @_[1,0] : @_[0,1]
+  );
+}
+
 use overload (
   # unary operators
   (map {
@@ -19,16 +32,7 @@ use overload (
     my ($overload, $as) = ref($_) ? @$_ : ($_, $_);
     $overload => sub {
       Data::Query::ExprBuilder->new({
-        expr => perl_operator(
-           $as,
-           map {
-             (Scalar::Util::blessed($_)
-             && $_->isa('Data::Query::ExprBuilder'))
-               ? $_->{expr}
-               : perl_scalar_value($_)
-              # we're called with ($left, $right, 0) or ($right, $left, 1)
-            } $_[2] ? @_[1,0] : @_[0,1]
-          )
+        expr => _perl_binop($as, @_),
       });
     }
   }
@@ -40,22 +44,13 @@ use overload (
 
   # equality operators (need undef maping)
   (map {
-    my ($overload, $as) = ref($_) ? @$_ : ($_, $_);
-    $overload => sub {
+    my $op = $_;
+    $op => sub {
       Data::Query::ExprBuilder->new({
         expr => grep(!defined, @_[0,1])
-          ?  (map { $overload =~ /==|eq/ ? perl_operator(not => $_) : $_ }
+          ? (map { $op =~ /==|eq/ ? perl_operator(not => $_) : $_ }
               perl_operator(defined => map { defined($_) ? $_->{expr} : () } @_[0,1]))
-          :  perl_operator(
-               $as,
-               map {
-                 (Scalar::Util::blessed($_)
-                 && $_->isa('Data::Query::ExprBuilder'))
-                   ? $_->{expr}
-                   : perl_scalar_value($_)
-                  # we're called with ($left, $right, 0) or ($right, $left, 1)
-                } $_[2] ? @_[1,0] : @_[0,1]
-              )
+          : _perl_binop($op, @_),
       });
     }
   }