1 package DBIx::Class::SQLMaker::Converter;
3 use Data::Query::Constants qw(DQ_ALIAS DQ_GROUP DQ_WHERE DQ_JOIN DQ_SLICE);
7 extends 'SQL::Abstract::Converter';
9 around _select_to_dq => sub {
10 my ($orig, $self) = (shift, shift);
12 my $orig_dq = $self->$orig(@_);
13 return $orig_dq unless $attrs->{limit};
18 local $SQL::Abstract::Converter::Cur_Col_Meta
19 = { sqlt_datatype => 'integer' };
20 $self->_value_to_dq($attrs->{limit})
24 local $SQL::Abstract::Converter::Cur_Col_Meta
25 = { sqlt_datatype => 'integer' };
26 $self->_value_to_dq($attrs->{offset})
30 ($attrs->{order_is_stable}
31 ? (order_is_stable => 1)
33 ($attrs->{preserve_order}
34 ? (preserve_order => 1)
39 around _select_field_to_dq => sub {
40 my ($orig, $self) = (shift, shift);
44 my %hash = %$field; # shallow copy
46 my $as = delete $hash{-as}; # if supplied
48 my ($func, $args, @toomany) = %hash;
50 # there should be only one pair
52 die( "Malformed select argument - too many keys in hash: " . join (',', keys %$field ) );
55 if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
57 'The select => { distinct => ... } syntax is not supported for multiple columns.'
58 .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
59 .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
66 apply => $self->_ident_to_dq(uc($func)),
67 @{$self->_select_field_list_to_dq($args)},
70 $self->_select_field_to_dq($args);
74 return $field_dq unless $as;
82 return $self->$orig(@_);
86 around _source_to_dq => sub {
87 my ($orig, $self) = (shift, shift);
88 my $attrs = $_[4]; # table, fields, where, order, attrs
89 my $start_dq = $self->$orig(@_);
90 # if we have HAVING but no GROUP BY we render an empty DQ_GROUP
91 # node, which causes DQ to recognise the HAVING as being what it is.
92 # This ... is kinda bull. But that's how HAVING is specified.
93 return $start_dq unless $attrs->{group_by} or $attrs->{having};
94 my $grouped_dq = $self->_group_by_to_dq($attrs->{group_by}||[], $start_dq);
95 return $grouped_dq unless $attrs->{having};
99 where => $self->_where_to_dq($attrs->{having})
103 sub _group_by_to_dq {
104 my ($self, $group, $from) = @_;
107 by => $self->_select_field_list_to_dq($group),
112 around _table_to_dq => sub {
113 my ($orig, $self) = (shift, shift);
115 if (my $ref = ref $spec ) {
116 if ($ref eq 'ARRAY') {
117 return $self->_join_to_dq(@$spec);
119 elsif ($ref eq 'HASH') {
120 my ($as, $table, $toomuch) = ( map
121 { $_ => $spec->{$_} }
122 ( grep { $_ !~ /^\-/ } keys %$spec )
124 die "Only one table/as pair expected in from-spec but an exra '$toomuch' key present"
129 from => $self->_table_to_dq($table),
133 'dbix-class.source_name' => $spec->{-rsrc}->source_name,
134 'dbix-class.join_path' => $spec->{-join_path},
135 'dbix-class.is_single' => $spec->{-is_single},
142 return $self->$orig(@_);
146 my ($self, $from, @joins) = @_;
148 my $cur_dq = $self->_table_to_dq($from);
150 if (!@joins or @joins == 1 and ref($joins[0]) eq 'HASH') {
154 foreach my $join (@joins) {
155 my ($to, $on) = @$join;
157 # check whether a join type exists
158 my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
160 if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
161 $join_type = lc($to_jt->{-join_type});
162 $join_type =~ s/^\s+ | \s+$//xg;
163 undef($join_type) unless $join_type =~ s/^(left|right).*/$1/;
168 ($join_type ? (outer => $join_type) : ()),
170 right => $self->_table_to_dq($to),
172 ? (on => $self->_expr_to_dq($self->_expand_join_condition($on)))
180 sub _expand_join_condition {
181 my ($self, $cond) = @_;
183 # Backcompat for the old days when a plain hashref
184 # { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2
185 # Once things settle we should start warning here so that
186 # folks unroll their hacks
192 (keys %$cond)[0] =~ /\./
194 ! ref ( (values %$cond)[0] )
196 return +{ keys %$cond => { -ident => values %$cond } }
198 elsif ( ref $cond eq 'ARRAY' ) {
199 return [ map $self->_expand_join_condition($_), @$cond ];
205 around _bind_to_dq => sub {
206 my ($orig, $self) = (shift, shift);
208 if ($self->bind_meta) {
209 map { ref($_) eq 'ARRAY' ? $_ : [ {} => $_ ] } @_
214 return $self->$orig(@args);
223 Used to explicitly specify an SQL identifier. Takes a plain string as value
224 which is then invariably treated as a column name (and is being properly
225 quoted if quoting has been requested). Most useful for comparison of two
229 priority => { '<', 2 },
230 requestor => { -ident => 'submitter' }
235 $stmt = 'WHERE "priority" < ? AND "requestor" = "submitter"';
240 The -value operator signals that the argument to the right is a raw bind value.
241 It will be passed straight to DBI, without invoking any of the SQL::Abstract
242 condition-parsing logic. This allows you to, for example, pass an array as a
243 column value for databases that support array datatypes, e.g.:
246 array => { -value => [1, 2, 3] }
251 $stmt = 'WHERE array = ?';
256 See L<DBIx::Class/CONTRIBUTORS>.
260 You may distribute this code under the same terms as Perl itself.