lib/DBIx/Class/SQLMaker.pm

   1 package DBIx::Class::SQLMaker;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
   9
  10 =head1 DESCRIPTION
  11
  12 This module is currently a subclass of L<SQL::Abstract> and includes a number of
  13 DBIC-specific extensions/workarounds, not suitable for inclusion into the
  14 L<SQL::Abstract> core. It also provides all (and more than) the functionality
  15 of L<SQL::Abstract::Limit>, see L<DBIx::Class::SQLMaker::LimitDialects> for
  16 more info.
  17
  18 Currently the enhancements over L<SQL::Abstract> are:
  19
  20 =over
  21
  22 =item * Support for C<JOIN> statements (via extended C<table/from> support)
  23
  24 =item * Support of functions in C<SELECT> lists
  25
  26 =item * C<GROUP BY>/C<HAVING> support (via extensions to the order_by parameter)
  27
  28 =item * A rudimentary multicolumn IN operator
  29
  30 =item * Support of C<...FOR UPDATE> type of select statement modifiers
  31
  32 =back
  33
  34 =head1 ROADMAP
  35
  36 Some maintainer musings on the current state of SQL generation within DBIC as
  37 of Oct 2015
  38
  39 =head2 Folding of most (or all) of L<SQL::Abstract (SQLA)|SQL::Abstract> into DBIC
  40
  41 The rise of complex prefetch use, and the general streamlining of result
  42 parsing within DBIC ended up pushing the actual SQL generation to the forefront
  43 of many casual performance profiles. While the idea behind SQLA's API is sound,
  44 the actual implementation is terribly inefficient (once again bumping into the
  45 ridiculously high overhead of perl function calls).
  46
  47 Given that SQLA has a B<very> distinct life on its own, and is used within an
  48 order of magnitude more projects compared to DBIC, it is prudent to B<not>
  49 disturb the current call chains within SQLA itself. Instead in the near future
  50 an effort will be undertaken to seek a more thorough decoupling of DBIC SQL
  51 generation from reliance on SQLA, possibly to a point where B<DBIC will no
  52 longer depend on SQLA> at all.
  53
  54 B<The L<SQL::Abstract> library itself will continue being maintained> although
  55 it is not likely to gain many extra features, notably dialect support, at least
  56 not within the base C<SQL::Abstract> namespace.
  57
  58 This work (if undertaken) will take into consideration the following
  59 constraints:
  60
  61 =over
  62
  63 =item Main API compatibility
  64
  65 The object returned by C<< $schema->storage->sqlmaker >> needs to be able to
  66 satisfy most of the basic tests found in the current-at-the-time SQLA dist.
  67 While things like L<case|SQL::Abstract/case> or L<logic|SQL::Abstract/logic>
  68 or even worse L<convert|SQL::Abstract/convert> will definitely remain
  69 unsupported, the rest of the tests should pass (within reason).
  70
  71 =item Ability to plug back an SQL::Abstract (or derivative)
  72
  73 During the initial work on L<Data::Query> the test suite of DBIC turned out to
  74 be an invaluable asset to iron out hard-to-reason-about corner cases. In
  75 addition the test suite is much more vast and intricate than the tests of SQLA
  76 itself. This state of affairs is way too valuable to sacrifice in order to gain
  77 faster SQL generation. Thus a compile-time-ENV-check will be introduced along
  78 with an extra CI configuration to ensure that DBIC is used with an off-the-CPAN
  79 SQLA and that it continues to flawlessly run its entire test suite. While this
  80 will undoubtedly complicate the implementation of the better performing SQL
  81 generator, it will preserve both the usability of the test suite for external
  82 projects and will keep L<SQL::Abstract> from regressions in the future.
  83
  84 =back
  85
  86 Aside from these constraints it is becoming more and more practical to simply
  87 stop using SQLA in day-to-day production deployments of DBIC. The flexibility
  88 of the internals is simply not worth the performance cost.
  89
  90 =head2 Relationship to L<Data::Query (DQ)|Data::Query>
  91
  92 When initial work on DQ was taking place, the tools in L<::Storage::DBIHacks
  93 |http://github.com/dbsrgits/dbix-class/blob/master/lib/DBIx/Class/Storage/DBIHacks.pm>
  94 were only beginning to take shape, and it wasn't clear how important they will
  95 become further down the road. In fact the I<regexing all over the place> was
  96 considered an ugly stop-gap, and even a couple of highly entertaining talks
  97 were given to that effect. As the use-cases of DBIC were progressing, and
  98 evidence for the importance of supporting arbitrary SQL was mounting, it became
  99 clearer that DBIC itself would not really benefit in any way from an
 100 integration with DQ, but on the contrary is likely to lose functionality while
 101 the corners of the brand new DQ codebase are sanded off.
 102
 103 The current status of DBIC/DQ integration is that the only benefit is for DQ by
 104 having access to the very extensive "early adopter" test suite, in the same
 105 manner as early DBIC benefitted tremendously from usurping the Class::DBI test
 106 suite. As far as the DBIC user-base - there are no immediate practical upsides
 107 to DQ integration, neither in terms of API nor in performance.
 108
 109 So (as described higher up) the DBIC development effort will in the foreseable
 110 future ignore the existence of DQ, and will continue optimizing the preexisting
 111 SQLA-based solution, potentially "organically growing" its own compatible
 112 implementation. Also (again, as described higher up) the ability to plug a
 113 separate SQLA-compatible class providing the necessary surface API will remain
 114 possible, and will be protected at all costs in order to continue providing DQ
 115 access to the test cases of DBIC.
 116
 117 In the short term, after one more pass over the ResultSet internals is
 118 undertaken I<real soon now (tm)>, and before the SQLA/SQLMaker integration
 119 takes place, the preexisting DQ-based branches will be pulled/modified/rebased
 120 to get up-to-date with the current state of the codebase, which changed very
 121 substantially since the last migration effort, especially in the SQL
 122 classification meta-parsing codepath.
 123
 124 =cut
 125
 126 use base qw/
 127   DBIx::Class::SQLMaker::LimitDialects
 128   SQL::Abstract
 129   DBIx::Class
 130 /;
 131 use mro 'c3';
 132
 133 use DBIx::Class::Carp;
 134 use DBIx::Class::_Util 'set_subname';
 135 use SQL::Abstract 'is_literal_value';
 136 use namespace::clean;
 137
 138 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
 139
 140 sub _quoting_enabled {
 141   ( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0
 142 }
 143
 144 # for when I need a normalized l/r pair
 145 sub _quote_chars {
 146
 147   # in case we are called in the old !!$sm->_quote_chars fashion
 148   return () if !wantarray and ( ! defined $_[0]->{quote_char} or ! length $_[0]->{quote_char} );
 149
 150   map
 151     { defined $_ ? $_ : '' }
 152     ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
 153   ;
 154 }
 155
 156 # FIXME when we bring in the storage weaklink, check its schema
 157 # weaklink and channel through $schema->throw_exception
 158 sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
 159
 160 BEGIN {
 161   # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
 162   # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
 163   no warnings qw/redefine/;
 164
 165   *SQL::Abstract::belch = set_subname 'SQL::Abstract::belch' => sub (@) {
 166     my($func) = (caller(1))[3];
 167     carp "[$func] Warning: ", @_;
 168   };
 169
 170   *SQL::Abstract::puke = set_subname 'SQL::Abstract::puke' => sub (@) {
 171     my($func) = (caller(1))[3];
 172     __PACKAGE__->throw_exception("[$func] Fatal: " . join ('',  @_));
 173   };
 174 }
 175
 176 # the "oh noes offset/top without limit" constant
 177 # limited to 31 bits for sanity (and consistency,
 178 # since it may be handed to the like of sprintf %u)
 179 #
 180 # Also *some* builds of SQLite fail the test
 181 #   some_column BETWEEN ? AND ?: 1, 4294967295
 182 # with the proper integer bind attrs
 183 #
 184 # Implemented as a method, since ::Storage::DBI also
 185 # refers to it (i.e. for the case of software_limit or
 186 # as the value to abuse with MSSQL ordered subqueries)
 187 sub __max_int () { 0x7FFFFFFF };
 188
 189 # we ne longer need to check this - DBIC has ways of dealing with it
 190 # specifically ::Storage::DBI::_resolve_bindattrs()
 191 sub _assert_bindval_matches_bindtype () { 1 };
 192
 193 # poor man's de-qualifier
 194 sub _quote {
 195   $_[0]->next::method( ( $_[0]{_dequalify_idents} and defined $_[1] and ! ref $_[1] )
 196     ? $_[1] =~ / ([^\.]+) $ /x
 197     : $_[1]
 198   );
 199 }
 200
 201 sub _where_op_NEST {
 202   carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
 203       .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
 204   );
 205
 206   shift->next::method(@_);
 207 }
 208
 209 # Handle limit-dialect selection
 210 sub select {
 211   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 212
 213   ($fields, @{$self->{select_bind}}) = length ref $fields
 214     ? $self->_recurse_fields( $fields )
 215     : $self->_quote( $fields )
 216   ;
 217
 218   # Override the default behavior of SQL::Abstract - SELECT * makes
 219   # no sense in the context of DBIC (and has resulted in several
 220   # tricky debugging sessions in the past)
 221   not length $fields
 222     and
 223 # FIXME - some day we need to enable this, but too many things break
 224 # ( notably S::L )
 225 #  # Random value selected by a fair roll of dice
 226 #  # In seriousness - this has to be a number, as it is much more
 227 #  # palatable to random engines in a SELECT list
 228 #  $fields = 42
 229 #    and
 230   carp_unique (
 231     "ResultSets with an empty selection are deprecated (you almost certainly "
 232   . "did not mean to do that): if this is indeed your intent you must "
 233   . "explicitly supply \\'*' to your search()"
 234   );
 235
 236   if (defined $offset) {
 237     $self->throw_exception('A supplied offset must be a non-negative integer')
 238       if ( $offset =~ /[^0-9]/ or $offset < 0 );
 239   }
 240   $offset ||= 0;
 241
 242   if (defined $limit) {
 243     $self->throw_exception('A supplied limit must be a positive integer')
 244       if ( $limit =~ /[^0-9]/ or $limit <= 0 );
 245   }
 246   elsif ($offset) {
 247     $limit = $self->__max_int;
 248   }
 249
 250
 251   my ($sql, @bind);
 252   if ($limit) {
 253     # this is legacy code-flow from SQLA::Limit, it is not set in stone
 254
 255     ($sql, @bind) = $self->next::method ($table, $fields, $where);
 256
 257     my $limiter;
 258
 259     if( $limiter = $self->can ('emulate_limit') ) {
 260       carp_unique(
 261         'Support for the legacy emulate_limit() mechanism inherited from '
 262       . 'SQL::Abstract::Limit has been deprecated, and will be removed at '
 263       . 'some future point, as it gets in the way of architectural and/or '
 264       . 'performance advances within DBIC. If your code uses this type of '
 265       . 'limit specification please file an RT and provide the source of '
 266       . 'your emulate_limit() implementation, so an acceptable upgrade-path '
 267       . 'can be devised'
 268       );
 269     }
 270     else {
 271       my $dialect = $self->limit_dialect
 272         or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" );
 273
 274       $limiter = $self->can ("_$dialect")
 275         or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'");
 276     }
 277
 278     $sql = $self->$limiter (
 279       $sql,
 280       { %{$rs_attrs||{}}, _selector_sql => $fields },
 281       $limit,
 282       $offset
 283     );
 284   }
 285   else {
 286     ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
 287   }
 288
 289   push @{$self->{where_bind}}, @bind;
 290
 291 # this *must* be called, otherwise extra binds will remain in the sql-maker
 292   my @all_bind = $self->_assemble_binds;
 293
 294   $sql .= $self->_lock_select ($rs_attrs->{for})
 295     if $rs_attrs->{for};
 296
 297   return wantarray ? ($sql, @all_bind) : $sql;
 298 }
 299
 300 sub _assemble_binds {
 301   my $self = shift;
 302   return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/);
 303 }
 304
 305 my $for_syntax = {
 306   update => 'FOR UPDATE',
 307   shared => 'FOR SHARE',
 308 };
 309 sub _lock_select {
 310   my ($self, $type) = @_;
 311
 312   my $sql;
 313   if (ref($type) eq 'SCALAR') {
 314     $sql = "FOR $$type";
 315   }
 316   else {
 317     $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" );
 318   }
 319
 320   return " $sql";
 321 }
 322
 323 # Handle default inserts
 324 sub insert {
 325 # optimized due to hotttnesss
 326 #  my ($self, $table, $data, $options) = @_;
 327
 328   # FIXME SQLA will emit INSERT INTO $table ( ) VALUES ( )
 329   # which is sadly understood only by MySQL. Change default behavior here,
 330   # until we fold the extra pieces into SQLMaker properly
 331   if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
 332     my @bind;
 333     my $sql = sprintf(
 334       'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
 335     );
 336
 337     if ( ($_[3]||{})->{returning} ) {
 338       my $s;
 339       ($s, @bind) = $_[0]->_insert_returning ($_[3]);
 340       $sql .= $s;
 341     }
 342
 343     return ($sql, @bind);
 344   }
 345
 346   next::method(@_);
 347 }
 348
 349 sub _recurse_fields {
 350   my ($self, $fields) = @_;
 351
 352   if( not length ref $fields ) {
 353     return $self->_quote( $fields );
 354   }
 355
 356   elsif( my $lit = is_literal_value( $fields ) ) {
 357     return @$lit
 358   }
 359
 360   elsif( ref $fields eq 'ARRAY' ) {
 361     my (@select, @bind, @bind_fragment);
 362
 363     (
 364       ( $select[ $#select + 1 ], @bind_fragment ) = length ref $_
 365         ? $self->_recurse_fields( $_ )
 366         : $self->_quote( $_ )
 367     ),
 368     ( push @bind, @bind_fragment )
 369       for @$fields;
 370
 371     return (join(', ', @select), @bind);
 372   }
 373
 374   # FIXME - really crappy handling of functions
 375   elsif ( ref $fields eq 'HASH') {
 376     my %hash = %$fields;  # shallow copy
 377
 378     my $as = delete $hash{-as};   # if supplied
 379
 380     my ($func, $rhs, @toomany) = %hash;
 381
 382     # there should be only one pair
 383     $self->throw_exception(
 384       "Malformed select argument - too many keys in hash: " . join (',', keys %$fields )
 385     ) if @toomany;
 386
 387     $self->throw_exception (
 388       'The select => { distinct => ... } syntax is not supported for multiple columns.'
 389      .' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }'
 390      .' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }'
 391     ) if (
 392       lc ($func) eq 'distinct'
 393         and
 394       ref $rhs eq 'ARRAY'
 395         and
 396       @$rhs > 1
 397     );
 398
 399     my ($rhs_sql, @rhs_bind) = length ref $rhs
 400       ? $self->_recurse_fields($rhs)
 401       : $self->_quote($rhs)
 402     ;
 403
 404     return(
 405       sprintf( '%s( %s )%s',
 406         $self->_sqlcase($func),
 407         $rhs_sql,
 408         $as
 409           ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
 410           : ''
 411       ),
 412       @rhs_bind
 413     );
 414   }
 415
 416   else {
 417     $self->throw_exception( ref($fields) . ' unexpected in _recurse_fields()' );
 418   }
 419 }
 420
 421
 422 # this used to be a part of _order_by but is broken out for clarity.
 423 # What we have been doing forever is hijacking the $order arg of
 424 # SQLA::select to pass in arbitrary pieces of data (first the group_by,
 425 # then pretty much the entire resultset attr-hash, as more and more
 426 # things in the SQLA space need to have more info about the $rs they
 427 # create SQL for. The alternative would be to keep expanding the
 428 # signature of _select with more and more positional parameters, which
 429 # is just gross.
 430 #
 431 # FIXME - this will have to transition out to a subclass when the effort
 432 # of folding the SQLA machinery into SQLMaker takes place
 433 sub _parse_rs_attrs {
 434   my ($self, $arg) = @_;
 435
 436   my $sql = '';
 437   my @sqlbind;
 438
 439   if (
 440     $arg->{group_by}
 441       and
 442     @sqlbind = $self->_recurse_fields($arg->{group_by})
 443   ) {
 444     $sql .= $self->_sqlcase(' group by ') . shift @sqlbind;
 445     push @{$self->{group_bind}}, @sqlbind;
 446   }
 447
 448   if (
 449     $arg->{having}
 450       and
 451     @sqlbind = $self->_recurse_where($arg->{having})
 452   ) {
 453     $sql .= $self->_sqlcase(' having ') . shift @sqlbind;
 454     push(@{$self->{having_bind}}, @sqlbind);
 455   }
 456
 457   if ($arg->{order_by}) {
 458     # unlike the 2 above, _order_by injects into @{...bind...} for us
 459     $sql .= $self->_order_by ($arg->{order_by});
 460   }
 461
 462   return $sql;
 463 }
 464
 465 sub _order_by {
 466   my ($self, $arg) = @_;
 467
 468   # check that we are not called in legacy mode (order_by as 4th argument)
 469   (
 470     ref $arg eq 'HASH'
 471       and
 472     not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg
 473   )
 474     ? $self->_parse_rs_attrs ($arg)
 475     : do {
 476       my ($sql, @bind) = $self->next::method($arg);
 477       push @{$self->{order_bind}}, @bind;
 478       $sql; # RV
 479     }
 480   ;
 481 }
 482
 483 sub _split_order_chunk {
 484   my ($self, $chunk) = @_;
 485
 486   # strip off sort modifiers, but always succeed, so $1 gets reset
 487   $chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix;
 488
 489   return (
 490     $chunk,
 491     ( $1 and uc($1) eq 'DESC' ) ? 1 : 0,
 492   );
 493 }
 494
 495 sub _table {
 496 # optimized due to hotttnesss
 497 #  my ($self, $from) = @_;
 498   if (my $ref = ref $_[1] ) {
 499     if ($ref eq 'ARRAY') {
 500       return $_[0]->_recurse_from(@{$_[1]});
 501     }
 502     elsif ($ref eq 'HASH') {
 503       return $_[0]->_recurse_from($_[1]);
 504     }
 505     elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') {
 506       my ($sql, @bind) = @{ ${$_[1]} };
 507       push @{$_[0]->{from_bind}}, @bind;
 508       return $sql
 509     }
 510   }
 511   return $_[0]->next::method ($_[1]);
 512 }
 513
 514 sub _generate_join_clause {
 515     my ($self, $join_type) = @_;
 516
 517     $join_type = $self->{_default_jointype}
 518       if ! defined $join_type;
 519
 520     return sprintf ('%s JOIN ',
 521       $join_type ?  $self->_sqlcase($join_type) : ''
 522     );
 523 }
 524
 525 sub _recurse_from {
 526   my $self = shift;
 527   return join (' ', $self->_gen_from_blocks(@_) );
 528 }
 529
 530 sub _gen_from_blocks {
 531   my ($self, $from, @joins) = @_;
 532
 533   my @fchunks = $self->_from_chunk_to_sql($from);
 534
 535   for (@joins) {
 536     my ($to, $on) = @$_;
 537
 538     # check whether a join type exists
 539     my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
 540     my $join_type;
 541     if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
 542       $join_type = $to_jt->{-join_type};
 543       $join_type =~ s/^\s+ | \s+$//xg;
 544     }
 545
 546     my @j = $self->_generate_join_clause( $join_type );
 547
 548     if (ref $to eq 'ARRAY') {
 549       push(@j, '(', $self->_recurse_from(@$to), ')');
 550     }
 551     else {
 552       push(@j, $self->_from_chunk_to_sql($to));
 553     }
 554
 555     my ($sql, @bind) = $self->_join_condition($on);
 556     push(@j, ' ON ', $sql);
 557     push @{$self->{from_bind}}, @bind;
 558
 559     push @fchunks, join '', @j;
 560   }
 561
 562   return @fchunks;
 563 }
 564
 565 sub _from_chunk_to_sql {
 566   my ($self, $fromspec) = @_;
 567
 568   return join (' ', do {
 569     if (! ref $fromspec) {
 570       $self->_quote($fromspec);
 571     }
 572     elsif (ref $fromspec eq 'SCALAR') {
 573       $$fromspec;
 574     }
 575     elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') {
 576       push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
 577       $$fromspec->[0];
 578     }
 579     elsif (ref $fromspec eq 'HASH') {
 580       my ($as, $table, $toomuch) = ( map
 581         { $_ => $fromspec->{$_} }
 582         ( grep { $_ !~ /^\-/ } keys %$fromspec )
 583       );
 584
 585       $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
 586         if defined $toomuch;
 587
 588       ($self->_from_chunk_to_sql($table), $self->_quote($as) );
 589     }
 590     else {
 591       $self->throw_exception('Unsupported from refkind: ' . ref $fromspec );
 592     }
 593   });
 594 }
 595
 596 sub _join_condition {
 597   my ($self, $cond) = @_;
 598
 599   # Backcompat for the old days when a plain hashref
 600   # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
 601   if (
 602     ref $cond eq 'HASH'
 603       and
 604     keys %$cond == 1
 605       and
 606     (keys %$cond)[0] =~ /\./
 607       and
 608     ! ref ( (values %$cond)[0] )
 609   ) {
 610     carp_unique(
 611       "ResultSet {from} structures with conditions not conforming to the "
 612     . "SQL::Abstract syntax are deprecated: you either need to stop abusing "
 613     . "{from} altogether, or express the condition properly using the "
 614     . "{ -ident => ... } operator"
 615     );
 616     $cond = { keys %$cond => { -ident => values %$cond } }
 617   }
 618   elsif ( ref $cond eq 'ARRAY' ) {
 619     # do our own ORing so that the hashref-shim above is invoked
 620     my @parts;
 621     my @binds;
 622     foreach my $c (@$cond) {
 623       my ($sql, @bind) = $self->_join_condition($c);
 624       push @binds, @bind;
 625       push @parts, $sql;
 626     }
 627     return join(' OR ', @parts), @binds;
 628   }
 629
 630   return $self->_recurse_where($cond);
 631 }
 632
 633 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
 634 #
 635 # This is rather odd, but vanilla SQLA does not have support for multicolumn IN
 636 # expressions
 637 # Currently has only one callsite in ResultSet, body moved into this subclass
 638 # of SQLA to raise API questions like:
 639 # - how do we convey a list of idents...?
 640 # - can binds reside on lhs?
 641 #
 642 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
 643 sub _where_op_multicolumn_in {
 644   my ($self, $lhs, $rhs) = @_;
 645
 646   if (! ref $lhs or ref $lhs eq 'ARRAY') {
 647     my (@sql, @bind);
 648     for (ref $lhs ? @$lhs : $lhs) {
 649       if (! ref $_) {
 650         push @sql, $self->_quote($_);
 651       }
 652       elsif (ref $_ eq 'SCALAR') {
 653         push @sql, $$_;
 654       }
 655       elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') {
 656         my ($s, @b) = @$$_;
 657         push @sql, $s;
 658         push @bind, @b;
 659       }
 660       else {
 661         $self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs...");
 662       }
 663     }
 664     $lhs = \[ join(', ', @sql), @bind];
 665   }
 666   elsif (ref $lhs eq 'SCALAR') {
 667     $lhs = \[ $$lhs ];
 668   }
 669   elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) {
 670     # noop
 671   }
 672   else {
 673     $self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs...");
 674   }
 675
 676   # is this proper...?
 677   $rhs = \[ $self->_recurse_where($rhs) ];
 678
 679   for ($lhs, $rhs) {
 680     $$_->[0] = "( $$_->[0] )"
 681       unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs;
 682   }
 683
 684   \[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ];
 685 }
 686
 687 =head1 FURTHER QUESTIONS?
 688
 689 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 690
 691 =head1 COPYRIGHT AND LICENSE
 692
 693 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 694 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 695 redistribute it and/or modify it under the same terms as the
 696 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 697
 698 =cut
 699
 700 1;