1 package DBIx::Class::SQLMaker;
8 DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
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
18 Currently the enhancements over L<SQL::Abstract> are:
22 =item * Support for C<JOIN> statements (via extended C<table/from> support)
24 =item * Support of functions in C<SELECT> lists
26 =item * C<GROUP BY>/C<HAVING> support (via extensions to the order_by parameter)
28 =item * A rudimentary multicolumn IN operator
30 =item * Support of C<...FOR UPDATE> type of select statement modifiers
36 Some maintainer musings on the current state of SQL generation within DBIC as
39 =head2 Folding of most (or all) of L<SQL::Abstract (SQLA)|SQL::Abstract> into DBIC
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).
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.
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.
58 This work (if undertaken) will take into consideration the following
63 =item Main API compatibility
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).
71 =item Ability to plug back an SQL::Abstract (or derivative)
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.
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.
90 =head2 Relationship to L<Data::Query (DQ)|Data::Query>
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.
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.
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.
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.
127 DBIx::Class::SQLMaker::LimitDialects
133 use DBIx::Class::Carp;
134 use DBIx::Class::_Util 'set_subname';
135 use SQL::Abstract 'is_literal_value';
136 use namespace::clean;
138 __PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
140 sub _quoting_enabled {
141 ( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0
144 # for when I need a normalized l/r pair
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} );
151 { defined $_ ? $_ : '' }
152 ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
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]) }
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/;
165 *SQL::Abstract::belch = set_subname 'SQL::Abstract::belch' => sub (@) {
166 my($func) = (caller(1))[3];
167 carp "[$func] Warning: ", @_;
170 *SQL::Abstract::puke = set_subname 'SQL::Abstract::puke' => sub (@) {
171 my($func) = (caller(1))[3];
172 __PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_));
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)
180 # Also *some* builds of SQLite fail the test
181 # some_column BETWEEN ? AND ?: 1, 4294967295
182 # with the proper integer bind attrs
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 };
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 };
193 # poor man's de-qualifier
195 $_[0]->next::method( ( $_[0]{_dequalify_idents} and defined $_[1] and ! ref $_[1] )
196 ? $_[1] =~ / ([^\.]+) $ /x
202 carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
203 .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
206 shift->next::method(@_);
209 # Handle limit-dialect selection
211 my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
213 ($fields, @{$self->{select_bind}}) = length ref $fields
214 ? $self->_recurse_fields( $fields )
215 : $self->_quote( $fields )
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)
223 # FIXME - some day we need to enable this, but too many things break
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
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()"
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 );
242 if (defined $limit) {
243 $self->throw_exception('A supplied limit must be a positive integer')
244 if ( $limit =~ /[^0-9]/ or $limit <= 0 );
247 $limit = $self->__max_int;
253 # this is legacy code-flow from SQLA::Limit, it is not set in stone
255 ($sql, @bind) = $self->next::method ($table, $fields, $where);
259 if( $limiter = $self->can ('emulate_limit') ) {
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 '
271 my $dialect = $self->limit_dialect
272 or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" );
274 $limiter = $self->can ("_$dialect")
275 or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'");
278 $sql = $self->$limiter (
280 { %{$rs_attrs||{}}, _selector_sql => $fields },
286 ($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);
289 push @{$self->{where_bind}}, @bind;
291 # this *must* be called, otherwise extra binds will remain in the sql-maker
292 my @all_bind = $self->_assemble_binds;
294 $sql .= $self->_lock_select ($rs_attrs->{for})
297 return wantarray ? ($sql, @all_bind) : $sql;
300 sub _assemble_binds {
302 return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/);
306 update => 'FOR UPDATE',
307 shared => 'FOR SHARE',
310 my ($self, $type) = @_;
313 if (ref($type) eq 'SCALAR') {
317 $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" );
323 # Handle default inserts
325 # optimized due to hotttnesss
326 # my ($self, $table, $data, $options) = @_;
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]} ) ) {
334 'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1])
337 if ( ($_[3]||{})->{returning} ) {
339 ($s, @bind) = $_[0]->_insert_returning ($_[3]);
343 return ($sql, @bind);
349 sub _recurse_fields {
350 my ($self, $fields) = @_;
352 if( not length ref $fields ) {
353 return $self->_quote( $fields );
356 elsif( my $lit = is_literal_value( $fields ) ) {
360 elsif( ref $fields eq 'ARRAY' ) {
361 my (@select, @bind, @bind_fragment);
364 ( $select[ $#select + 1 ], @bind_fragment ) = length ref $_
365 ? $self->_recurse_fields( $_ )
366 : $self->_quote( $_ )
368 ( push @bind, @bind_fragment )
371 return (join(', ', @select), @bind);
374 # FIXME - really crappy handling of functions
375 elsif ( ref $fields eq 'HASH') {
376 my %hash = %$fields; # shallow copy
378 my $as = delete $hash{-as}; # if supplied
380 my ($func, $rhs, @toomany) = %hash;
382 # there should be only one pair
383 $self->throw_exception(
384 "Malformed select argument - too many keys in hash: " . join (',', keys %$fields )
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 }'
392 lc ($func) eq 'distinct'
399 my ($rhs_sql, @rhs_bind) = length ref $rhs
400 ? $self->_recurse_fields($rhs)
401 : $self->_quote($rhs)
405 sprintf( '%s( %s )%s',
406 $self->_sqlcase($func),
409 ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
417 $self->throw_exception( ref($fields) . ' unexpected in _recurse_fields()' );
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
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) = @_;
442 @sqlbind = $self->_recurse_fields($arg->{group_by})
444 $sql .= $self->_sqlcase(' group by ') . shift @sqlbind;
445 push @{$self->{group_bind}}, @sqlbind;
451 @sqlbind = $self->_recurse_where($arg->{having})
453 $sql .= $self->_sqlcase(' having ') . shift @sqlbind;
454 push(@{$self->{having_bind}}, @sqlbind);
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});
466 my ($self, $arg) = @_;
468 # check that we are not called in legacy mode (order_by as 4th argument)
472 not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg
474 ? $self->_parse_rs_attrs ($arg)
476 my ($sql, @bind) = $self->next::method($arg);
477 push @{$self->{order_bind}}, @bind;
483 sub _split_order_chunk {
484 my ($self, $chunk) = @_;
486 # strip off sort modifiers, but always succeed, so $1 gets reset
487 $chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix;
491 ( $1 and uc($1) eq 'DESC' ) ? 1 : 0,
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]});
502 elsif ($ref eq 'HASH') {
503 return $_[0]->_recurse_from($_[1]);
505 elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') {
506 my ($sql, @bind) = @{ ${$_[1]} };
507 push @{$_[0]->{from_bind}}, @bind;
511 return $_[0]->next::method ($_[1]);
514 sub _generate_join_clause {
515 my ($self, $join_type) = @_;
517 $join_type = $self->{_default_jointype}
518 if ! defined $join_type;
520 return sprintf ('%s JOIN ',
521 $join_type ? $self->_sqlcase($join_type) : ''
527 return join (' ', $self->_gen_from_blocks(@_) );
530 sub _gen_from_blocks {
531 my ($self, $from, @joins) = @_;
533 my @fchunks = $self->_from_chunk_to_sql($from);
538 # check whether a join type exists
539 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
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;
546 my @j = $self->_generate_join_clause( $join_type );
548 if (ref $to eq 'ARRAY') {
549 push(@j, '(', $self->_recurse_from(@$to), ')');
552 push(@j, $self->_from_chunk_to_sql($to));
555 my ($sql, @bind) = $self->_join_condition($on);
556 push(@j, ' ON ', $sql);
557 push @{$self->{from_bind}}, @bind;
559 push @fchunks, join '', @j;
565 sub _from_chunk_to_sql {
566 my ($self, $fromspec) = @_;
568 return join (' ', do {
569 if (! ref $fromspec) {
570 $self->_quote($fromspec);
572 elsif (ref $fromspec eq 'SCALAR') {
575 elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') {
576 push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
579 elsif (ref $fromspec eq 'HASH') {
580 my ($as, $table, $toomuch) = ( map
581 { $_ => $fromspec->{$_} }
582 ( grep { $_ !~ /^\-/ } keys %$fromspec )
585 $self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" )
588 ($self->_from_chunk_to_sql($table), $self->_quote($as) );
591 $self->throw_exception('Unsupported from refkind: ' . ref $fromspec );
596 sub _join_condition {
597 my ($self, $cond) = @_;
599 # Backcompat for the old days when a plain hashref
600 # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
606 (keys %$cond)[0] =~ /\./
608 ! ref ( (values %$cond)[0] )
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"
616 $cond = { keys %$cond => { -ident => values %$cond } }
618 elsif ( ref $cond eq 'ARRAY' ) {
619 # do our own ORing so that the hashref-shim above is invoked
622 foreach my $c (@$cond) {
623 my ($sql, @bind) = $self->_join_condition($c);
627 return join(' OR ', @parts), @binds;
630 return $self->_recurse_where($cond);
633 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
635 # This is rather odd, but vanilla SQLA does not have support for multicolumn IN
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?
642 # !!! EXPERIMENTAL API !!! WILL CHANGE !!!
643 sub _where_op_multicolumn_in {
644 my ($self, $lhs, $rhs) = @_;
646 if (! ref $lhs or ref $lhs eq 'ARRAY') {
648 for (ref $lhs ? @$lhs : $lhs) {
650 push @sql, $self->_quote($_);
652 elsif (ref $_ eq 'SCALAR') {
655 elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') {
661 $self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs...");
664 $lhs = \[ join(', ', @sql), @bind];
666 elsif (ref $lhs eq 'SCALAR') {
669 elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) {
673 $self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs...");
677 $rhs = \[ $self->_recurse_where($rhs) ];
680 $$_->[0] = "( $$_->[0] )"
681 unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs;
684 \[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ];
687 =head1 FURTHER QUESTIONS?
689 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
691 =head1 COPYRIGHT AND LICENSE
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>.