lib/SQL/Abstract/Converter.pm

   1 package SQL::Abstract::Converter;
   2
   3 use Carp ();
   4 use List::Util ();
   5 use Scalar::Util ();
   6 use Data::Query::ExprHelpers;
   7 use Moo;
   8 use namespace::clean;
   9
  10 has renderer_will_quote => (
  11   is => 'ro'
  12 );
  13
  14 has lower_case => (
  15   is => 'ro'
  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';
  61   Literal('SQL', $literal, [ $self->_bind_to_dq(@bind) ]);
  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;
  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   );
  93 }
  94
  95 sub _maybe_convert_dq {
  96   my ($self, $dq) = @_;
  97   if (my $c = $self->{where_convert}) {
  98     Operator({ 'SQL.Naive' => 'apply' }, [
  99         Identifier($self->_sqlcase($c)),
 100         $dq
 101       ]
 102     );
 103   } else {
 104     $dq;
 105   }
 106 }
 107
 108 sub _op_to_dq {
 109   my ($self, $op, @args) = @_;
 110   $self->_assert_pass_injection_guard($op);
 111   Operator({ 'SQL.Naive' => $op }, \@args);
 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   }
 145   Insert(
 146     (@names ? ([ map $self->_ident_to_dq($_), @names ]) : undef),
 147     [ \@values ],
 148     $self->_table_to_dq($table),
 149     ($returning ? ($returning) : undef),
 150   );
 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
 184   Update(
 185     \@set,
 186     $self->_where_to_dq($where),
 187     $self->_table_to_dq($table),
 188   );
 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)) {
 197     $source_dq = Where($where_dq, $source_dq);
 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) {
 211       $self->_order_by_to_dq($order, undef, undef, $source_dq);
 212     } else {
 213       $source_dq
 214     }
 215   };
 216
 217   return $self->_select_select_to_dq($fields, $ordered_dq);
 218 }
 219
 220 sub _select_select_to_dq {
 221   my ($self, $fields, $from_dq) = @_;
 222
 223   $fields ||= '*';
 224
 225   Select(
 226     $self->_select_field_list_to_dq($fields),
 227     $from_dq,
 228   );
 229 }
 230
 231 sub _select_field_list_to_dq {
 232   my ($self, $fields) = @_;
 233   [ map $self->_select_field_to_dq($_),
 234       ref($fields) eq 'ARRAY' ? @$fields : $fields ];
 235 }
 236
 237 sub _select_field_to_dq {
 238   my ($self, $field) = @_;
 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)
 247 }
 248
 249 sub _delete_to_dq {
 250   my ($self, $table, $where) = @_;
 251   Delete(
 252     $self->_where_to_dq($where),
 253     $self->_table_to_dq($table),
 254   );
 255 }
 256
 257 sub _where_to_dq {
 258   my ($self, $where, $logic) = @_;
 259
 260   return undef unless defined($where);
 261
 262   # if we're given a simple string assume it's a literal
 263   return $self->_literal_to_dq($where) if !ref($where);
 264
 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
 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
 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);
 295   } elsif (ref($where) eq 'REF' and ref($$where) eq 'HASH') {
 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;
 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 (
 404       is_Operator($arg) and $arg->{operator}{'SQL.Naive'} eq 'apply'
 405       and @{$arg->{args}} == 2 and !is_Operator($arg->{args}[1])
 406
 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')) {
 457       return Literal('SQL', [ $self->_ident_to_dq($k), $self->_literal_to_dq($$v) ]);
 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') {
 486       die "Argument passed to the '$op' operator can not be undefined" unless defined $rhs;
 487       $rhs = [$rhs] unless ref $rhs;
 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;
 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             }
 504           }
 505         }
 506         return $self->_op_to_dq(
 507           $op, $self->_ident_to_dq($k), $self->_literal_to_dq($$rhs)
 508         );
 509       }
 510       if (grep !defined, @$rhs) {
 511         my ($inop, $logic, $nullop) = $op =~ /^NOT/
 512           ? (-not_in => AND => { '!=' => undef })
 513           : (-in => OR => undef);
 514         if (my @defined = grep defined, @$rhs) {
 515           return $self->_expr_to_dq_ARRAYREF([
 516             { $k => { $inop => \@defined } },
 517             { $k => $nullop },
 518           ], $logic);
 519         }
 520         return $self->_expr_to_dq_HASHREF({ $k => $nullop });
 521       }
 522       return $self->_literal_to_dq(
 523         $op =~ /^NOT/ ? $self->{sqltrue} : $self->{sqlfalse}
 524       ) unless @$rhs;
 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 {
 540         if ($op eq '=' or $op eq 'LIKE' or $op eq 'IS') {
 541           'IS NULL'
 542         } elsif ($op eq '!=' or $op eq 'NOT LIKE' or $op eq 'IS NOT') {
 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 {
 573   my ($self, $arg, $dir, $nulls, $from) = @_;
 574
 575   return unless $arg;
 576
 577   my $dq = Order(
 578     undef,
 579     (defined($dir) ? (!!($dir =~ /desc/i)) : undef),
 580     $nulls,
 581     ($from ? ($from) : undef),
 582   );
 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;
 593       my $next = $self->_order_by_to_dq($member, $dir, $nulls, $from);
 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);
 602   } elsif (ref($arg) eq 'REF' and ref($$arg) eq 'HASH') {
 603     $dq->{by} = $$arg;
 604   } elsif (ref($arg) eq 'SCALAR') {
 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
 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) {
 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     }
 626   } elsif (ref($arg) eq 'HASH') {
 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};
 638         die "invalid value for -nulls" unless $nulls =~ /^(?:first|last|none)$/i;
 639       } else {
 640         die "invalid key ${key} in hash passed to _order_by_to_dq";
 641       }
 642     }
 643
 644     die "hash passed to _order_by_to_dq must have exactly one of -desc or -asc"
 645         unless defined $direction;
 646
 647     return $self->_order_by_to_dq($val, $direction, $nulls, $from);
 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) {
 660       $dq = Join(
 661         $dq,
 662         $self->_table_to_dq($x),
 663       );
 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;