1 package DBIx::Class::SQLMaker;
8 DBIx::Class::SQLMaker - An SQL::Abstract-based SQL maker class
12 This module is a subclass of L<SQL::Abstract> and includes a number of
13 DBIC-specific workarounds, not yet 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 to 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 * Support of C<...FOR UPDATE> type of select statement modifiers
30 =item * The L</-ident> operator
32 =item * The L</-value> operator
40 DBIx::Class::SQLMaker::LimitDialects
44 use Module::Runtime qw(use_module);
45 use Sub::Name 'subname';
46 use DBIx::Class::Carp;
47 use DBIx::Class::Exception;
51 has limit_dialect => (
52 is => 'rw', default => sub { 'LimitOffset' },
53 trigger => sub { shift->clear_renderer_class }
56 our %LIMIT_DIALECT_MAP = (
57 'GenericSubQ' => 'GenericSubquery',
60 sub mapped_limit_dialect {
62 my $unmapped = $self->limit_dialect;
63 $LIMIT_DIALECT_MAP{$unmapped}||$unmapped;
66 around _build_renderer_roles => sub {
67 my ($orig, $self) = (shift, shift);
70 'Data::Query::Renderer::SQL::Slice::'.$self->mapped_limit_dialect
74 # for when I need a normalized l/r pair
77 { defined $_ ? $_ : '' }
78 ( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) )
82 sub _build_converter_class {
83 Module::Runtime::use_module('DBIx::Class::SQLMaker::Converter')
86 # FIXME when we bring in the storage weaklink, check its schema
87 # weaklink and channel through $schema->throw_exception
88 sub throw_exception { DBIx::Class::Exception->throw($_[1]) }
91 # reinstall the belch()/puke() functions of SQL::Abstract with custom versions
92 # that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp
93 no warnings qw/redefine/;
95 *SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) {
96 my($func) = (caller(1))[3];
97 carp "[$func] Warning: ", @_;
100 *SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) {
101 my($func) = (caller(1))[3];
102 __PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_));
105 # Current SQLA pollutes its namespace - clean for the time being
106 namespace::clean->clean_subroutines(qw/SQL::Abstract carp croak confess/);
109 # the "oh noes offset/top without limit" constant
110 # limited to 31 bits for sanity (and consistency,
111 # since it may be handed to the like of sprintf %u)
113 # Also *some* builds of SQLite fail the test
114 # some_column BETWEEN ? AND ?: 1, 4294967295
115 # with the proper integer bind attrs
117 # Implemented as a method, since ::Storage::DBI also
118 # refers to it (i.e. for the case of software_limit or
119 # as the value to abuse with MSSQL ordered subqueries)
120 sub __max_int () { 0x7FFFFFFF };
122 # poor man's de-qualifier
124 $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
125 ? $_[1] =~ / ([^\.]+) $ /x
131 carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n"
132 .q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }|
135 shift->next::method(@_);
138 # Handle limit-dialect selection
140 my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
142 if (defined $offset) {
143 $self->throw_exception('A supplied offset must be a non-negative integer')
144 if ( $offset =~ /\D/ or $offset < 0 );
148 if (defined $limit) {
149 $self->throw_exception('A supplied limit must be a positive integer')
150 if ( $limit =~ /\D/ or $limit <= 0 );
153 $limit = $self->__max_int;
156 my %final_attrs = (%{$rs_attrs||{}}, limit => $limit, offset => $offset);
158 if ($limit or $offset) {
159 my %slice_stability = $self->renderer->slice_stability;
161 if (my $stability = $slice_stability{$offset ? 'offset' : 'limit'}) {
162 my $source = $rs_attrs->{_rsroot_rsrc};
164 $final_attrs{order_is_stable}
165 = $final_attrs{preserve_order}
166 = $source->schema->storage
167 ->_order_by_is_stable(
168 @final_attrs{qw(from order_by where)}
171 if ($stability eq 'requires') {
172 if ($self->converter->_order_by_to_dq($final_attrs{order_by})) {
173 $self->throw_exception(
174 $self->limit_dialect.' limit/offset implementation requires a stable order for offset'
177 if (my $ident_cols = $source->_identifying_column_set) {
178 $final_attrs{order_by} = [
179 map "$final_attrs{alias}.$_", @$ident_cols
181 $final_attrs{order_is_stable} = 1;
183 $self->throw_exception(sprintf(
184 'Unable to auto-construct stable order criteria for "skimming type"
186 . "dialect based on source '%s'", $source->name) );
193 my %slice_subquery = $self->renderer->slice_subquery;
195 if (my $subquery = $slice_subquery{$offset ? 'offset' : 'limit'}) {
197 my $f = $fields->[$_];
199 $f = { '' => $f } unless ref($f) eq 'HASH';
200 ($f->{-as} ||= $final_attrs{as}[$_]) =~ s/\Q${\$self->name_sep}/__/g;
201 } elsif ($f !~ /^\Q$final_attrs{alias}${\$self->name_sep}/) {
203 ($f->{-as} ||= $final_attrs{as}[$_]) =~ s/\Q${\$self->name_sep}/__/g;
210 my ($sql, @bind) = $self->next::method ($table, $fields, $where, $final_attrs{order_by}, \%final_attrs );
212 $sql .= $self->_lock_select ($rs_attrs->{for})
215 return wantarray ? ($sql, @bind) : $sql;
218 sub _assemble_binds {
220 return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/);
224 update => 'FOR UPDATE',
225 shared => 'FOR SHARE',
228 my ($self, $type) = @_;
231 if (ref($type) eq 'SCALAR') {
235 $sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FO
236 R type '$type' requested" );
243 scalar shift->_render_sqla(table => \@_);
252 Used to explicitly specify an SQL identifier. Takes a plain string as value
253 which is then invariably treated as a column name (and is being properly
254 quoted if quoting has been requested). Most useful for comparison of two
258 priority => { '<', 2 },
259 requestor => { -ident => 'submitter' }
264 $stmt = 'WHERE "priority" < ? AND "requestor" = "submitter"';
269 The -value operator signals that the argument to the right is a raw bind value.
270 It will be passed straight to DBI, without invoking any of the SQL::Abstract
271 condition-parsing logic. This allows you to, for example, pass an array as a
272 column value for databases that support array datatypes, e.g.:
275 array => { -value => [1, 2, 3] }
280 $stmt = 'WHERE array = ?';
285 See L<DBIx::Class/CONTRIBUTORS>.
289 You may distribute this code under the same terms as Perl itself.