Optimise out AND/OR clause in { -(not_)in => [undef] }
[dbsrgits/SQL-Abstract.git] / lib / SQL / Abstract / Converter.pm
CommitLineData
a82e41dc 1package SQL::Abstract::Converter;
2
3use Carp ();
4use List::Util ();
5use Scalar::Util ();
4caa4620 6use Data::Query::ExprHelpers;
a82e41dc 7use Moo;
8b9b83ae 8use namespace::clean;
a82e41dc 9
10has renderer_will_quote => (
11 is => 'ro'
12);
13
14has lower_case => (
4caa4620 15 is => 'ro'
a82e41dc 16);
17
18has default_logic => (
19 is => 'ro', coerce => sub { uc($_[0]) }, default => sub { 'OR' }
20);
21
22has bind_meta => (
23 is => 'ro', default => sub { 1 }
24);
25
26has cmp => (is => 'ro', default => sub { '=' });
27
28has sqltrue => (is => 'ro', default => sub { '1=1' });
29has sqlfalse => (is => 'ro', default => sub { '0=1' });
30
31has special_ops => (is => 'ro', default => sub { [] });
32
33# XXX documented but I don't current fail any tests not using it
34has unary_ops => (is => 'ro', default => sub { [] });
35
36has injection_guard => (
37 is => 'ro',
38 default => sub {
39 qr/
40 \;
41 |
42 ^ \s* go \s
43 /xmi;
44 }
45);
46
47has identifier_sep => (
48 is => 'ro', default => sub { '.' },
49);
50
51has always_quote => (is => 'ro', default => sub { 1 });
52
53has convert => (is => 'ro');
54
55has array_datatypes => (is => 'ro');
56
57sub _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
64sub _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
75sub _value_to_dq {
76 my ($self, $value) = @_;
77 $self->_maybe_convert_dq(perl_scalar_value($value, our $Cur_Col_Meta));
78}
79
80sub _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
95sub _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
108sub _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
114sub _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
123sub _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
153sub _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
170sub _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
191sub _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
203sub _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}
219
87af4204 220sub _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
231sub _select_field_list_to_dq {
232 my ($self, $fields) = @_;
87af4204 233 [ map $self->_select_field_to_dq($_),
234 ref($fields) eq 'ARRAY' ? @$fields : $fields ];
a82e41dc 235}
236
237sub _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
249sub _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
257sub _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 271my %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 283sub _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
316sub _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
343sub _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
363sub _where_to_dq_SCALAR {
364 shift->_value_to_dq(@_);
365}
366
367sub _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
417sub _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') {
023fd01d 486 $rhs = [$rhs] unless ref $rhs;
a82e41dc 487 if (ref($rhs) ne 'ARRAY') {
488 if ($op =~ /IN$/) {
489 # have to add parens if none present because -in => \"SELECT ..."
490 # got documented. mst hates everything.
491 if (ref($rhs) eq 'SCALAR') {
492 my $x = $$rhs;
493 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
494 $rhs = \$x;
43da3819 495 } elsif (ref($rhs) eq 'REF') {
496 if (ref($$rhs) eq 'ARRAY') {
497 my ($x, @rest) = @{$$rhs};
498 1 while ($x =~ s/\A\s*\((.*)\)\s*\Z/$1/s);
499 $rhs = \[ $x, @rest ];
500 } elsif (ref($$rhs) eq 'HASH') {
501 return $self->_op_to_dq($op, $self->_ident_to_dq($k), $$rhs);
502 }
a82e41dc 503 }
504 }
505 return $self->_op_to_dq(
506 $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
507 );
508 }
5b670507 509 if (grep !defined, @$rhs) {
510 my ($inop, $logic, $nullop) = $op =~ /^NOT/
511 ? (-not_in => AND => { '!=' => undef })
512 : (-in => OR => undef);
39221d2b 513 if (my @defined = grep defined, @$rhs) {
514 return $self->_expr_to_dq_ARRAYREF([
515 { $k => { $inop => \@defined } },
5b670507 516 { $k => $nullop },
517 ], $logic);
39221d2b 518 } else {
519 return $self->_expr_to_dq_HASHREF({
520 $k => $nullop,
521 });
522 }
5b670507 523 }
bdf53200 524 return $self->_literal_to_dq(
525 $op =~ /^NOT/ ? $self->{sqltrue} : $self->{sqlfalse}
526 ) unless @$rhs;
a82e41dc 527 return $self->_op_to_dq(
528 $op, $self->_ident_to_dq($k), map $self->_expr_to_dq($_), @$rhs
529 )
530 } elsif ($op =~ s/^NOT (?!LIKE)//) {
531 return $self->_where_hashpair_to_dq(-not => { $k => { $op => $rhs } });
532 } elsif ($op eq 'IDENT') {
533 return $self->_op_to_dq(
534 $self->{cmp}, $self->_ident_to_dq($k), $self->_ident_to_dq($rhs)
535 );
536 } elsif ($op eq 'VALUE') {
537 return $self->_op_to_dq(
538 $self->{cmp}, $self->_ident_to_dq($k), $self->_value_to_dq($rhs)
539 );
540 } elsif (!defined($rhs)) {
541 my $null_op = do {
542 if ($op eq '=' or $op eq 'LIKE') {
543 'IS NULL'
544 } elsif ($op eq '!=') {
545 'IS NOT NULL'
546 } else {
547 die "Can't do undef -> NULL transform for operator ${op}";
548 }
549 };
550 return $self->_op_to_dq($null_op, $self->_ident_to_dq($k));
551 }
552 if (ref($rhs) eq 'ARRAY') {
553 if (!@$rhs) {
554 return $self->_literal_to_dq(
555 $op eq '!=' ? $self->{sqltrue} : $self->{sqlfalse}
556 );
557 } elsif (defined($rhs->[0]) and $rhs->[0] =~ /^-(and|or)$/i) {
558 return $self->_expr_to_dq_ARRAYREF([
559 map +{ $k => { $op => $_ } }, @{$rhs}[1..$#$rhs]
560 ], uc($1));
561 } elsif ($op =~ /^-(?:AND|OR|NEST)_?\d+/) {
562 die "Use of [and|or|nest]_N modifiers is no longer supported";
563 }
564 return $self->_expr_to_dq_ARRAYREF([
565 map +{ $k => { $op => $_ } }, @$rhs
566 ]);
567 }
568 return $self->_op_to_dq(
569 $op, $self->_ident_to_dq($k), $self->_expr_to_dq($rhs)
570 );
571 }
572}
573
574sub _order_by_to_dq {
36e3ea6c 575 my ($self, $arg, $dir, $nulls, $from) = @_;
a82e41dc 576
577 return unless $arg;
578
4caa4620 579 my $dq = Order(
580 undef,
581 (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
e1ba0ad9 582 $nulls,
4caa4620 583 ($from ? ($from) : undef),
584 );
a82e41dc 585
586 if (!ref($arg)) {
587 $dq->{by} = $self->_ident_to_dq($arg);
588 } elsif (ref($arg) eq 'ARRAY') {
589 return unless @$arg;
590 local our $Order_Inner unless our $Order_Recursing;
591 local $Order_Recursing = 1;
592 my ($outer, $inner);
593 foreach my $member (@$arg) {
594 local $Order_Inner;
36e3ea6c 595 my $next = $self->_order_by_to_dq($member, $dir, $nulls, $from);
a82e41dc 596 $outer ||= $next;
597 $inner->{from} = $next if $inner;
598 $inner = $Order_Inner || $next;
599 }
600 $Order_Inner = $inner;
601 return $outer;
602 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'ARRAY') {
603 $dq->{by} = $self->_literal_to_dq($$arg);
02202b68 604 } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'HASH') {
605 $dq->{by} = $$arg;
a82e41dc 606 } elsif (ref($arg) eq 'SCALAR') {
8b9b83ae 607
608 # < mst> right, but if it doesn't match that, it goes "ok, right, not sure,
609 # totally leaving this untouched as a literal"
610 # < mst> so I -think- it's relatively robust
611 # < ribasushi> right, it's relatively safe then
612 # < ribasushi> is this regex centralized?
613 # < mst> it only exists in _order_by_to_dq in SQL::Abstract::Converter
614 # < mst> it only exists because you were kind enough to support new
615 # dbihacks crack combined with old literal order_by crack
616 # < ribasushi> heh :)
617
c30db4b6 618 # this should take into account our quote char and name sep
619
620 my $match_ident = '\w+(?:\.\w+)*';
621
622 if (my ($ident, $dir) = $$arg =~ /^(${match_ident})(?:\s+(desc|asc))?$/i) {
3d82b6c9 623 $dq->{by} = $self->_ident_to_dq($ident);
624 $dq->{reverse} = 1 if $dir and lc($dir) eq 'desc';
625 } else {
626 $dq->{by} = $self->_literal_to_dq($$arg);
627 }
a82e41dc 628 } elsif (ref($arg) eq 'HASH') {
36e3ea6c 629 return () unless %$arg;
630
631 my ($direction, $val);
632 foreach my $key (keys %$arg) {
633 if ( $key =~ /^-(desc|asc)/i ) {
634 die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
635 if defined $direction;
636 $direction = $1;
637 $val = $arg->{$key};
638 } elsif ($key =~ /^-nulls$/i) {
639 $nulls = $arg->{$key};
e1ba0ad9 640 die "invalid value for -nulls" unless $nulls =~ /^(?:first|last|none)$/i;
36e3ea6c 641 } else {
c5caf045 642 die "invalid key ${key} in hash passed to _order_by_to_dq";
36e3ea6c 643 }
644 }
a82e41dc 645
36e3ea6c 646 die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
647 unless defined $direction;
a82e41dc 648
36e3ea6c 649 return $self->_order_by_to_dq($val, $direction, $nulls, $from);
a82e41dc 650 } else {
651 die "Can't handle $arg in _order_by_to_dq";
652 }
653 return $dq;
654}
655
656sub _table_to_dq {
657 my ($self, $from) = @_;
658 if (ref($from) eq 'ARRAY') {
659 die "Empty FROM list" unless my @f = @$from;
660 my $dq = $self->_table_to_dq(shift @f);
661 while (my $x = shift @f) {
4caa4620 662 $dq = Join(
663 $dq,
664 $self->_table_to_dq($x),
665 );
a82e41dc 666 }
667 $dq;
668 } elsif (ref($from) eq 'SCALAR' or (ref($from) eq 'REF')) {
669 $self->_literal_to_dq($$from);
670 } else {
671 $self->_ident_to_dq($from);
672 }
673}
674
675# And bindtype
676sub _bindtype (@) {
677 #my ($self, $col, @vals) = @_;
678
679 #LDNOTE : changed original implementation below because it did not make
680 # sense when bindtype eq 'columns' and @vals > 1.
681# return $self->{bindtype} eq 'columns' ? [ $col, @vals ] : @vals;
682
683 # called often - tighten code
684 return $_[0]->bind_meta
685 ? map {[$_[1], $_]} @_[2 .. $#_]
686 : @_[2 .. $#_]
687 ;
688}
689
690# Dies if any element of @bind is not in [colname => value] format
691# if bindtype is 'columns'.
692sub _assert_bindval_matches_bindtype {
693# my ($self, @bind) = @_;
694 my $self = shift;
695 if ($self->bind_meta) {
696 for (@_) {
697 if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
698 die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
699 }
700 }
701 }
702}
703
704# Fix SQL case, if so requested
705sub _sqlcase {
706 return $_[0]->lower_case ? $_[1] : uc($_[1]);
707}
708
7091;