stop treating old special ops normally
[scpubgit/Q-Branch.git] / lib / SQL / Abstract.pm
index 131126b..cf70129 100644 (file)
@@ -168,11 +168,8 @@ sub new {
   # special operators
   $opt{special_ops} ||= [];
 
-  # regexes are applied in order, thus push after user-defines
-  push @{$opt{special_ops}}, @BUILTIN_SPECIAL_OPS;
-
   if ($class->isa('DBIx::Class::SQLMaker')) {
-    $opt{is_dbic_sqlmaker} = 1;
+    $opt{warn_once_on_nest} = 1;
     $opt{disable_old_special_ops} = 1;
   }
 
@@ -204,12 +201,20 @@ sub new {
     -bind => sub { shift; +{ @_ } },
     -in => '_expand_in',
     -not_in => '_expand_in',
-    -tuple => sub {
+    -row => sub {
       my ($self, $node, $args) = @_;
       +{ $node => [ map $self->expand_expr($_), @$args ] };
     },
     -between => '_expand_between',
     -not_between => '_expand_between',
+    -op => sub {
+      my ($self, $node, $args) = @_;
+      my ($op, @opargs) = @$args;
+      +{ $node => [ $op, map $self->expand_expr($_), @opargs ] };
+    },
+    (map +($_ => '_expand_op_is'), ('-is', '-is_not')),
+    -ident => '_expand_ident',
+    -value => '_expand_value',
   };
 
   $opt{expand_op} = {
@@ -220,25 +225,12 @@ sub new {
     'nest' => '_expand_nest',
     (map +($_ => '_expand_op_andor'), ('and', 'or')),
     (map +($_ => '_expand_op_is'), ('is', 'is_not')),
+    'ident' => '_expand_ident',
+    'value' => '_expand_value',
   };
 
-  # placeholder for _expand_unop system
-  {
-    my %unops = (-ident => '_expand_ident', -value => '_expand_value');
-    foreach my $name (keys %unops) {
-      $opt{expand}{$name} = $unops{$name};
-      my ($op) = $name =~ /^-(.*)$/;
-      $opt{expand_op}{$op} = sub {
-        my ($self, $op, $arg, $k) = @_;
-        return $self->_expand_expr_hashpair_cmp(
-          $k, { "-${op}" => $arg }
-        );
-      };
-    }
-  }
-
   $opt{render} = {
-    (map +("-$_", "_render_$_"), qw(op func bind ident literal tuple)),
+    (map +("-$_", "_render_$_"), qw(op func bind ident literal row)),
     %{$opt{render}||{}}
   };
 
@@ -739,8 +731,13 @@ sub _expand_expr_hashpair_op {
 
     if (
       (our $Expand_Depth) == 1
-      and $self->{disable_old_special_ops}
-      and List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
+      and (
+        List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}
+        or (
+          $self->{disable_old_special_ops}
+          and List::Util::first { $op =~ $_->{regex} } @BUILTIN_SPECIAL_OPS
+        )
+      )
     ) {
       puke "Illegal use of top-level '-$op'"
     }
@@ -886,7 +883,10 @@ sub _dwim_op_to_is {
 }
 
 sub _expand_ident {
-  my ($self, $op, $body) = @_;
+  my ($self, $op, $body, $k) = @_;
+  return $self->_expand_expr_hashpair_cmp(
+    $k, { -ident => $body }
+  ) if defined($k);
   unless (defined($body) or (ref($body) and ref($body) eq 'ARRAY')) {
     puke "$op requires a single plain scalar argument (a quotable identifier) or an arrayref of identifier parts";
   }
@@ -900,6 +900,9 @@ sub _expand_ident {
 }
 
 sub _expand_value {
+  return $_[0]->_expand_expr_hashpair_cmp(
+    $_[3], { -value => $_[2] },
+  ) if defined($_[3]);
   +{ -bind => [ our $Cur_Col_Meta, $_[2] ] };
 }
 
@@ -972,6 +975,8 @@ sub _expand_op_andor {
 
 sub _expand_op_is {
   my ($self, $op, $vv, $k) = @_;
+  $op =~ s/^-//;
+  ($k, $vv) = @$vv unless defined $k;
   puke "$op can only take undef as argument"
     if defined($vv)
        and not (
@@ -979,14 +984,13 @@ sub _expand_op_is {
          and exists($vv->{-value})
          and !defined($vv->{-value})
        );
-  return +{ -op => [ $op.'_null', $self->_expand_ident(-ident => $k) ] };
+  return +{ -op => [ $op.'_null', $self->expand_expr($k, -ident) ] };
 }
 
 sub _expand_between {
   my ($self, $op, $vv, $k) = @_;
   $op =~ s/^-//;
   $k = shift @{$vv = [ @$vv ]} unless defined $k;
-  local our $Cur_Col_Meta = $k;
   my @rhs = map $self->_expand_expr($_),
               ref($vv) eq 'ARRAY' ? @$vv : $vv;
   unless (
@@ -998,7 +1002,7 @@ sub _expand_between {
   }
   return +{ -op => [
     $op,
-    $self->_expand_ident(-ident => $k),
+    $self->expand_expr(ref($k) ? $k : { -ident => $k }),
     @rhs
   ] }
 }
@@ -1039,7 +1043,7 @@ sub _expand_nest {
   my ($self, $op, $v) = @_;
   # DBIx::Class requires a nest warning to be emitted once but the private
   # method it overrode to do so no longer exists
-  if ($self->{is_dbic_sqlmaker}) {
+  if ($self->{warn_once_on_nest}) {
     unless (our $Nest_Warned) {
       belch(
         "-nest in search conditions is deprecated, you most probably wanted:\n"
@@ -1080,7 +1084,7 @@ sub _render_ident {
   return $self->_convert($self->_quote($ident));
 }
 
-sub _render_tuple {
+sub _render_row {
   my ($self, $values) = @_;
   my ($sql, @bind) = $self->_render_op([ ',', @$values ]);
   return "($sql)", @bind;