Merge branch 'master' into dq
Peter Rabbitson [Wed, 18 Dec 2013 09:29:56 +0000 (10:29 +0100)]
1  2 
Changes
lib/SQL/Abstract.pm
lib/SQL/Abstract/Converter.pm
t/01generate.t
t/05in_between.t

diff --cc Changes
Simple merge
Simple merge
index 42a25d0,0000000..e89ae42
mode 100644,000000..100644
--- /dev/null
@@@ -1,707 -1,0 +1,707 @@@
 +package SQL::Abstract::Converter;
 +
 +use Carp ();
 +use List::Util ();
 +use Scalar::Util ();
 +use Data::Query::ExprHelpers;
 +use Moo;
 +use namespace::clean;
 +
 +has renderer_will_quote => (
 +  is => 'ro'
 +);
 +
 +has lower_case => (
 +  is => 'ro'
 +);
 +
 +has default_logic => (
 +  is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
 +);
 +
 +has bind_meta => (
 +  is => 'ro', default => sub { 1 }
 +);
 +
 +has cmp => (is => 'ro', default => sub { '=' });
 +
 +has sqltrue => (is => 'ro', default => sub { '1=1' });
 +has sqlfalse => (is => 'ro', default => sub { '0=1' });
 +
 +has special_ops => (is => 'ro', default => sub { [] });
 +
 +# XXX documented but I don't current fail any tests not using it
 +has unary_ops => (is => 'ro', default => sub { [] });
 +
 +has injection_guard => (
 +  is => 'ro',
 +  default => sub {
 +    qr/
 +      \;
 +        |
 +      ^ \s* go \s
 +    /xmi;
 +  }
 +);
 +
 +has identifier_sep => (
 +  is => 'ro', default => sub { '.' },
 +);
 +
 +has always_quote => (is => 'ro', default => sub { 1 });
 +
 +has convert => (is => 'ro');
 +
 +has array_datatypes => (is => 'ro');
 +
 +sub _literal_to_dq {
 +  my ($self, $literal) = @_;
 +  my @bind;
 +  ($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
 +  Literal('SQL', $literal, [ $self->_bind_to_dq(@bind) ]);
 +}
 +
 +sub _bind_to_dq {
 +  my ($self, @bind) = @_;
 +  return unless @bind;
 +  $self->bind_meta
 +    ? do {
 +        $self->_assert_bindval_matches_bindtype(@bind);
 +        map perl_scalar_value(reverse @$_), @bind
 +      }
 +    : map perl_scalar_value($_), @bind
 +}
 +
 +sub _value_to_dq {
 +  my ($self, $value) = @_;
 +  $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
 +}
 +
 +sub _ident_to_dq {
 +  my ($self, $ident) = @_;
 +  $self->_assert_pass_injection_guard($ident)
 +    unless $self->renderer_will_quote;
 +  $self->_maybe_convert_dq(
 +    Identifier(do {
 +      if (my $sep = $self->identifier_sep) {
 +        split /\Q$sep/, $ident
 +      } else {
 +        $ident
 +      }
 +    })
 +  );
 +}
 +
 +sub _maybe_convert_dq {
 +  my ($self, $dq) = @_;
 +  if (my $c = $self->{where_convert}) {
 +    Operator({ 'SQL.Naive' => 'apply' }, [
 +        Identifier($self->_sqlcase($c)),
 +        $dq
 +      ]
 +    );
 +  } else {
 +    $dq;
 +  }
 +}
 +
 +sub _op_to_dq {
 +  my ($self, $op, @args) = @_;
 +  $self->_assert_pass_injection_guard($op);
 +  Operator({ 'SQL.Naive' => $op }, \@args);
 +}
 +
 +sub _assert_pass_injection_guard {
 +  if ($_[1] =~ $_[0]->{injection_guard}) {
 +    my $class = ref $_[0];
 +    die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
 +     . "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
 +     . "{injection_guard} attribute to ${class}->new()"
 +  }
 +}
 +
 +sub _insert_to_dq {
 +  my ($self, $table, $data, $options) = @_;
 +  my (@names, @values);
 +  if (ref($data) eq 'HASH') {
 +    @names = sort keys %$data;
 +    foreach my $k (@names) {
 +      local our $Cur_Col_Meta = $k;
 +      push @values, $self->_mutation_rhs_to_dq($data->{$k});
 +    }
 +  } elsif (ref($data) eq 'ARRAY') {
 +    local our $Cur_Col_Meta;
 +    @values = map $self->_mutation_rhs_to_dq($_), @$data;
 +  } else {
 +    die "Not handled yet";
 +  }
 +  my $returning;
 +  if (my $r_source = $options->{returning}) {
 +    $returning = [
 +      map +(ref($_) ? $self->_expr_to_dq($_) : $self->_ident_to_dq($_)),
 +        (ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
 +    ];
 +  }
 +  Insert(
 +    (@names ? ([ map $self->_ident_to_dq($_), @names ]) : undef),
 +    [ \@values ],
 +    $self->_table_to_dq($table),
 +    ($returning ? ($returning) : undef),
 +  );
 +}
 +
 +sub _mutation_rhs_to_dq {
 +  my ($self, $v) = @_;
 +  if (ref($v) eq 'ARRAY') {
 +    if ($self->{array_datatypes}) {
 +      return $self->_value_to_dq($v);
 +    }
 +    $v = \do { my $x = $v };
 +  }
 +  if (ref($v) eq 'HASH') {
 +    my ($op, $arg, @rest) = %$v;
 +
 +    die 'Operator calls in update/insert must be in the form { -op => $arg }'
 +      if (@rest or not $op =~ /^\-(.+)/);
 +  }
 +  return $self->_expr_to_dq($v);
 +}
 +
 +sub _update_to_dq {
 +  my ($self, $table, $data, $where) = @_;
 +
 +  die "Unsupported data type specified to \$sql->update"
 +    unless ref $data eq 'HASH';
 +
 +  my @set;
 +
 +  foreach my $k (sort keys %$data) {
 +    my $v = $data->{$k};
 +    local our $Cur_Col_Meta = $k;
 +    push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
 +  }
 +
 +  Update(
 +    \@set,
 +    $self->_where_to_dq($where),
 +    $self->_table_to_dq($table),
 +  );
 +}
 +
 +sub _source_to_dq {
 +  my ($self, $table, undef, $where) = @_;
 +
 +  my $source_dq = $self->_table_to_dq($table);
 +
 +  if (my $where_dq = $self->_where_to_dq($where)) {
 +    $source_dq = Where($where_dq, $source_dq);
 +  }
 +
 +  $source_dq;
 +}
 +
 +sub _select_to_dq {
 +  my $self = shift;
 +  my ($table, $fields, $where, $order) = @_;
 +
 +  my $source_dq = $self->_source_to_dq(@_);
 +
 +  my $ordered_dq = do {
 +    if ($order) {
 +      $self->_order_by_to_dq($order, undef, undef, $source_dq);
 +    } else {
 +      $source_dq
 +    }
 +  };
 +
 +  return $self->_select_select_to_dq($fields, $ordered_dq);
 +}
 +
 +sub _select_select_to_dq {
 +  my ($self, $fields, $from_dq) = @_;
 +
 +  $fields ||= '*';
 +
 +  Select(
 +    $self->_select_field_list_to_dq($fields),
 +    $from_dq,
 +  );
 +}
 +
 +sub _select_field_list_to_dq {
 +  my ($self, $fields) = @_;
 +  [ map $self->_select_field_to_dq($_),
 +      ref($fields) eq 'ARRAY' ? @$fields : $fields ];
 +}
 +
 +sub _select_field_to_dq {
 +  my ($self, $field) = @_;
 +  if (my $ref = ref($field)) {
 +    if ($ref eq 'REF' and ref($$field) eq 'HASH') {
 +      return $$field;
 +    } else {
 +      return $self->_literal_to_dq($$field);
 +    }
 +  }
 +  return $self->_ident_to_dq($field)
 +}
 +
 +sub _delete_to_dq {
 +  my ($self, $table, $where) = @_;
 +  Delete(
 +    $self->_where_to_dq($where),
 +    $self->_table_to_dq($table),
 +  );
 +}
 +
 +sub _where_to_dq {
 +  my ($self, $where, $logic) = @_;
 +
 +  return undef unless defined($where);
 +
 +  # if we're given a simple string assume it's a literal
 +  return $self->_literal_to_dq($where) if !ref($where);
 +
 +  # turn the convert misfeature on - only used in WHERE clauses
 +  local $self->{where_convert} = $self->convert;
 +
 +  return $self->_expr_to_dq($where, $logic);
 +}
 +
 +my %op_conversions = (
 +  '==' => '=',
 +  'eq' => '=',
 +  'ne' => '!=',
 +  '!' => 'NOT',
 +  'gt' => '>',
 +  'ge' => '>=',
 +  'lt' => '<',
 +  'le' => '<=',
 +  'defined' => 'IS NOT NULL',
 +);
 +
 +sub _expr_to_dq {
 +  my ($self, $where, $logic) = @_;
 +
 +  if (ref($where) eq 'ARRAY') {
 +    return $self->_expr_to_dq_ARRAYREF($where, $logic);
 +  } elsif (ref($where) eq 'HASH') {
 +    return $self->_expr_to_dq_HASHREF($where, $logic);
 +  } elsif (
 +    ref($where) eq 'SCALAR'
 +    or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
 +  ) {
 +    return $self->_literal_to_dq($$where);
 +  } elsif (ref($where) eq 'REF' and ref($$where) eq 'HASH') {
 +    return map_dq_tree {
 +      if (
 +        is_Operator
 +        and not $_->{operator}{'SQL.Naive'}
 +        and my $op = $_->{operator}{'Perl'}
 +      ) {
 +        my $sql_op = $op_conversions{$op} || uc($op);
 +        return +{
 +          %{$_},
 +          operator => { 'SQL.Naive' => $sql_op }
 +        };
 +      }
 +      return $_;
 +    } $$where;
 +  } elsif (!ref($where) or Scalar::Util::blessed($where)) {
 +    return $self->_value_to_dq($where);
 +  }
 +  die "Can't handle $where";
 +}
 +
 +sub _expr_to_dq_ARRAYREF {
 +  my ($self, $where, $logic) = @_;
 +
 +  $logic = uc($logic || $self->default_logic || 'OR');
 +  $logic eq 'AND' or $logic eq 'OR' or die "unknown logic: $logic";
 +
 +  return unless @$where;
 +
 +  my ($first, @rest) = @$where;
 +
 +  return $self->_expr_to_dq($first) unless @rest;
 +
 +  my $first_dq = do {
 +    if (!ref($first)) {
 +      $self->_where_hashpair_to_dq($first => shift(@rest));
 +    } else {
 +      $self->_expr_to_dq($first);
 +    }
 +  };
 +
 +  return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
 +
 +  $self->_op_to_dq(
 +    $logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
 +  );
 +}
 +
 +sub _expr_to_dq_HASHREF {
 +  my ($self, $where, $logic) = @_;
 +
 +  $logic = uc($logic) if $logic;
 +
 +  my @dq = map {
 +    $self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
 +  } sort keys %$where;
 +
 +  return $dq[0] unless @dq > 1;
 +
 +  my $final = pop(@dq);
 +
 +  foreach my $dq (reverse @dq) {
 +    $final = $self->_op_to_dq($logic||'AND', $dq, $final);
 +  }
 +
 +  return $final;
 +}
 +
 +sub _where_to_dq_SCALAR {
 +  shift->_value_to_dq(@_);
 +}
 +
 +sub _apply_to_dq {
 +  my ($self, $op, $v) = @_;
 +  my @args = map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v);
 +
 +  # Ok. Welcome to stupid compat code land. An SQLA expr that would in the
 +  # absence of this piece of crazy render to:
 +  #
 +  #   A( B( C( x ) ) )
 +  #
 +  # such as
 +  #
 +  #   { -a => { -b => { -c => $x } } }
 +  #
 +  # actually needs to render to:
 +  #
 +  #   A( B( C x ) )
 +  #
 +  # because SQL sucks, and databases are hateful, and SQLA is Just That DWIM.
 +  #
 +  # However, we don't want to catch 'A(x)' and turn it into 'A x'
 +  #
 +  # So the way we deal with this is to go through all our arguments, and
 +  # then if the argument is -also- an apply, i.e. at least 'B', we check
 +  # its arguments - and if there's only one of them, and that isn't an apply,
 +  # then we convert to the bareword form. The end result should be:
 +  #
 +  # A( x )                   -> A( x )
 +  # A( B( x ) )              -> A( B x )
 +  # A( B( C( x ) ) )         -> A( B( C x ) )
 +  # A( B( x + y ) )          -> A( B( x + y ) )
 +  # A( B( x, y ) )           -> A( B( x, y ) )
 +  #
 +  # If this turns out not to be quite right, please add additional tests
 +  # to either 01generate.t or 02where.t *and* update this comment.
 +
 +  foreach my $arg (@args) {
 +    if (
 +      is_Operator($arg) and $arg->{operator}{'SQL.Naive'} eq 'apply'
 +      and @{$arg->{args}} == 2 and !is_Operator($arg->{args}[1])
 +
 +    ) {
 +      $arg->{operator}{'SQL.Naive'} = (shift @{$arg->{args}})->{elements}->[0];
 +    }
 +  }
 +  $self->_assert_pass_injection_guard($op);
 +  return $self->_op_to_dq(
 +    apply => $self->_ident_to_dq($op), @args
 +  );
 +}
 +
 +sub _where_hashpair_to_dq {
 +  my ($self, $k, $v, $logic) = @_;
 +
 +  if ($k =~ /^-(.*)/s) {
 +    my $op = uc($1);
 +    if ($op eq 'AND' or $op eq 'OR') {
 +      return $self->_expr_to_dq($v, $op);
 +    } elsif ($op eq 'NEST') {
 +      return $self->_expr_to_dq($v);
 +    } elsif ($op eq 'NOT') {
 +      return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
 +    } elsif ($op eq 'BOOL') {
 +      return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
 +    } elsif ($op eq 'NOT_BOOL') {
 +      return $self->_op_to_dq(
 +        NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
 +      );
 +    } elsif ($op eq 'IDENT') {
 +      return $self->_ident_to_dq($v);
 +    } elsif ($op eq 'VALUE') {
 +      return $self->_value_to_dq($v);
 +    } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+/) {
 +      die "Use of [and|or|nest]_N modifiers is no longer supported";
 +    } else {
 +      return $self->_apply_to_dq($op, $v);
 +    }
 +  } else {
 +    local our $Cur_Col_Meta = $k;
 +    if (ref($v) eq 'ARRAY') {
 +      if (!@$v) {
 +        return $self->_literal_to_dq($self->{sqlfalse});
 +      } elsif (defined($v->[0]) && $v->[0] =~ /-(and|or)/i) {
 +        return $self->_expr_to_dq_ARRAYREF([
 +          map +{ $k => $_ }, @{$v}[1..$#$v]
 +        ], uc($1));
 +      }
 +      return $self->_expr_to_dq_ARRAYREF([
 +        map +{ $k => $_ }, @$v
 +      ], $logic);
 +    } elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
 +      return Literal('SQL', [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]);
 +    }
 +    my ($op, $rhs) = do {
 +      if (ref($v) eq 'HASH') {
 +        if (keys %$v > 1) {
 +          return $self->_expr_to_dq_ARRAYREF([
 +            map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
 +          ], $logic||'AND');
 +        }
 +        my ($op, $value) = %$v;
 +        s/^-//, s/_/ /g for $op;
 +        if ($op =~ /^(and|or)$/i) {
 +          return $self->_expr_to_dq({ $k => $value }, $op);
 +        } elsif (
 +          my $special_op = List::Util::first {$op =~ $_->{regex}}
 +                             @{$self->{special_ops}}
 +        ) {
 +          return $self->_literal_to_dq(
 +            [ $special_op->{handler}->($k, $op, $value) ]
 +          );;
 +        } elsif ($op =~ /^(?:AND|OR|NEST)_?\d+$/i) {
 +          die "Use of [and|or|nest]_N modifiers is no longer supported";
 +        }
 +        (uc($op), $value);
 +      } else {
 +        ($self->{cmp}, $v);
 +      }
 +    };
 +    if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
-       die "Can't use undef argument for operator $op" unless defined $rhs;
++      die "Argument passed to the '$op' operator can not be undefined" unless defined $rhs;
 +      $rhs = [$rhs] unless ref $rhs;
 +      if (ref($rhs) ne 'ARRAY') {
 +        if ($op =~ /IN$/) {
 +          # have to add parens if none present because -in => \"SELECT ..."
 +          # got documented. mst hates everything.
 +          if (ref($rhs) eq 'SCALAR') {
 +            my $x = $$rhs;
 +            1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
 +            $rhs = \$x;
 +          } elsif (ref($rhs) eq 'REF') {
 +            if (ref($$rhs) eq 'ARRAY') {
 +              my ($x, @rest) = @{$$rhs};
 +              1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
 +              $rhs = \[ $x, @rest ];
 +            } elsif (ref($$rhs) eq 'HASH') {
 +              return $self->_op_to_dq($op, $self->_ident_to_dq($k), $$rhs);
 +            }
 +          }
 +        }
 +        return $self->_op_to_dq(
 +          $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
 +        );
 +      }
 +      if (grep !defined, @$rhs) {
 +        my ($inop, $logic, $nullop) = $op =~ /^NOT/
 +          ? (-not_in => AND => { '!=' => undef })
 +          : (-in => OR => undef);
 +        if (my @defined = grep defined, @$rhs) {
 +          return $self->_expr_to_dq_ARRAYREF([
 +            { $k => { $inop => \@defined } },
 +            { $k => $nullop },
 +          ], $logic);
 +        }
 +        return $self->_expr_to_dq_HASHREF({ $k => $nullop });
 +      }
 +      return $self->_literal_to_dq(
 +        $op =~ /^NOT/ ? $self->{sqltrue} : $self->{sqlfalse}
 +      ) unless @$rhs;
 +      return $self->_op_to_dq(
 +        $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
 +      )
 +    } elsif ($op =~ s/^NOT (?!LIKE)//) {
 +      return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
 +    } elsif ($op eq 'IDENT') {
 +      return $self->_op_to_dq(
 +        $self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
 +      );
 +    } elsif ($op eq 'VALUE') {
 +      return $self->_op_to_dq(
 +        $self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
 +      );
 +    } elsif (!defined($rhs)) {
 +      my $null_op = do {
 +        if ($op eq '=' or $op eq 'LIKE' or $op eq 'IS') {
 +          'IS NULL'
 +        } elsif ($op eq '!=' or $op eq 'NOT LIKE' or $op eq 'IS NOT') {
 +          'IS NOT NULL'
 +        } else {
 +          die "Can't do undef -> NULL transform for operator ${op}";
 +        }
 +      };
 +      return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
 +    }
 +    if (ref($rhs) eq 'ARRAY') {
 +      if (!@$rhs) {
 +        return $self->_literal_to_dq(
 +          $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
 +        );
 +      } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
 +        return $self->_expr_to_dq_ARRAYREF([
 +          map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
 +        ], uc($1));
 +      } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
 +        die "Use of [and|or|nest]_N modifiers is no longer supported";
 +      }
 +      return $self->_expr_to_dq_ARRAYREF([
 +        map +{ $k => { $op => $_ } }, @$rhs
 +      ]);
 +    }
 +    return $self->_op_to_dq(
 +      $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
 +    );
 +  }
 +}
 +
 +sub _order_by_to_dq {
 +  my ($self, $arg, $dir, $nulls, $from) = @_;
 +
 +  return unless $arg;
 +
 +  my $dq = Order(
 +    undef,
 +    (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
 +    $nulls,
 +    ($from ? ($from) : undef),
 +  );
 +
 +  if (!ref($arg)) {
 +    $dq->{by} = $self->_ident_to_dq($arg);
 +  } elsif (ref($arg) eq 'ARRAY') {
 +    return unless @$arg;
 +    local our $Order_Inner unless our $Order_Recursing;
 +    local $Order_Recursing = 1;
 +    my ($outer, $inner);
 +    foreach my $member (@$arg) {
 +      local $Order_Inner;
 +      my $next = $self->_order_by_to_dq($member, $dir, $nulls, $from);
 +      $outer ||= $next;
 +      $inner->{from} = $next if $inner;
 +      $inner = $Order_Inner || $next;
 +    }
 +    $Order_Inner = $inner;
 +    return $outer;
 +  } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
 +    $dq->{by} = $self->_literal_to_dq($$arg);
 +  } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'HASH') {
 +    $dq->{by} = $$arg;
 +  } elsif (ref($arg) eq 'SCALAR') {
 +
 +    # < 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 
 +    #        dbihacks crack combined with old literal order_by crack
 +    # < ribasushi> heh :)
 +
 +    # this should take into account our quote char and name sep
 +
 +    my $match_ident = '\w+(?:\.\w+)*';
 +
 +    if (my ($ident, $dir) = $$arg =~ /^(${match_ident})(?:\s+(desc|asc))?$/i) {
 +      $dq->{by} = $self->_ident_to_dq($ident);
 +      $dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
 +    } else {
 +      $dq->{by} = $self->_literal_to_dq($$arg);
 +    }
 +  } elsif (ref($arg) eq 'HASH') {
 +    return () unless %$arg;
 +
 +    my ($direction, $val);
 +    foreach my $key (keys %$arg) {
 +      if ( $key =~ /^-(desc|asc)/i ) {
 +        die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
 +            if defined $direction;
 +        $direction = $1;
 +        $val = $arg->{$key};
 +      } elsif ($key =~ /^-nulls$/i)  {
 +        $nulls = $arg->{$key};
 +        die "invalid value for -nulls" unless $nulls =~ /^(?:first|last|none)$/i;
 +      } else {
 +        die "invalid key ${key} in hash passed to _order_by_to_dq";
 +      }
 +    }
 +
 +    die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
 +        unless defined $direction;
 +
 +    return $self->_order_by_to_dq($val, $direction, $nulls, $from);
 +  } else {
 +    die "Can't handle $arg in _order_by_to_dq";
 +  }
 +  return $dq;
 +}
 +
 +sub _table_to_dq {
 +  my ($self, $from) = @_;
 +  if (ref($from) eq 'ARRAY') {
 +    die "Empty FROM list" unless my @f = @$from;
 +    my $dq = $self->_table_to_dq(shift @f);
 +    while (my $x = shift @f) {
 +      $dq = Join(
 +        $dq,
 +        $self->_table_to_dq($x),
 +      );
 +    }
 +    $dq;
 +  } elsif (ref($from) eq 'SCALAR' or (ref($from) eq 'REF')) {
 +    $self->_literal_to_dq($$from);
 +  } else {
 +    $self->_ident_to_dq($from);
 +  }
 +}
 +
 +# And bindtype
 +sub _bindtype (@) {
 +  #my ($self, $col, @vals) = @_;
 +
 +  #LDNOTE : changed original implementation below because it did not make
 +  # sense when bindtype eq 'columns' and @vals > 1.
 +#  return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
 +
 +  # called often - tighten code
 +  return $_[0]->bind_meta
 +    ? map {[$_[1], $_]} @_[2 .. $#_]
 +    : @_[2 .. $#_]
 +  ;
 +}
 +
 +# Dies if any element of @bind is not in [colname => value] format
 +# if bindtype is 'columns'.
 +sub _assert_bindval_matches_bindtype {
 +#  my ($self, @bind) = @_;
 +  my $self = shift;
 +  if ($self->bind_meta) {
 +    for (@_) {
 +      if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
 +        die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
 +      }
 +    }
 +  }
 +}
 +
 +# Fix SQL case, if so requested
 +sub _sqlcase {
 +  return $_[0]->lower_case ? $_[1] : uc($_[1]);
 +}
 +
 +1;
diff --cc t/01generate.t
@@@ -554,6 -547,20 +554,13 @@@ my @tests = 
        },
        {
                func => 'select',
+               args => ['test', '*', { a => { -in => [] }, b => { -not_in => [] } }],
+               stmt => 'SELECT * FROM test WHERE ( 0=1 AND 1=1 )',
+               stmt_q => 'SELECT * FROM `test` WHERE ( 0=1 AND 1=1 )',
+               bind => [],
+       },
+       {
 -              exception_like => qr/
 -                \QSQL::Abstract before v1.75 used to generate incorrect SQL \E
 -                \Qwhen the -IN operator was given an undef-containing list: \E
 -                \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E
 -                \Qversion of SQL::Abstract will emit the logically correct SQL \E
 -                \Qinstead of raising this exception)\E
 -              /x,
+               func => 'select',
                args => ['test', '*', { a => { -in => [42, undef] }, b => { -not_in => [42, undef] } } ],
                stmt => 'SELECT * FROM test WHERE ( ( a IN ( ? ) OR a IS NULL ) AND b NOT IN ( ? ) AND b IS NOT NULL )',
                stmt_q => 'SELECT * FROM `test` WHERE ( ( `a` IN ( ? ) OR `a` IS NULL ) AND `b` NOT IN ( ? ) AND `b` IS NOT NULL )',
        },
        {
                func => 'select',
 +              args => ['test', '*', { a => { '=' => undef }, b => { -is => undef }, c => { -like => undef } }],
 +              stmt => 'SELECT * FROM test WHERE ( a IS NULL AND b IS NULL AND c IS NULL )',
 +              stmt_q => 'SELECT * FROM `test` WHERE ( `a` IS NULL AND `b` IS NULL AND `c` IS NULL )',
 +              bind => [],
 +      },
 +      {
 +              func => 'select',
 +              args => ['test', '*', { a => { '!=' => undef }, b => { -is_not => undef }, c => { -not_like => undef } }],
 +              stmt => 'SELECT * FROM test WHERE ( a IS NOT NULL AND b IS NOT  NULL AND c IS NOT  NULL )',
 +              stmt_q => 'SELECT * FROM `test` WHERE ( `a` IS NOT  NULL AND `b` IS NOT  NULL AND `c` IS NOT  NULL )',
 +              bind => [],
 +      },
 +      {
 +              func => 'select',
 +              args => ['test', '*', { a => { IS => undef }, b => { LIKE => undef } }],
 +              stmt => 'SELECT * FROM test WHERE ( a IS NULL AND b IS NULL )',
 +              stmt_q => 'SELECT * FROM `test` WHERE ( `a` IS NULL AND `b` IS NULL )',
 +              bind => [],
 +      },
 +      {
 +              func => 'select',
 +              args => ['test', '*', { a => { 'IS NOT' => undef }, b => { 'NOT LIKE' => undef } }],
 +              stmt => 'SELECT * FROM test WHERE ( a IS NOT NULL AND b IS NOT  NULL )',
 +              stmt_q => 'SELECT * FROM `test` WHERE ( `a` IS NOT  NULL AND `b` IS NOT  NULL )',
 +              bind => [],
 +      },
 +      {
 +              func => 'select',
                args => ['test', '*', { a => { -in => undef } }],
-               exception_like => qr/Can't use undef argument for operator IN/,
+               exception_like => qr/Argument passed to the 'IN' operator can not be undefined/,
        },
  );
  
@@@ -636,11 -622,9 +643,12 @@@ for my $t (@tests) 
          );
        }
        else {
 -        $cref->();
 +        unless (eval { $cref->(); 1 }) {
 +          die "Unexpected exception thrown for structure:\n"
 +              .Dumper($t)."Exception was: $@";
 +        }
        }
        is_same_sql_bind(
          $stmt,
          \@bind,
Simple merge