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/current/blead/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 Sub::Name 'subname';
 134 use DBIx::Class::Carp;
 135 use namespace::clean;
 136
 137 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
 138
 139 sub _quoting_enabled {
 140   ( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0
 141 }
 142
 143 # for when I need a normalized l/r pair
 144 sub _quote_chars {
 145
 146   # in case we are called in the old !!$sm->_quote_chars fashion
 147   return () if !wantarray and ( ! defined $_[0]->{quote_char} or ! length $_[0]->{quote_char} );
 148
 149   map
 150     { defined $_ ? $_ : '' }
 151     ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
 152   ;
 153 }
 154
 155 # FIXME when we bring in the storage weaklink, check its schema
 156 # weaklink and channel through $schema->throw_exception
 157 sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
 158
 159 BEGIN {
 160   # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
 161   # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
 162   no warnings qw/redefine/;
 163
 164   *SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) {
 165     my($func) = (caller(1))[3];
 166     carp "[$func] Warning: ", @_;
 167   };
 168
 169   *SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) {
 170     my($func) = (caller(1))[3];
 171     __PACKAGE__->throw_exception("[$func] Fatal: " . join ('',  @_));
 172   };
 173 }
 174
 175 # the "oh noes offset/top without limit" constant
 176 # limited to 31 bits for sanity (and consistency,
 177 # since it may be handed to the like of sprintf %u)
 178 #
 179 # Also *some* builds of SQLite fail the test
 180 #   some_column BETWEEN ? AND ?: 1, 4294967295
 181 # with the proper integer bind attrs
 182 #
 183 # Implemented as a method, since ::Storage::DBI also
 184 # refers to it (i.e. for the case of software_limit or
 185 # as the value to abuse with MSSQL ordered subqueries)
 186 sub __max_int () { 0x7FFFFFFF };
 187
 188 # we ne longer need to check this - DBIC has ways of dealing with it
 189 # specifically ::Storage::DBI::_resolve_bindattrs()
 190 sub _assert_bindval_matches_bindtype () { 1 };
 191
 192 # poor man's de-qualifier
 193 sub _quote {
 194   $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
 195     ? $_[1] =~ / ([^\.]+) $ /x
 196     : $_[1]
 197   );
 198 }
 199
 200 sub _where_op_NEST {
 201   carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
 202       .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
 203   );
 204
 205   shift->next::method(@_);
 206 }
 207
 208 # Handle limit-dialect selection
 209 sub select {
 210   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 211
 212
 213   ($fields, @{$self->{select_bind}}) = $self->_recurse_fields($fields);
 214
 215   if (defined $offset) {
 216     $self->throw_exception('A supplied offset must be a non-negative integer')
 217       if ( $offset =~ /\D/ or $offset < 0 );
 218   }
 219   $offset ||= 0;
 220
 221   if (defined $limit) {
 222     $self->throw_exception('A supplied limit must be a positive integer')
 223       if ( $limit =~ /\D/ or $limit <= 0 );
 224   }
 225   elsif ($offset) {
 226     $limit = $self->__max_int;
 227   }
 228
 229
 230   my ($sql, @bind);
 231   if ($limit) {
 232     # this is legacy code-flow from SQLA::Limit, it is not set in stone
 233
 234     ($sql, @bind) = $self->next::method ($table, $fields, $where);
 235
 236     my $limiter;
 237
 238     if( $limiter = $self->can ('emulate_limit') ) {
 239       carp_unique(
 240         'Support for the legacy emulate_limit() mechanism inherited from '
 241       . 'SQL::Abstract::Limit has been deprecated, and will be removed at '
 242       . 'some future point, as it gets in the way of architectural and/or '
 243       . 'performance advances within DBIC. If your code uses this type of '
 244       . 'limit specification please file an RT and provide the source of '
 245       . 'your emulate_limit() implementation, so an acceptable upgrade-path '
 246       . 'can be devised'
 247       );
 248     }
 249     else {
 250       my $dialect = $self->limit_dialect
 251         or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" );
 252
 253       $limiter = $self->can ("_$dialect")
 254         or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'");
 255     }
 256
 257     $sql = $self->$limiter (
 258       $sql,
 259       { %{$rs_attrs||{}}, _selector_sql => $fields },
 260       $limit,
 261       $offset
 262     );
 263   }
 264   else {
 265     ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
 266   }
 267
 268   push @{$self->{where_bind}}, @bind;
 269
 270 # this *must* be called, otherwise extra binds will remain in the sql-maker
 271   my @all_bind = $self->_assemble_binds;
 272
 273   $sql .= $self->_lock_select ($rs_attrs->{for})
 274     if $rs_attrs->{for};
 275
 276   return wantarray ? ($sql, @all_bind) : $sql;
 277 }
 278
 279 sub _assemble_binds {
 280   my $self = shift;
 281   return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/);
 282 }
 283
 284 my $for_syntax = {
 285   update => 'FOR UPDATE',
 286   shared => 'FOR SHARE',
 287 };
 288 sub _lock_select {
 289   my ($self, $type) = @_;
 290
 291   my $sql;
 292   if (ref($type) eq 'SCALAR') {
 293     $sql = "FOR $$type";
 294   }
 295   else {
 296     $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" );
 297   }
 298
 299   return " $sql";
 300 }
 301
 302 # Handle default inserts
 303 sub insert {
 304 # optimized due to hotttnesss
 305 #  my ($self, $table, $data, $options) = @_;
 306
 307   # FIXME SQLA will emit INSERT INTO $table ( ) VALUES ( )
 308   # which is sadly understood only by MySQL. Change default behavior here,
 309   # until we fold the extra pieces into SQLMaker properly
 310   if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
 311     my @bind;
 312     my $sql = sprintf(
 313       'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
 314     );
 315
 316     if ( ($_[3]||{})->{returning} ) {
 317       my $s;
 318       ($s, @bind) = $_[0]->_insert_returning ($_[3]);
 319       $sql .= $s;
 320     }
 321
 322     return ($sql, @bind);
 323   }
 324
 325   next::method(@_);
 326 }
 327
 328 sub _recurse_fields {
 329   my ($self, $fields) = @_;
 330   my $ref = ref $fields;
 331   return $self->_quote($fields) unless $ref;
 332   return $$fields if $ref eq 'SCALAR';
 333
 334   if ($ref eq 'ARRAY') {
 335     my (@select, @bind);
 336     for my $field (@$fields) {
 337       my ($select, @new_bind) = $self->_recurse_fields($field);
 338       push @select, $select;
 339       push @bind, @new_bind;
 340     }
 341     return (join(', ', @select), @bind);
 342   }
 343   elsif ($ref eq 'HASH') {
 344     my %hash = %$fields;  # shallow copy
 345
 346     my $as = delete $hash{-as};   # if supplied
 347
 348     my ($func, $rhs, @toomany) = %hash;
 349
 350     # there should be only one pair
 351     if (@toomany) {
 352       $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
 353     }
 354
 355     if (lc ($func) eq 'distinct' && ref $rhs eq 'ARRAY' && @$rhs > 1) {
 356       $self->throw_exception (
 357         'The select => { distinct => ... } syntax is not supported for multiple columns.'
 358        .' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }'
 359        .' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }'
 360       );
 361     }
 362
 363     my ($rhs_sql, @rhs_bind) = $self->_recurse_fields($rhs);
 364     my $select = sprintf ('%s( %s )%s',
 365       $self->_sqlcase($func),
 366       $rhs_sql,
 367       $as
 368         ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
 369         : ''
 370     );
 371
 372     return ($select, @rhs_bind);
 373   }
 374   elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
 375     return @{$$fields};
 376   }
 377   else {
 378     $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
 379   }
 380 }
 381
 382
 383 # this used to be a part of _order_by but is broken out for clarity.
 384 # What we have been doing forever is hijacking the $order arg of
 385 # SQLA::select to pass in arbitrary pieces of data (first the group_by,
 386 # then pretty much the entire resultset attr-hash, as more and more
 387 # things in the SQLA space need to have more info about the $rs they
 388 # create SQL for. The alternative would be to keep expanding the
 389 # signature of _select with more and more positional parameters, which
 390 # is just gross.
 391 #
 392 # FIXME - this will have to transition out to a subclass when the effort
 393 # of folding the SQLA machinery into SQLMaker takes place
 394 sub _parse_rs_attrs {
 395   my ($self, $arg) = @_;
 396
 397   my $sql = '';
 398   my @sqlbind;
 399
 400   if (
 401     $arg->{group_by}
 402       and
 403     @sqlbind = $self->_recurse_fields($arg->{group_by})
 404   ) {
 405     $sql .= $self->_sqlcase(' group by ') . shift @sqlbind;
 406     push @{$self->{group_bind}}, @sqlbind;
 407   }
 408
 409   if (
 410     $arg->{having}
 411       and
 412     @sqlbind = $self->_recurse_where($arg->{having})
 413   ) {
 414     $sql .= $self->_sqlcase(' having ') . shift @sqlbind;
 415     push(@{$self->{having_bind}}, @sqlbind);
 416   }
 417
 418   if ($arg->{order_by}) {
 419     # unlike the 2 above, _order_by injects into @{...bind...} for us
 420     $sql .= $self->_order_by ($arg->{order_by});
 421   }
 422
 423   return $sql;
 424 }
 425
 426 sub _order_by {
 427   my ($self, $arg) = @_;
 428
 429   # check that we are not called in legacy mode (order_by as 4th argument)
 430   (
 431     ref $arg eq 'HASH'
 432       and
 433     not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg
 434   )
 435     ? $self->_parse_rs_attrs ($arg)
 436     : do {
 437       my ($sql, @bind) = $self->next::method($arg);
 438       push @{$self->{order_bind}}, @bind;
 439       $sql; # RV
 440     }
 441   ;
 442 }
 443
 444 sub _split_order_chunk {
 445   my ($self, $chunk) = @_;
 446
 447   # strip off sort modifiers, but always succeed, so $1 gets reset
 448   $chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix;
 449
 450   return (
 451     $chunk,
 452     ( $1 and uc($1) eq 'DESC' ) ? 1 : 0,
 453   );
 454 }
 455
 456 sub _table {
 457 # optimized due to hotttnesss
 458 #  my ($self, $from) = @_;
 459   if (my $ref = ref $_[1] ) {
 460     if ($ref eq 'ARRAY') {
 461       return $_[0]->_recurse_from(@{$_[1]});
 462     }
 463     elsif ($ref eq 'HASH') {
 464       return $_[0]->_recurse_from($_[1]);
 465     }
 466     elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') {
 467       my ($sql, @bind) = @{ ${$_[1]} };
 468       push @{$_[0]->{from_bind}}, @bind;
 469       return $sql
 470     }
 471   }
 472   return $_[0]->next::method ($_[1]);
 473 }
 474
 475 sub _generate_join_clause {
 476     my ($self, $join_type) = @_;
 477
 478     $join_type = $self->{_default_jointype}
 479       if ! defined $join_type;
 480
 481     return sprintf ('%s JOIN ',
 482       $join_type ?  $self->_sqlcase($join_type) : ''
 483     );
 484 }
 485
 486 sub _recurse_from {
 487   my $self = shift;
 488   return join (' ', $self->_gen_from_blocks(@_) );
 489 }
 490
 491 sub _gen_from_blocks {
 492   my ($self, $from, @joins) = @_;
 493
 494   my @fchunks = $self->_from_chunk_to_sql($from);
 495
 496   for (@joins) {
 497     my ($to, $on) = @$_;
 498
 499     # check whether a join type exists
 500     my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
 501     my $join_type;
 502     if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
 503       $join_type = $to_jt->{-join_type};
 504       $join_type =~ s/^\s+ | \s+$//xg;
 505     }
 506
 507     my @j = $self->_generate_join_clause( $join_type );
 508
 509     if (ref $to eq 'ARRAY') {
 510       push(@j, '(', $self->_recurse_from(@$to), ')');
 511     }
 512     else {
 513       push(@j, $self->_from_chunk_to_sql($to));
 514     }
 515
 516     my ($sql, @bind) = $self->_join_condition($on);
 517     push(@j, ' ON ', $sql);
 518     push @{$self->{from_bind}}, @bind;
 519
 520     push @fchunks, join '', @j;
 521   }
 522
 523   return @fchunks;
 524 }
 525
 526 sub _from_chunk_to_sql {
 527   my ($self, $fromspec) = @_;
 528
 529   return join (' ', do {
 530     if (! ref $fromspec) {
 531       $self->_quote($fromspec);
 532     }
 533     elsif (ref $fromspec eq 'SCALAR') {
 534       $$fromspec;
 535     }
 536     elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') {
 537       push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
 538       $$fromspec->[0];
 539     }
 540     elsif (ref $fromspec eq 'HASH') {
 541       my ($as, $table, $toomuch) = ( map
 542         { $_ => $fromspec->{$_} }
 543         ( grep { $_ !~ /^\-/ } keys %$fromspec )
 544       );
 545
 546       $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
 547         if defined $toomuch;
 548
 549       ($self->_from_chunk_to_sql($table), $self->_quote($as) );
 550     }
 551     else {
 552       $self->throw_exception('Unsupported from refkind: ' . ref $fromspec );
 553     }
 554   });
 555 }
 556
 557 sub _join_condition {
 558   my ($self, $cond) = @_;
 559
 560   # Backcompat for the old days when a plain hashref
 561   # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
 562   if (
 563     ref $cond eq 'HASH'
 564       and
 565     keys %$cond == 1
 566       and
 567     (keys %$cond)[0] =~ /\./
 568       and
 569     ! ref ( (values %$cond)[0] )
 570   ) {
 571     carp_unique(
 572       "ResultSet {from} structures with conditions not conforming to the "
 573     . "SQL::Abstract syntax are deprecated: you either need to stop abusing "
 574     . "{from} altogether, or express the condition properly using the "
 575     . "{ -ident => ... } operator"
 576     );
 577     $cond = { keys %$cond => { -ident => values %$cond } }
 578   }
 579   elsif ( ref $cond eq 'ARRAY' ) {
 580     # do our own ORing so that the hashref-shim above is invoked
 581     my @parts;
 582     my @binds;
 583     foreach my $c (@$cond) {
 584       my ($sql, @bind) = $self->_join_condition($c);
 585       push @binds, @bind;
 586       push @parts, $sql;
 587     }
 588     return join(' OR ', @parts), @binds;
 589   }
 590
 591   return $self->_recurse_where($cond);
 592 }
 593
 594 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
 595 #
 596 # This is rather odd, but vanilla SQLA does not have support for multicolumn IN
 597 # expressions
 598 # Currently has only one callsite in ResultSet, body moved into this subclass
 599 # of SQLA to raise API questions like:
 600 # - how do we convey a list of idents...?
 601 # - can binds reside on lhs?
 602 #
 603 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
 604 sub _where_op_multicolumn_in {
 605   my ($self, $lhs, $rhs) = @_;
 606
 607   if (! ref $lhs or ref $lhs eq 'ARRAY') {
 608     my (@sql, @bind);
 609     for (ref $lhs ? @$lhs : $lhs) {
 610       if (! ref $_) {
 611         push @sql, $self->_quote($_);
 612       }
 613       elsif (ref $_ eq 'SCALAR') {
 614         push @sql, $$_;
 615       }
 616       elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') {
 617         my ($s, @b) = @$$_;
 618         push @sql, $s;
 619         push @bind, @b;
 620       }
 621       else {
 622         $self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs...");
 623       }
 624     }
 625     $lhs = \[ join(', ', @sql), @bind];
 626   }
 627   elsif (ref $lhs eq 'SCALAR') {
 628     $lhs = \[ $$lhs ];
 629   }
 630   elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) {
 631     # noop
 632   }
 633   else {
 634     $self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs...");
 635   }
 636
 637   # is this proper...?
 638   $rhs = \[ $self->_recurse_where($rhs) ];
 639
 640   for ($lhs, $rhs) {
 641     $$_->[0] = "( $$_->[0] )"
 642       unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs;
 643   }
 644
 645   \[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ];
 646 }
 647
 648 =head1 FURTHER QUESTIONS?
 649
 650 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 651
 652 =head1 COPYRIGHT AND LICENSE
 653
 654 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 655 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 656 redistribute it and/or modify it under the same terms as the
 657 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 658
 659 =cut
 660
 661 1;