[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract / Converter.pm

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;
      $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;
Commit	Line	Data
a82e41dc	1	package SQL::Abstract::Converter;
	2
	3	use Carp ();
	4	use List::Util ();
	5	use Scalar::Util ();
4caa4620	6	use Data::Query::ExprHelpers;
a82e41dc	7	use Moo;
8b9b83ae	8	use namespace::clean;
a82e41dc	9
	10	has renderer_will_quote => (
	11	is => 'ro'
	12	);
	13
	14	has lower_case => (
4caa4620	15	is => 'ro'
a82e41dc	16	);
	17
	18	has default_logic => (
	19	is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
	20	);
	21
	22	has bind_meta => (
	23	is => 'ro', default => sub { 1 }
	24	);
	25
	26	has cmp => (is => 'ro', default => sub { '=' });
	27
	28	has sqltrue => (is => 'ro', default => sub { '1=1' });
	29	has sqlfalse => (is => 'ro', default => sub { '0=1' });
	30
	31	has special_ops => (is => 'ro', default => sub { [] });
	32
	33	# XXX documented but I don't current fail any tests not using it
	34	has unary_ops => (is => 'ro', default => sub { [] });
	35
	36	has injection_guard => (
	37	is => 'ro',
	38	default => sub {
	39	qr/
	40	\;
	41	\|
	42	^ \s* go \s
	43	/xmi;
	44	}
	45	);
	46
	47	has identifier_sep => (
	48	is => 'ro', default => sub { '.' },
	49	);
	50
	51	has always_quote => (is => 'ro', default => sub { 1 });
	52
	53	has convert => (is => 'ro');
	54
	55	has array_datatypes => (is => 'ro');
	56
	57	sub _literal_to_dq {
	58	my ($self, $literal) = @_;
	59	my @bind;
	60	($literal, @bind) = @$literal if ref($literal) eq 'ARRAY';
3ed3c560	61	Literal('SQL', $literal, [ $self->_bind_to_dq(@bind) ]);
a82e41dc	62	}
	63
	64	sub _bind_to_dq {
	65	my ($self, @bind) = @_;
	66	return unless @bind;
	67	$self->bind_meta
	68	? do {
	69	$self->_assert_bindval_matches_bindtype(@bind);
	70	map perl_scalar_value(reverse @$_), @bind
	71	}
	72	: map perl_scalar_value($_), @bind
	73	}
	74
	75	sub _value_to_dq {
	76	my ($self, $value) = @_;
	77	$self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
	78	}
	79
	80	sub _ident_to_dq {
	81	my ($self, $ident) = @_;
	82	$self->_assert_pass_injection_guard($ident)
	83	unless $self->renderer_will_quote;
95516ac5	84	$self->_maybe_convert_dq(
	85	Identifier(do {
	86	if (my $sep = $self->identifier_sep) {
	87	split /\Q$sep/, $ident
	88	} else {
	89	$ident
	90	}
	91	})
	92	);
a82e41dc	93	}
	94
	95	sub _maybe_convert_dq {
	96	my ($self, $dq) = @_;
	97	if (my $c = $self->{where_convert}) {
4caa4620	98	Operator({ 'SQL.Naive' => 'apply' }, [
f3c68822	99	Identifier($self->_sqlcase($c)),
4caa4620	100	$dq
	101	]
	102	);
a82e41dc	103	} else {
	104	$dq;
	105	}
	106	}
	107
	108	sub _op_to_dq {
	109	my ($self, $op, @args) = @_;
	110	$self->_assert_pass_injection_guard($op);
4caa4620	111	Operator({ 'SQL.Naive' => $op }, \@args);
a82e41dc	112	}
	113
	114	sub _assert_pass_injection_guard {
	115	if ($_[1] =~ $_[0]->{injection_guard}) {
	116	my $class = ref $_[0];
	117	die "Possible SQL injection attempt '$_[1]'. If this is indeed a part of the "
	118	. "desired SQL use literal SQL ( \'...' or \[ '...' ] ) or supply your own "
	119	. "{injection_guard} attribute to ${class}->new()"
	120	}
	121	}
	122
	123	sub _insert_to_dq {
	124	my ($self, $table, $data, $options) = @_;
	125	my (@names, @values);
	126	if (ref($data) eq 'HASH') {
	127	@names = sort keys %$data;
	128	foreach my $k (@names) {
	129	local our $Cur_Col_Meta = $k;
	130	push @values, $self->_mutation_rhs_to_dq($data->{$k});
	131	}
	132	} elsif (ref($data) eq 'ARRAY') {
	133	local our $Cur_Col_Meta;
	134	@values = map $self->_mutation_rhs_to_dq($_), @$data;
	135	} else {
	136	die "Not handled yet";
	137	}
	138	my $returning;
	139	if (my $r_source = $options->{returning}) {
	140	$returning = [
	141	map +(ref($_) ? $self->_expr_to_dq($_) : $self->_ident_to_dq($_)),
	142	(ref($r_source) eq 'ARRAY' ? @$r_source : $r_source),
	143	];
	144	}
4caa4620	145	Insert(
	146	(@names ? ([ map $self->_ident_to_dq($_), @names ]) : undef),
	147	[ \@values ],
	148	$self->_table_to_dq($table),
	149	($returning ? ($returning) : undef),
	150	);
a82e41dc	151	}
	152
	153	sub _mutation_rhs_to_dq {
	154	my ($self, $v) = @_;
	155	if (ref($v) eq 'ARRAY') {
	156	if ($self->{array_datatypes}) {
	157	return $self->_value_to_dq($v);
	158	}
	159	$v = \do { my $x = $v };
	160	}
	161	if (ref($v) eq 'HASH') {
	162	my ($op, $arg, @rest) = %$v;
	163
	164	die 'Operator calls in update/insert must be in the form { -op => $arg }'
	165	if (@rest or not $op =~ /^\-(.+)/);
	166	}
	167	return $self->_expr_to_dq($v);
	168	}
	169
	170	sub _update_to_dq {
	171	my ($self, $table, $data, $where) = @_;
	172
	173	die "Unsupported data type specified to \$sql->update"
	174	unless ref $data eq 'HASH';
	175
	176	my @set;
	177
	178	foreach my $k (sort keys %$data) {
	179	my $v = $data->{$k};
	180	local our $Cur_Col_Meta = $k;
	181	push @set, [ $self->_ident_to_dq($k), $self->_mutation_rhs_to_dq($v) ];
	182	}
	183
4caa4620	184	Update(
	185	\@set,
	186	$self->_where_to_dq($where),
	187	$self->_table_to_dq($table),
	188	);
a82e41dc	189	}
	190
	191	sub _source_to_dq {
	192	my ($self, $table, undef, $where) = @_;
	193
	194	my $source_dq = $self->_table_to_dq($table);
	195
	196	if (my $where_dq = $self->_where_to_dq($where)) {
4caa4620	197	$source_dq = Where($where_dq, $source_dq);
a82e41dc	198	}
	199
	200	$source_dq;
	201	}
	202
	203	sub _select_to_dq {
	204	my $self = shift;
	205	my ($table, $fields, $where, $order) = @_;
	206
	207	my $source_dq = $self->_source_to_dq(@_);
	208
	209	my $ordered_dq = do {
	210	if ($order) {
36e3ea6c	211	$self->_order_by_to_dq($order, undef, undef, $source_dq);
a82e41dc	212	} else {
	213	$source_dq
	214	}
	215	};
	216
87af4204	217	return $self->_select_select_to_dq($fields, $ordered_dq);
a82e41dc	218	}
a82e41dc	219
87af4204	220	sub _select_select_to_dq {
a82e41dc	221	my ($self, $fields, $from_dq) = @_;
	222
	223	$fields \|\|= '*';
	224
4caa4620	225	Select(
	226	$self->_select_field_list_to_dq($fields),
	227	$from_dq,
	228	);
a82e41dc	229	}
	230
	231	sub _select_field_list_to_dq {
	232	my ($self, $fields) = @_;
87af4204	233	[ map $self->_select_field_to_dq($_),
87af4204	234	ref($fields) eq 'ARRAY' ? @$fields : $fields ];
a82e41dc	235	}
	236
	237	sub _select_field_to_dq {
	238	my ($self, $field) = @_;
87af4204	239	if (my $ref = ref($field)) {
	240	if ($ref eq 'REF' and ref($$field) eq 'HASH') {
	241	return $$field;
	242	} else {
	243	return $self->_literal_to_dq($$field);
	244	}
	245	}
	246	return $self->_ident_to_dq($field)
a82e41dc	247	}
	248
	249	sub _delete_to_dq {
	250	my ($self, $table, $where) = @_;
4caa4620	251	Delete(
	252	$self->_where_to_dq($where),
	253	$self->_table_to_dq($table),
	254	);
a82e41dc	255	}
	256
	257	sub _where_to_dq {
	258	my ($self, $where, $logic) = @_;
	259
	260	return undef unless defined($where);
	261
e177c256	262	# if we're given a simple string assume it's a literal
	263	return $self->_literal_to_dq($where) if !ref($where);
	264
a82e41dc	265	# turn the convert misfeature on - only used in WHERE clauses
	266	local $self->{where_convert} = $self->convert;
	267
	268	return $self->_expr_to_dq($where, $logic);
	269	}
	270
6da91977	271	my %op_conversions = (
	272	'==' => '=',
	273	'eq' => '=',
	274	'ne' => '!=',
	275	'!' => 'NOT',
	276	'gt' => '>',
	277	'ge' => '>=',
	278	'lt' => '<',
	279	'le' => '<=',
	280	'defined' => 'IS NOT NULL',
	281	);
	282
a82e41dc	283	sub _expr_to_dq {
	284	my ($self, $where, $logic) = @_;
	285
	286	if (ref($where) eq 'ARRAY') {
	287	return $self->_expr_to_dq_ARRAYREF($where, $logic);
	288	} elsif (ref($where) eq 'HASH') {
	289	return $self->_expr_to_dq_HASHREF($where, $logic);
	290	} elsif (
	291	ref($where) eq 'SCALAR'
	292	or (ref($where) eq 'REF' and ref($$where) eq 'ARRAY')
	293	) {
	294	return $self->_literal_to_dq($$where);
62d17764	295	} elsif (ref($where) eq 'REF' and ref($$where) eq 'HASH') {
6da91977	296	return map_dq_tree {
	297	if (
	298	is_Operator
	299	and not $_->{operator}{'SQL.Naive'}
	300	and my $op = $_->{operator}{'Perl'}
	301	) {
	302	my $sql_op = $op_conversions{$op} \|\| uc($op);
	303	return +{
	304	%{$_},
	305	operator => { 'SQL.Naive' => $sql_op }
	306	};
	307	}
	308	return $_;
	309	} $$where;
a82e41dc	310	} elsif (!ref($where) or Scalar::Util::blessed($where)) {
	311	return $self->_value_to_dq($where);
	312	}
	313	die "Can't handle $where";
	314	}
	315
	316	sub _expr_to_dq_ARRAYREF {
	317	my ($self, $where, $logic) = @_;
	318
	319	$logic = uc($logic \|\| $self->default_logic \|\| 'OR');
	320	$logic eq 'AND' or $logic eq 'OR' or die "unknown logic: $logic";
	321
	322	return unless @$where;
	323
	324	my ($first, @rest) = @$where;
	325
	326	return $self->_expr_to_dq($first) unless @rest;
	327
	328	my $first_dq = do {
	329	if (!ref($first)) {
	330	$self->_where_hashpair_to_dq($first => shift(@rest));
	331	} else {
	332	$self->_expr_to_dq($first);
	333	}
	334	};
	335
	336	return $self->_expr_to_dq_ARRAYREF(\@rest, $logic) unless $first_dq;
	337
	338	$self->_op_to_dq(
	339	$logic, $first_dq, $self->_expr_to_dq_ARRAYREF(\@rest, $logic)
	340	);
	341	}
	342
	343	sub _expr_to_dq_HASHREF {
	344	my ($self, $where, $logic) = @_;
	345
	346	$logic = uc($logic) if $logic;
	347
	348	my @dq = map {
	349	$self->_where_hashpair_to_dq($_ => $where->{$_}, $logic)
	350	} sort keys %$where;
	351
	352	return $dq[0] unless @dq > 1;
	353
	354	my $final = pop(@dq);
	355
	356	foreach my $dq (reverse @dq) {
	357	$final = $self->_op_to_dq($logic\|\|'AND', $dq, $final);
	358	}
	359
	360	return $final;
	361	}
	362
	363	sub _where_to_dq_SCALAR {
	364	shift->_value_to_dq(@_);
	365	}
	366
	367	sub _apply_to_dq {
	368	my ($self, $op, $v) = @_;
	369	my @args = map $self->_expr_to_dq($_), (ref($v) eq 'ARRAY' ? @$v : $v);
	370
	371	# Ok. Welcome to stupid compat code land. An SQLA expr that would in the
	372	# absence of this piece of crazy render to:
	373	#
374	# A( B( C( x ) ) )
375	#
376	# such as
377	#
378	# { -a => { -b => { -c => $x } } }
379	#
380	# actually needs to render to:
381	#
382	# A( B( C x ) )
383	#
384	# because SQL sucks, and databases are hateful, and SQLA is Just That DWIM.
385	#
386	# However, we don't want to catch 'A(x)' and turn it into 'A x'
387	#
388	# So the way we deal with this is to go through all our arguments, and
389	# then if the argument is -also- an apply, i.e. at least 'B', we check
390	# its arguments - and if there's only one of them, and that isn't an apply,
391	# then we convert to the bareword form. The end result should be:
392	#
393	# A( x ) -> A( x )
394	# A( B( x ) ) -> A( B x )
395	# A( B( C( x ) ) ) -> A( B( C x ) )
396	# A( B( x + y ) ) -> A( B( x + y ) )
397	# A( B( x, y ) ) -> A( B( x, y ) )
398	#
399	# If this turns out not to be quite right, please add additional tests
400	# to either 01generate.t or 02where.t and update this comment.
401
402	foreach my $arg (@args) {
403	if (
f3c68822	404	is_Operator($arg) and $arg->{operator}{'SQL.Naive'} eq 'apply'
	405	and @{$arg->{args}} == 2 and !is_Operator($arg->{args}[1])
	406
a82e41dc	407	) {
	408	$arg->{operator}{'SQL.Naive'} = (shift @{$arg->{args}})->{elements}->[0];
	409	}
	410	}
	411	$self->_assert_pass_injection_guard($op);
	412	return $self->_op_to_dq(
	413	apply => $self->_ident_to_dq($op), @args
	414	);
	415	}
	416
	417	sub _where_hashpair_to_dq {
	418	my ($self, $k, $v, $logic) = @_;
	419
	420	if ($k =~ /^-(.*)/s) {
	421	my $op = uc($1);
	422	if ($op eq 'AND' or $op eq 'OR') {
	423	return $self->_expr_to_dq($v, $op);
	424	} elsif ($op eq 'NEST') {
	425	return $self->_expr_to_dq($v);
	426	} elsif ($op eq 'NOT') {
	427	return $self->_op_to_dq(NOT => $self->_expr_to_dq($v));
	428	} elsif ($op eq 'BOOL') {
	429	return ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v);
	430	} elsif ($op eq 'NOT_BOOL') {
	431	return $self->_op_to_dq(
	432	NOT => ref($v) ? $self->_expr_to_dq($v) : $self->_ident_to_dq($v)
	433	);
	434	} elsif ($op eq 'IDENT') {
	435	return $self->_ident_to_dq($v);
	436	} elsif ($op eq 'VALUE') {
	437	return $self->_value_to_dq($v);
	438	} elsif ($op =~ /^(?:AND\|OR\|NEST)_?\d+/) {
	439	die "Use of [and\|or\|nest]_N modifiers is no longer supported";
	440	} else {
	441	return $self->_apply_to_dq($op, $v);
	442	}
	443	} else {
	444	local our $Cur_Col_Meta = $k;
	445	if (ref($v) eq 'ARRAY') {
	446	if (!@$v) {
	447	return $self->_literal_to_dq($self->{sqlfalse});
	448	} elsif (defined($v->[0]) && $v->[0] =~ /-(and\|or)/i) {
	449	return $self->_expr_to_dq_ARRAYREF([
	450	map +{ $k => $_ }, @{$v}[1..$#$v]
	451	], uc($1));
	452	}
	453	return $self->_expr_to_dq_ARRAYREF([
	454	map +{ $k => $_ }, @$v
	455	], $logic);
	456	} elsif (ref($v) eq 'SCALAR' or (ref($v) eq 'REF' and ref($$v) eq 'ARRAY')) {
3ed3c560	457	return Literal('SQL', [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]);
a82e41dc	458	}
	459	my ($op, $rhs) = do {
	460	if (ref($v) eq 'HASH') {
	461	if (keys %$v > 1) {
	462	return $self->_expr_to_dq_ARRAYREF([
	463	map +{ $k => { $_ => $v->{$_} } }, sort keys %$v
	464	], $logic\|\|'AND');
	465	}
	466	my ($op, $value) = %$v;
	467	s/^-//, s/_/ /g for $op;
	468	if ($op =~ /^(and\|or)$/i) {
	469	return $self->_expr_to_dq({ $k => $value }, $op);
	470	} elsif (
	471	my $special_op = List::Util::first {$op =~ $_->{regex}}
	472	@{$self->{special_ops}}
	473	) {
	474	return $self->_literal_to_dq(
	475	[ $special_op->{handler}->($k, $op, $value) ]
	476	);;
	477	} elsif ($op =~ /^(?:AND\|OR\|NEST)_?\d+$/i) {
	478	die "Use of [and\|or\|nest]_N modifiers is no longer supported";
	479	}
	480	(uc($op), $value);
	481	} else {
	482	($self->{cmp}, $v);
	483	}
	484	};
	485	if ($op eq 'BETWEEN' or $op eq 'IN' or $op eq 'NOT IN' or $op eq 'NOT BETWEEN') {
90c87778	486	die "Can't use undef argument for operator $op" unless defined $rhs;
023fd01d	487	$rhs = [$rhs] unless ref $rhs;
a82e41dc	488	if (ref($rhs) ne 'ARRAY') {
	489	if ($op =~ /IN$/) {
	490	# have to add parens if none present because -in => \"SELECT ..."
	491	# got documented. mst hates everything.
	492	if (ref($rhs) eq 'SCALAR') {
	493	my $x = $$rhs;
	494	1 while ($x =~ s/\A\s\((.)\)\s*\Z/$1/s);
	495	$rhs = \$x;
43da3819	496	} elsif (ref($rhs) eq 'REF') {
	497	if (ref($$rhs) eq 'ARRAY') {
	498	my ($x, @rest) = @{$$rhs};
	499	1 while ($x =~ s/\A\s\((.)\)\s*\Z/$1/s);
	500	$rhs = \[ $x, @rest ];
	501	} elsif (ref($$rhs) eq 'HASH') {
	502	return $self->_op_to_dq($op, $self->_ident_to_dq($k), $$rhs);
	503	}
a82e41dc	504	}
	505	}
	506	return $self->_op_to_dq(
	507	$op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
	508	);
	509	}
5b670507	510	if (grep !defined, @$rhs) {
	511	my ($inop, $logic, $nullop) = $op =~ /^NOT/
	512	? (-not_in => AND => { '!=' => undef })
	513	: (-in => OR => undef);
39221d2b	514	if (my @defined = grep defined, @$rhs) {
	515	return $self->_expr_to_dq_ARRAYREF([
	516	{ $k => { $inop => \@defined } },
5b670507	517	{ $k => $nullop },
5b670507	518	], $logic);
39221d2b	519	}
fc4b3e6d	520	return $self->_expr_to_dq_HASHREF({ $k => $nullop });
5b670507	521	}
bdf53200	522	return $self->_literal_to_dq(
	523	$op =~ /^NOT/ ? $self->{sqltrue} : $self->{sqlfalse}
	524	) unless @$rhs;
a82e41dc	525	return $self->_op_to_dq(
	526	$op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
	527	)
	528	} elsif ($op =~ s/^NOT (?!LIKE)//) {
	529	return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
	530	} elsif ($op eq 'IDENT') {
	531	return $self->_op_to_dq(
	532	$self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
	533	);
	534	} elsif ($op eq 'VALUE') {
	535	return $self->_op_to_dq(
	536	$self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
	537	);
	538	} elsif (!defined($rhs)) {
	539	my $null_op = do {
fce4b7a9	540	if ($op eq '=' or $op eq 'LIKE' or $op eq 'IS') {
a82e41dc	541	'IS NULL'
fce4b7a9	542	} elsif ($op eq '!=' or $op eq 'NOT LIKE' or $op eq 'IS NOT') {
a82e41dc	543	'IS NOT NULL'
	544	} else {
	545	die "Can't do undef -> NULL transform for operator ${op}";
	546	}
	547	};
	548	return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
	549	}
	550	if (ref($rhs) eq 'ARRAY') {
	551	if (!@$rhs) {
	552	return $self->_literal_to_dq(
	553	$op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
	554	);
	555	} elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and\|or)$/i) {
	556	return $self->_expr_to_dq_ARRAYREF([
	557	map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
	558	], uc($1));
	559	} elsif ($op =~ /^-(?:AND\|OR\|NEST)_?\d+/) {
	560	die "Use of [and\|or\|nest]_N modifiers is no longer supported";
	561	}
	562	return $self->_expr_to_dq_ARRAYREF([
	563	map +{ $k => { $op => $_ } }, @$rhs
	564	]);
	565	}
	566	return $self->_op_to_dq(
	567	$op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
	568	);
	569	}
	570	}
	571
	572	sub _order_by_to_dq {
36e3ea6c	573	my ($self, $arg, $dir, $nulls, $from) = @_;
a82e41dc	574
	575	return unless $arg;
	576
4caa4620	577	my $dq = Order(
	578	undef,
	579	(defined($dir) ? (!!($dir =~ /desc/i)) : undef),
e1ba0ad9	580	$nulls,
4caa4620	581	($from ? ($from) : undef),
4caa4620	582	);
a82e41dc	583
	584	if (!ref($arg)) {
	585	$dq->{by} = $self->_ident_to_dq($arg);
	586	} elsif (ref($arg) eq 'ARRAY') {
	587	return unless @$arg;
	588	local our $Order_Inner unless our $Order_Recursing;
	589	local $Order_Recursing = 1;
	590	my ($outer, $inner);
	591	foreach my $member (@$arg) {
	592	local $Order_Inner;
36e3ea6c	593	my $next = $self->_order_by_to_dq($member, $dir, $nulls, $from);
a82e41dc	594	$outer \|\|= $next;
	595	$inner->{from} = $next if $inner;
	596	$inner = $Order_Inner \|\| $next;
	597	}
	598	$Order_Inner = $inner;
	599	return $outer;
	600	} elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
	601	$dq->{by} = $self->_literal_to_dq($$arg);
02202b68	602	} elsif (ref($arg) eq 'REF' and ref($$arg) eq 'HASH') {
02202b68	603	$dq->{by} = $$arg;
a82e41dc	604	} elsif (ref($arg) eq 'SCALAR') {
8b9b83ae	605
	606	# < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
	607	# totally leaving this untouched as a literal"
	608	# < mst> so I -think- it's relatively robust
	609	# < ribasushi> right, it's relatively safe then
	610	# < ribasushi> is this regex centralized?
	611	# < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
	612	# < mst> it only exists because you were kind enough to support new
	613	# dbihacks crack combined with old literal order_by crack
	614	# < ribasushi> heh :)
	615
c30db4b6	616	# this should take into account our quote char and name sep
	617
	618	my $match_ident = '\w+(?:\.\w+)*';
	619
	620	if (my ($ident, $dir) = $$arg =~ /^(${match_ident})(?:\s+(desc\|asc))?$/i) {
3d82b6c9	621	$dq->{by} = $self->_ident_to_dq($ident);
	622	$dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
	623	} else {
	624	$dq->{by} = $self->_literal_to_dq($$arg);
	625	}
a82e41dc	626	} elsif (ref($arg) eq 'HASH') {
36e3ea6c	627	return () unless %$arg;
	628
	629	my ($direction, $val);
	630	foreach my $key (keys %$arg) {
	631	if ( $key =~ /^-(desc\|asc)/i ) {
	632	die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
	633	if defined $direction;
	634	$direction = $1;
	635	$val = $arg->{$key};
	636	} elsif ($key =~ /^-nulls$/i) {
	637	$nulls = $arg->{$key};
e1ba0ad9	638	die "invalid value for -nulls" unless $nulls =~ /^(?:first\|last\|none)$/i;
36e3ea6c	639	} else {
c5caf045	640	die "invalid key ${key} in hash passed to _order_by_to_dq";
36e3ea6c	641	}
36e3ea6c	642	}
a82e41dc	643
36e3ea6c	644	die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
36e3ea6c	645	unless defined $direction;
a82e41dc	646
36e3ea6c	647	return $self->_order_by_to_dq($val, $direction, $nulls, $from);
a82e41dc	648	} else {
	649	die "Can't handle $arg in _order_by_to_dq";
	650	}
	651	return $dq;
	652	}
	653
	654	sub _table_to_dq {
	655	my ($self, $from) = @_;
	656	if (ref($from) eq 'ARRAY') {
	657	die "Empty FROM list" unless my @f = @$from;
	658	my $dq = $self->_table_to_dq(shift @f);
	659	while (my $x = shift @f) {
4caa4620	660	$dq = Join(
	661	$dq,
	662	$self->_table_to_dq($x),
	663	);
a82e41dc	664	}
	665	$dq;
	666	} elsif (ref($from) eq 'SCALAR' or (ref($from) eq 'REF')) {
	667	$self->_literal_to_dq($$from);
	668	} else {
	669	$self->_ident_to_dq($from);
	670	}
	671	}
	672
	673	# And bindtype
	674	sub _bindtype (@) {
	675	#my ($self, $col, @vals) = @_;
	676
	677	#LDNOTE : changed original implementation below because it did not make
	678	# sense when bindtype eq 'columns' and @vals > 1.
	679	# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
	680
	681	# called often - tighten code
	682	return $_[0]->bind_meta
	683	? map {[$_[1], $_]} @_[2 .. $#_]
	684	: @_[2 .. $#_]
	685	;
	686	}
	687
	688	# Dies if any element of @bind is not in [colname => value] format
	689	# if bindtype is 'columns'.
	690	sub _assert_bindval_matches_bindtype {
	691	# my ($self, @bind) = @_;
	692	my $self = shift;
	693	if ($self->bind_meta) {
	694	for (@_) {
	695	if (!defined $_ \|\| ref($_) ne 'ARRAY' \|\| @$_ != 2) {
	696	die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
	697	}
	698	}
	699	}
	700	}
	701
	702	# Fix SQL case, if so requested
	703	sub _sqlcase {
	704	return $_[0]->lower_case ? $_[1] : uc($_[1]);
	705	}
	706
	707	1;