X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FConverter.pm;h=0e134b0bc9b193e4c4dbeb2226de61c4ab01c06b;hb=9ea5bb0fa6703634d4f5169236586a2708a44696;hp=c4c8295aa308f8cf28aa452602e14a9a18e02a46;hpb=5245699d8ed21cf994541a1bd79b66f69a9b238b;p=dbsrgits%2FSQL-Abstract.git

diff --git a/lib/SQL/Abstract/Converter.pm b/lib/SQL/Abstract/Converter.pm
index c4c8295..0e134b0 100644
--- a/lib/SQL/Abstract/Converter.pm
+++ b/lib/SQL/Abstract/Converter.pm
@@ -4,6 +4,7 @@ use Carp ();
 use List::Util ();
 use Scalar::Util ();
 use Data::Query::ExprHelpers;
+use Sub::Quote 'quote_sub';
 use Moo;
 use namespace::clean;
 
@@ -16,44 +17,65 @@ has lower_case => (
 );
 
 has default_logic => (
-  is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
+  is => 'ro', coerce => quote_sub( 'uc($_[0])' ), default => 'OR'
 );
 
 has bind_meta => (
-  is => 'ro', default => sub { 1 }
+  is => 'ro', default => 1
 );
 
-has cmp => (is => 'ro', default => sub { '=' });
+has cmp => (is => 'ro', default => '=' );
 
-has sqltrue => (is => 'ro', default => sub { '1=1' });
-has sqlfalse => (is => 'ro', default => sub { '0=1' });
+has sqltrue => (is => 'ro', default => '1=1' );
+has sqlfalse => (is => 'ro', default => '0=1' );
 
-has special_ops => (is => 'ro', default => sub { [] });
+has special_ops => (is => 'ro', default => quote_sub( '[]' ) );
 
 # XXX documented but I don't current fail any tests not using it
-has unary_ops => (is => 'ro', default => sub { [] });
+has unary_ops => (is => 'ro', default => quote_sub( '[]' ) );
 
 has injection_guard => (
   is => 'ro',
-  default => sub {
+  default => quote_sub( q{
     qr/
       \;
         |
       ^ \s* go \s
     /xmi;
-  }
+  } ),
 );
 
 has identifier_sep => (
-  is => 'ro', default => sub { '.' },
+  is => 'ro', default => '.',
 );
 
-has always_quote => (is => 'ro', default => sub { 1 });
+has always_quote => (is => 'ro', default => 1);
 
 has convert => (is => 'ro');
 
 has array_datatypes => (is => 'ro');
 
+has equality_op => (
+  is => 'ro',
+  default => quote_sub( q{ qr/^ (?: = ) $/ix } ),
+);
+
+has inequality_op => (
+  is => 'ro',
+  default => quote_sub( q{ qr/^ (?: != | <> ) $/ix } ),
+);
+
+has like_op => (
+  is => 'ro',
+  default => quote_sub( q{ qr/^ (?: is \s+ )? r?like $/xi } ),
+);
+
+has not_like_op => (
+  is => 'ro',
+  default => quote_sub( q{ qr/^ (?: is \s+ )? not \s+ r?like $/xi } ),
+);
+
+
 sub _literal_to_dq {
   my ($self, $literal) = @_;
   my @bind;
@@ -507,6 +529,8 @@ sub _where_hashpair_to_dq {
           $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
         );
       }
+      die "Operator '$op' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref"
+        if $op =~ /^(?:NOT )?BETWEEN$/ and (@$rhs != 2 or grep !defined, @$rhs);
       if (grep !defined, @$rhs) {
         my ($inop, $logic, $nullop) = $op =~ /^NOT/
           ? (-not_in => AND => { '!=' => undef })
@@ -525,7 +549,7 @@ sub _where_hashpair_to_dq {
       return $self->_op_to_dq(
         $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
       )
-    } elsif ($op =~ s/^NOT (?!LIKE)//) {
+    } elsif ($op =~ s/^NOT (?!R?LIKE)//) {
       return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
     } elsif ($op eq 'IDENT') {
       return $self->_op_to_dq(
@@ -537,9 +561,15 @@ sub _where_hashpair_to_dq {
       );
     } elsif (!defined($rhs)) {
       my $null_op = do {
-        if ($op eq '=' or $op eq 'LIKE' or $op eq 'IS') {
+        warn "Supplying an undefined argument to '$op' is deprecated"
+          if $op =~ $self->like_op or $op =~ $self->not_like_op;
+        if ($op =~ $self->equality_op or $op =~ $self->like_op or $op eq 'IS') {
           'IS NULL'
-        } elsif ($op eq '!=' or $op eq 'NOT LIKE' or $op eq 'IS NOT') {
+        } elsif (
+          $op =~ $self->inequality_op or $op =~ $self->not_like_op
+            or
+          $op eq 'IS NOT' or $op eq 'NOT'
+        ) {
           'IS NOT NULL'
         } else {
           die "Can't do undef -> NULL transform for operator ${op}";
@@ -549,8 +579,14 @@ sub _where_hashpair_to_dq {
     }
     if (ref($rhs) eq 'ARRAY') {
       if (!@$rhs) {
+        if ($op =~ $self->like_op or $op =~ $self->not_like_op) {
+          warn "Supplying an empty arrayref to '$op' is deprecated";
+        } elsif ($op !~ $self->equality_op and $op !~ $self->inequality_op) {
+          die "operator '$op' applied on an empty array (field '$k')";
+        }
         return $self->_literal_to_dq(
-          $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
+          ($op =~ $self->inequality_op or $op =~ $self->not_like_op)
+            ? $self->{sqltrue} : $self->{sqlfalse}
         );
       } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
         return $self->_expr_to_dq_ARRAYREF([
@@ -558,6 +594,10 @@ sub _where_hashpair_to_dq {
         ], uc($1));
       } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
         die "Use of [and|or|nest]_N modifiers is no longer supported";
+      } elsif (@$rhs > 1 and ($op =~ $self->inequality_op or $op =~ $self->not_like_op)) {
+        warn "A multi-element arrayref as an argument to the inequality op '$op' "
+          . 'is technically equivalent to an always-true 1=1 (you probably wanted '
+          . "to say ...{ \$inequality_op => [ -and => \@values ] }... instead)";
       }
       return $self->_expr_to_dq_ARRAYREF([
         map +{ $k => { $op => $_ } }, @$rhs
@@ -603,13 +643,13 @@ sub _order_by_to_dq {
     $dq->{by} = $$arg;
   } elsif (ref($arg) eq 'SCALAR') {
 
-    # < mst> right, but if it doesn't match that, it goes "ok, right, not sure, 
+    # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
     #        totally leaving this untouched as a literal"
     # < mst> so I -think- it's relatively robust
     # < ribasushi> right, it's relatively safe then
     # < ribasushi> is this regex centralized?
     # < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
-    # < mst> it only exists because you were kind enough to support new 
+    # < mst> it only exists because you were kind enough to support new
     #        dbihacks crack combined with old literal order_by crack
     # < ribasushi> heh :)