Expand/fortify the handling of attributes
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / SQLMaker.pm
CommitLineData
d5dedbd6 1package DBIx::Class::SQLMaker;
6f4ddea1 2
a697fa31 3use strict;
4use warnings;
5
d5dedbd6 6=head1 NAME
7
8DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
9
10=head1 DESCRIPTION
11
07fadea8 12This module is currently a subclass of L<SQL::Abstract> and includes a number of
13DBIC-specific extensions/workarounds, not suitable for inclusion into the
d5dedbd6 14L<SQL::Abstract> core. It also provides all (and more than) the functionality
15of L<SQL::Abstract::Limit>, see L<DBIx::Class::SQLMaker::LimitDialects> for
16more info.
17
07fadea8 18Currently the enhancements over L<SQL::Abstract> are:
d5dedbd6 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
07fadea8 28=item * A rudimentary multicolumn IN operator
29
d5dedbd6 30=item * Support of C<...FOR UPDATE> type of select statement modifiers
31
32=back
33
07fadea8 34=head1 ROADMAP
35
36Some maintainer musings on the current state of SQL generation within DBIC as
37of Oct 2015
38
39=head2 Folding of most (or all) of L<SQL::Abstract (SQLA)|SQL::Abstract> into DBIC
40
41The rise of complex prefetch use, and the general streamlining of result
42parsing within DBIC ended up pushing the actual SQL generation to the forefront
43of many casual performance profiles. While the idea behind SQLA's API is sound,
44the actual implementation is terribly inefficient (once again bumping into the
45ridiculously high overhead of perl function calls).
46
47Given that SQLA has a B<very> distinct life on its own, and is used within an
48order of magnitude more projects compared to DBIC, it is prudent to B<not>
49disturb the current call chains within SQLA itself. Instead in the near future
50an effort will be undertaken to seek a more thorough decoupling of DBIC SQL
51generation from reliance on SQLA, possibly to a point where B<DBIC will no
52longer depend on SQLA> at all.
53
54B<The L<SQL::Abstract> library itself will continue being maintained> although
55it is not likely to gain many extra features, notably dialect support, at least
56not within the base C<SQL::Abstract> namespace.
57
58This work (if undertaken) will take into consideration the following
59constraints:
60
61=over
62
63=item Main API compatibility
64
65The object returned by C<< $schema->storage->sqlmaker >> needs to be able to
66satisfy most of the basic tests found in the current-at-the-time SQLA dist.
67While things like L<case|SQL::Abstract/case> or L<logic|SQL::Abstract/logic>
68or even worse L<convert|SQL::Abstract/convert> will definitely remain
69unsupported, the rest of the tests should pass (within reason).
70
71=item Ability to plug back an SQL::Abstract (or derivative)
72
73During the initial work on L<Data::Query> the test suite of DBIC turned out to
74be an invaluable asset to iron out hard-to-reason-about corner cases. In
75addition the test suite is much more vast and intricate than the tests of SQLA
76itself. This state of affairs is way too valuable to sacrifice in order to gain
77faster SQL generation. Thus a compile-time-ENV-check will be introduced along
78with an extra CI configuration to ensure that DBIC is used with an off-the-CPAN
79SQLA and that it continues to flawlessly run its entire test suite. While this
80will undoubtedly complicate the implementation of the better performing SQL
81generator, it will preserve both the usability of the test suite for external
82projects and will keep L<SQL::Abstract> from regressions in the future.
83
84=back
85
86Aside from these constraints it is becoming more and more practical to simply
87stop using SQLA in day-to-day production deployments of DBIC. The flexibility
88of the internals is simply not worth the performance cost.
89
90=head2 Relationship to L<Data::Query (DQ)|Data::Query>
91
92When initial work on DQ was taking place, the tools in L<::Storage::DBIHacks
33d0570d 93|http://github.com/dbsrgits/dbix-class/blob/master/lib/DBIx/Class/Storage/DBIHacks.pm>
07fadea8 94were only beginning to take shape, and it wasn't clear how important they will
95become further down the road. In fact the I<regexing all over the place> was
96considered an ugly stop-gap, and even a couple of highly entertaining talks
97were given to that effect. As the use-cases of DBIC were progressing, and
98evidence for the importance of supporting arbitrary SQL was mounting, it became
99clearer that DBIC itself would not really benefit in any way from an
100integration with DQ, but on the contrary is likely to lose functionality while
101the corners of the brand new DQ codebase are sanded off.
102
103The current status of DBIC/DQ integration is that the only benefit is for DQ by
104having access to the very extensive "early adopter" test suite, in the same
105manner as early DBIC benefitted tremendously from usurping the Class::DBI test
106suite. As far as the DBIC user-base - there are no immediate practical upsides
107to DQ integration, neither in terms of API nor in performance.
108
109So (as described higher up) the DBIC development effort will in the foreseable
110future ignore the existence of DQ, and will continue optimizing the preexisting
111SQLA-based solution, potentially "organically growing" its own compatible
112implementation. Also (again, as described higher up) the ability to plug a
113separate SQLA-compatible class providing the necessary surface API will remain
114possible, and will be protected at all costs in order to continue providing DQ
115access to the test cases of DBIC.
116
117In the short term, after one more pass over the ResultSet internals is
118undertaken I<real soon now (tm)>, and before the SQLA/SQLMaker integration
119takes place, the preexisting DQ-based branches will be pulled/modified/rebased
120to get up-to-date with the current state of the codebase, which changed very
121substantially since the last migration effort, especially in the SQL
122classification meta-parsing codepath.
123
d5dedbd6 124=cut
6a247f33 125
126use base qw/
d5dedbd6 127 DBIx::Class::SQLMaker::LimitDialects
6a247f33 128 SQL::Abstract
70c28808 129 DBIx::Class
6a247f33 130/;
131use mro 'c3';
a697fa31 132
70c28808 133use DBIx::Class::Carp;
514b84f6 134use DBIx::Class::_Util 'set_subname';
e8fc51c7 135use namespace::clean;
b2b22cd6 136
6a247f33 137__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
138
111364b3 139sub _quoting_enabled {
140 ( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0
141}
142
3f5b99fe 143# for when I need a normalized l/r pair
144sub _quote_chars {
111364b3 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
3f5b99fe 149 map
150 { defined $_ ? $_ : '' }
151 ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
152 ;
153}
154
70c28808 155# FIXME when we bring in the storage weaklink, check its schema
156# weaklink and channel through $schema->throw_exception
157sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
158
b2b22cd6 159BEGIN {
2ea6032a 160 # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
70c28808 161 # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
b2b22cd6 162 no warnings qw/redefine/;
2ea6032a 163
514b84f6 164 *SQL::Abstract::belch = set_subname 'SQL::Abstract::belch' => sub (@) {
2ea6032a 165 my($func) = (caller(1))[3];
166 carp "[$func] Warning: ", @_;
167 };
168
514b84f6 169 *SQL::Abstract::puke = set_subname 'SQL::Abstract::puke' => sub (@) {
2ea6032a 170 my($func) = (caller(1))[3];
70c28808 171 __PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_));
2ea6032a 172 };
b2b22cd6 173}
6f4ddea1 174
e9657379 175# the "oh noes offset/top without limit" constant
fcb7fcbb 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#
6a247f33 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)
fcb7fcbb 186sub __max_int () { 0x7FFFFFFF };
e9657379 187
1b5ddf23 188# we ne longer need to check this - DBIC has ways of dealing with it
189# specifically ::Storage::DBI::_resolve_bindattrs()
190sub _assert_bindval_matches_bindtype () { 1 };
191
e39f188a 192# poor man's de-qualifier
193sub _quote {
194 $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
195 ? $_[1] =~ / ([^\.]+) $ /x
196 : $_[1]
197 );
198}
199
b1d821de 200sub _where_op_NEST {
70c28808 201 carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
b1d821de 202 .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
70c28808 203 );
b1d821de 204
205 shift->next::method(@_);
206}
207
6a247f33 208# Handle limit-dialect selection
6f4ddea1 209sub select {
6a247f33 210 my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
211
212
ad1d374e 213 ($fields, @{$self->{select_bind}}) = $self->_recurse_fields($fields);
6a247f33 214
215 if (defined $offset) {
70c28808 216 $self->throw_exception('A supplied offset must be a non-negative integer')
f033dcbe 217 if ( $offset =~ /[^0-9]/ or $offset < 0 );
6a247f33 218 }
219 $offset ||= 0;
1cbd3034 220
6a247f33 221 if (defined $limit) {
70c28808 222 $self->throw_exception('A supplied limit must be a positive integer')
f033dcbe 223 if ( $limit =~ /[^0-9]/ or $limit <= 0 );
6a247f33 224 }
225 elsif ($offset) {
226 $limit = $self->__max_int;
6f4ddea1 227 }
c2b7c5dc 228
a6b68a60 229
6a247f33 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
67341081 236 my $limiter;
237
238 if( $limiter = $self->can ('emulate_limit') ) {
239 carp_unique(
240 'Support for the legacy emulate_limit() mechanism inherited from '
07fadea8 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 '
67341081 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 }
6a247f33 256
f74d22e2 257 $sql = $self->$limiter (
258 $sql,
259 { %{$rs_attrs||{}}, _selector_sql => $fields },
260 $limit,
261 $offset
262 );
6a247f33 263 }
264 else {
265 ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
266 }
267
49afd714 268 push @{$self->{where_bind}}, @bind;
583a0c65 269
270# this *must* be called, otherwise extra binds will remain in the sql-maker
49afd714 271 my @all_bind = $self->_assemble_binds;
583a0c65 272
e5372da4 273 $sql .= $self->_lock_select ($rs_attrs->{for})
274 if $rs_attrs->{for};
275
49afd714 276 return wantarray ? ($sql, @all_bind) : $sql;
583a0c65 277}
278
279sub _assemble_binds {
280 my $self = shift;
8b31f62e 281 return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/);
6f4ddea1 282}
283
e5372da4 284my $for_syntax = {
285 update => 'FOR UPDATE',
286 shared => 'FOR SHARE',
287};
288sub _lock_select {
289 my ($self, $type) = @_;
8249c09b 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
e5372da4 299 return " $sql";
300}
301
6a247f33 302# Handle default inserts
6f4ddea1 303sub insert {
6a247f33 304# optimized due to hotttnesss
305# my ($self, $table, $data, $options) = @_;
7a72e5a5 306
07fadea8 307 # FIXME SQLA will emit INSERT INTO $table ( ) VALUES ( )
7a72e5a5 308 # which is sadly understood only by MySQL. Change default behavior here,
07fadea8 309 # until we fold the extra pieces into SQLMaker properly
6a247f33 310 if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) {
bf51641f 311 my @bind;
20595c02 312 my $sql = sprintf(
313 'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
314 );
28d28903 315
bf51641f 316 if ( ($_[3]||{})->{returning} ) {
317 my $s;
318 ($s, @bind) = $_[0]->_insert_returning ($_[3]);
319 $sql .= $s;
28d28903 320 }
321
bf51641f 322 return ($sql, @bind);
7a72e5a5 323 }
324
6a247f33 325 next::method(@_);
6f4ddea1 326}
327
328sub _recurse_fields {
81446c4f 329 my ($self, $fields) = @_;
6f4ddea1 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') {
ad1d374e 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);
83e09b5b 342 }
343 elsif ($ref eq 'HASH') {
81446c4f 344 my %hash = %$fields; # shallow copy
83e09b5b 345
50136dd9 346 my $as = delete $hash{-as}; # if supplied
347
ad1d374e 348 my ($func, $rhs, @toomany) = %hash;
81446c4f 349
350 # there should be only one pair
351 if (@toomany) {
70c28808 352 $self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) );
81446c4f 353 }
50136dd9 354
ad1d374e 355 if (lc ($func) eq 'distinct' && ref $rhs eq 'ARRAY' && @$rhs > 1) {
70c28808 356 $self->throw_exception (
50136dd9 357 'The select => { distinct => ... } syntax is not supported for multiple columns.'
ad1d374e 358 .' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }'
359 .' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }'
83e09b5b 360 );
6f4ddea1 361 }
83e09b5b 362
ad1d374e 363 my ($rhs_sql, @rhs_bind) = $self->_recurse_fields($rhs);
50136dd9 364 my $select = sprintf ('%s( %s )%s',
365 $self->_sqlcase($func),
ad1d374e 366 $rhs_sql,
50136dd9 367 $as
0491b597 368 ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
50136dd9 369 : ''
370 );
371
ad1d374e 372 return ($select, @rhs_bind);
6f4ddea1 373 }
6f4ddea1 374 elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
ad1d374e 375 return @{$$fields};
6f4ddea1 376 }
377 else {
70c28808 378 $self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} );
6f4ddea1 379 }
380}
381
a6b68a60 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
4a0eed52 387# things in the SQLA space need to have more info about the $rs they
a6b68a60 388# create SQL for. The alternative would be to keep expanding the
389# signature of _select with more and more positional parameters, which
07fadea8 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
a6b68a60 394sub _parse_rs_attrs {
1cbd3034 395 my ($self, $arg) = @_;
15827712 396
a6b68a60 397 my $sql = '';
71b788fb 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;
a6b68a60 407 }
1cbd3034 408
71b788fb 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);
a6b68a60 416 }
15827712 417
71b788fb 418 if ($arg->{order_by}) {
419 # unlike the 2 above, _order_by injects into @{...bind...} for us
a6b68a60 420 $sql .= $self->_order_by ($arg->{order_by});
421 }
15827712 422
a6b68a60 423 return $sql;
424}
425
426sub _order_by {
427 my ($self, $arg) = @_;
15827712 428
a6b68a60 429 # check that we are not called in legacy mode (order_by as 4th argument)
71b788fb 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 ;
6f4ddea1 442}
443
cb3e87f5 444sub _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
6f4ddea1 456sub _table {
6a247f33 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') {
4c2b30d6 464 return $_[0]->_recurse_from($_[1]);
6a247f33 465 }
1bffc6b8 466 elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') {
467 my ($sql, @bind) = @{ ${$_[1]} };
468 push @{$_[0]->{from_bind}}, @bind;
469 return $sql
470 }
6f4ddea1 471 }
6a247f33 472 return $_[0]->next::method ($_[1]);
6f4ddea1 473}
474
b8391c87 475sub _generate_join_clause {
476 my ($self, $join_type) = @_;
477
726c8f65 478 $join_type = $self->{_default_jointype}
479 if ! defined $join_type;
480
b8391c87 481 return sprintf ('%s JOIN ',
726c8f65 482 $join_type ? $self->_sqlcase($join_type) : ''
b8391c87 483 );
484}
485
6f4ddea1 486sub _recurse_from {
726c8f65 487 my $self = shift;
726c8f65 488 return join (' ', $self->_gen_from_blocks(@_) );
489}
490
491sub _gen_from_blocks {
492 my ($self, $from, @joins) = @_;
493
494 my @fchunks = $self->_from_chunk_to_sql($from);
6f4ddea1 495
726c8f65 496 for (@joins) {
4c2b30d6 497 my ($to, $on) = @$_;
aa82ce29 498
6f4ddea1 499 # check whether a join type exists
6f4ddea1 500 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
aa82ce29 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;
6f4ddea1 505 }
aa82ce29 506
726c8f65 507 my @j = $self->_generate_join_clause( $join_type );
6f4ddea1 508
509 if (ref $to eq 'ARRAY') {
726c8f65 510 push(@j, '(', $self->_recurse_from(@$to), ')');
511 }
512 else {
513 push(@j, $self->_from_chunk_to_sql($to));
6f4ddea1 514 }
726c8f65 515
a697fa31 516 my ($sql, @bind) = $self->_join_condition($on);
b4e9f590 517 push(@j, ' ON ', $sql);
a697fa31 518 push @{$self->{from_bind}}, @bind;
726c8f65 519
520 push @fchunks, join '', @j;
6f4ddea1 521 }
726c8f65 522
523 return @fchunks;
6f4ddea1 524}
525
4c2b30d6 526sub _from_chunk_to_sql {
527 my ($self, $fromspec) = @_;
528
e8885a53 529 return join (' ', do {
530 if (! ref $fromspec) {
531 $self->_quote($fromspec);
532 }
533 elsif (ref $fromspec eq 'SCALAR') {
4c2b30d6 534 $$fromspec;
e8885a53 535 }
536 elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') {
4c2b30d6 537 push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
538 $$fromspec->[0];
e8885a53 539 }
540 elsif (ref $fromspec eq 'HASH') {
4c2b30d6 541 my ($as, $table, $toomuch) = ( map
542 { $_ => $fromspec->{$_} }
543 ( grep { $_ !~ /^\-/ } keys %$fromspec )
544 );
6f4ddea1 545
70c28808 546 $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
4c2b30d6 547 if defined $toomuch;
6f4ddea1 548
4c2b30d6 549 ($self->_from_chunk_to_sql($table), $self->_quote($as) );
e8885a53 550 }
551 else {
552 $self->throw_exception('Unsupported from refkind: ' . ref $fromspec );
553 }
554 });
6f4ddea1 555}
556
557sub _join_condition {
558 my ($self, $cond) = @_;
4c2b30d6 559
a697fa31 560 # Backcompat for the old days when a plain hashref
561 # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
a697fa31 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 ) {
1efc866d 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 );
a697fa31 577 $cond = { keys %$cond => { -ident => values %$cond } }
6f4ddea1 578 }
a697fa31 579 elsif ( ref $cond eq 'ARRAY' ) {
580 # do our own ORing so that the hashref-shim above is invoked
9aae3566 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;
6f4ddea1 589 }
a697fa31 590
591 return $self->_recurse_where($cond);
6f4ddea1 592}
593
07fadea8 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?
66137dff 602#
603# !!! EXPERIMENTAL API !!! WILL CHANGE !!!
604sub _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] )"
1d1ccc94 642 unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs;
66137dff 643 }
644
645 \[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ];
646}
647
a2bd3796 648=head1 FURTHER QUESTIONS?
d5dedbd6 649
a2bd3796 650Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
d5dedbd6 651
a2bd3796 652=head1 COPYRIGHT AND LICENSE
d5dedbd6 653
a2bd3796 654This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
655by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
656redistribute it and/or modify it under the same terms as the
657L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
d5dedbd6 658
659=cut
a2bd3796 660
6611;