Commit | Line | Data |
8f306bb1 |
1 | package SQL::Abstract::Clauses; |
2 | |
3 | use strict; |
4 | use warnings; |
740af2e0 |
5 | use if $] < '5.010', 'MRO::Compat'; |
8f306bb1 |
6 | use mro 'c3'; |
7 | use base 'SQL::Abstract'; |
8 | |
d5f4b9d3 |
9 | BEGIN { *puke = \&SQL::Abstract::puke } |
10 | |
8f306bb1 |
11 | sub new { |
12 | shift->next::method(@_)->register_defaults |
13 | } |
14 | |
15 | sub register_defaults { |
16 | my ($self) = @_; |
17 | $self->{clauses_of}{select} = [ qw(select from where order_by) ]; |
18 | $self->{expand}{select} = sub { shift->_expand_statement(@_) }; |
25b45941 |
19 | $self->{render}{select} = sub { shift->_render_statement(select => @_) }; |
8cad5d13 |
20 | $self->{expand_clause}{"select.$_"} = "_expand_select_clause_$_" |
21 | for @{$self->{clauses_of}{select}}; |
45a145cf |
22 | $self->{clauses_of}{update} = [ qw(target set where returning) ]; |
d5f4b9d3 |
23 | $self->{expand}{update} = sub { shift->_expand_statement(@_) }; |
24 | $self->{render}{update} = sub { shift->_render_statement(update => @_) }; |
4c0c4404 |
25 | $self->{expand_clause}{"update.$_"} = "_expand_update_clause_$_" |
26 | for @{$self->{clauses_of}{update}}; |
45a145cf |
27 | $self->{expand_clause}{'update.update'} = '_expand_update_clause_target'; |
28 | $self->{render_clause}{'update.target'} = sub { |
29 | my ($self, $target) = @_; |
30 | my ($sql, @bind) = $self->render_aqt($target); |
31 | ($self->_sqlcase('update ').$sql, @bind); |
32 | }; |
33 | $self->{clauses_of}{delete} = [ qw(target where returning) ]; |
be12624c |
34 | $self->{expand}{delete} = sub { shift->_expand_statement(@_) }; |
35 | $self->{render}{delete} = sub { shift->_render_statement(delete => @_) }; |
bc637c4f |
36 | $self->{expand_clause}{"delete.$_"} = "_expand_delete_clause_$_" |
37 | for @{$self->{clauses_of}{delete}}; |
45a145cf |
38 | $self->{expand_clause}{"delete.from"} = '_expand_delete_clause_target'; |
39 | $self->{render_clause}{'delete.target'} = sub { |
40 | my ($self, $from) = @_; |
41 | my ($sql, @bind) = $self->render_aqt($from); |
42 | ($self->_sqlcase('delete from ').$sql, @bind); |
43 | }; |
6a47389f |
44 | $self->{clauses_of}{insert} = [ |
bea59460 |
45 | 'target', 'fields', 'from', 'returning' |
6a47389f |
46 | ]; |
5ed4a77e |
47 | $self->{expand}{insert} = sub { shift->_expand_statement(@_) }; |
48 | $self->{render}{insert} = sub { shift->_render_statement(insert => @_) }; |
45a145cf |
49 | $self->{expand_clause}{'insert.into'} = '_expand_insert_clause_target'; |
50 | $self->{expand_clause}{'insert.target'} = '_expand_insert_clause_target'; |
73f1883a |
51 | $self->{expand_clause}{'insert.fields'} = sub { |
52 | return +{ -row => [ |
53 | shift->_expand_maybe_list_expr(@_, -ident) |
54 | ] } if ref($_[1]) eq 'ARRAY'; |
55 | return $_[1]; # should maybe still expand somewhat? |
56 | }; |
89bbac1d |
57 | $self->{expand_clause}{'insert.values'} = '_expand_insert_clause_values'; |
5ed4a77e |
58 | $self->{expand_clause}{'insert.returning'} = sub { |
59 | shift->_expand_maybe_list_expr(@_, -ident); |
60 | }; |
6a47389f |
61 | $self->{render_clause}{'insert.fields'} = sub { |
4e38e5fb |
62 | return $_[0]->render_aqt($_[1]); |
6a47389f |
63 | }; |
45a145cf |
64 | $self->{render_clause}{'insert.target'} = sub { |
65 | my ($self, $from) = @_; |
66 | my ($sql, @bind) = $self->render_aqt($from); |
67 | ($self->_sqlcase('insert into ').$sql, @bind); |
68 | }; |
bea59460 |
69 | $self->{render_clause}{'insert.from'} = sub { |
6da32de8 |
70 | return $_[0]->render_aqt($_[1]); |
71 | }; |
8f306bb1 |
72 | return $self; |
73 | } |
74 | |
8cad5d13 |
75 | sub _expand_select_clause_select { |
76 | my ($self, $select) = @_; |
77 | +(select => $self->_expand_maybe_list_expr($select, -ident)); |
78 | } |
79 | |
80 | sub _expand_select_clause_from { |
81 | my ($self, $from) = @_; |
82 | +(from => $self->_expand_maybe_list_expr($from, -ident)); |
83 | } |
84 | |
85 | sub _expand_select_clause_where { |
86 | my ($self, $where) = @_; |
87 | +(where => $self->expand_expr($where)); |
88 | } |
89 | |
90 | sub _expand_select_clause_order_by { |
91 | my ($self, $order_by) = @_; |
92 | +(order_by => $self->_expand_order_by($order_by)); |
93 | } |
94 | |
45a145cf |
95 | sub _expand_update_clause_target { |
4c0c4404 |
96 | my ($self, $target) = @_; |
0891ae97 |
97 | +(target => $self->_expand_maybe_list_expr($target, -ident)); |
4c0c4404 |
98 | } |
99 | |
100 | sub _expand_update_clause_set { |
e5d02bc7 |
101 | return $_[1] if ref($_[1]) eq 'HASH' and ($_[1]->{-op}||[''])->[0] eq ','; |
4c0c4404 |
102 | +(set => shift->_expand_update_set_values(@_)); |
103 | } |
104 | |
105 | sub _expand_update_clause_where { |
106 | +(where => shift->expand_expr(@_)); |
107 | } |
108 | |
109 | sub _expand_update_clause_returning { |
110 | +(returning => shift->_expand_maybe_list_expr(@_, -ident)); |
111 | } |
112 | |
45a145cf |
113 | sub _expand_delete_clause_target { |
114 | +(target => shift->_expand_maybe_list_expr(@_, -ident)); |
bc637c4f |
115 | } |
116 | |
117 | sub _expand_delete_clause_where { +(where => shift->expand_expr(@_)); } |
118 | |
119 | sub _expand_delete_clause_returning { |
120 | +(returning => shift->_expand_maybe_list_expr(@_, -ident)); |
121 | } |
122 | |
8f306bb1 |
123 | sub _expand_statement { |
124 | my ($self, $type, $args) = @_; |
125 | my $ec = $self->{expand_clause}; |
25b45941 |
126 | return +{ "-${type}" => +{ |
95894429 |
127 | map { |
8f306bb1 |
128 | my $val = $args->{$_}; |
129 | if (defined($val) and my $exp = $ec->{"${type}.$_"}) { |
95894429 |
130 | if ((my (@exp) = $self->$exp($val)) == 1) { |
131 | ($_ => $exp[0]) |
132 | } else { |
133 | @exp |
134 | } |
8f306bb1 |
135 | } else { |
bea59460 |
136 | ($_ => $self->expand_expr($val)) |
8f306bb1 |
137 | } |
95894429 |
138 | } sort keys %$args |
25b45941 |
139 | } }; |
8f306bb1 |
140 | } |
141 | |
142 | sub _render_statement { |
143 | my ($self, $type, $args) = @_; |
144 | my @parts; |
145 | foreach my $clause (@{$self->{clauses_of}{$type}}) { |
146 | next unless my $clause_expr = $args->{$clause}; |
b96fbdc0 |
147 | local $self->{convert_where} = $self->{convert} if $clause eq 'where'; |
6a47389f |
148 | my ($sql) = my @part = do { |
149 | if (my $rdr = $self->{render_clause}{"${type}.${clause}"}) { |
150 | $self->$rdr($clause_expr); |
151 | } else { |
152 | my ($clause_sql, @bind) = $self->render_aqt($clause_expr); |
153 | my $sql = join ' ', |
154 | $self->_sqlcase(join ' ', split '_', $clause), |
155 | $clause_sql; |
156 | ($sql, @bind); |
157 | } |
158 | }; |
8f306bb1 |
159 | next unless defined($sql) and length($sql); |
6a47389f |
160 | push @parts, \@part; |
8f306bb1 |
161 | } |
162 | return $self->_join_parts(' ', @parts); |
163 | } |
164 | |
b96fbdc0 |
165 | sub select { |
166 | my ($self, @args) = @_; |
73f1883a |
167 | |
168 | return $self->render_expr({ -select => $_[1] }) if ref($_[1]) eq 'HASH'; |
169 | |
b96fbdc0 |
170 | my %clauses; |
171 | @clauses{qw(from select where order_by)} = @args; |
0c3c4c23 |
172 | |
b96fbdc0 |
173 | # This oddity is to literalify since historically SQLA doesn't quote |
0c3c4c23 |
174 | # a single identifier argument, so we convert it into a literal |
175 | |
91d37de5 |
176 | $clauses{select} = { -literal => [ $clauses{select}||'*' ] } |
177 | unless ref($clauses{select}); |
178 | |
73f1883a |
179 | return $self->render_expr({ -select => \%clauses }); |
b96fbdc0 |
180 | } |
181 | |
d5f4b9d3 |
182 | sub update { |
183 | my ($self, $table, $set, $where, $options) = @_; |
73f1883a |
184 | |
185 | return $self->render_expr({ -update => $_[1] }) if ref($_[1]) eq 'HASH'; |
186 | |
d5f4b9d3 |
187 | my %clauses; |
45a145cf |
188 | @clauses{qw(target set where)} = ($table, $set, $where); |
d5f4b9d3 |
189 | puke "Unsupported data type specified to \$sql->update" |
190 | unless ref($clauses{set}) eq 'HASH'; |
191 | @clauses{keys %$options} = values %$options; |
73f1883a |
192 | return $self->render_expr({ -update => \%clauses }); |
d5f4b9d3 |
193 | } |
194 | |
be12624c |
195 | sub delete { |
196 | my ($self, $table, $where, $options) = @_; |
73f1883a |
197 | |
198 | return $self->render_expr({ -delete => $_[1] }) if ref($_[1]) eq 'HASH'; |
199 | |
45a145cf |
200 | my %clauses = (target => $table, where => $where, %{$options||{}}); |
73f1883a |
201 | return $self->render_expr({ -delete => \%clauses }); |
be12624c |
202 | } |
203 | |
5ed4a77e |
204 | sub insert { |
205 | my ($self, $table, $data, $options) = @_; |
73f1883a |
206 | |
207 | return $self->render_expr({ -insert => $_[1] }) if ref($_[1]) eq 'HASH'; |
208 | |
45a145cf |
209 | my %clauses = (target => $table, values => $data, %{$options||{}}); |
73f1883a |
210 | return $self->render_expr({ -insert => \%clauses }); |
5ed4a77e |
211 | } |
212 | |
45a145cf |
213 | sub _expand_insert_clause_target { |
214 | +(target => shift->_expand_maybe_list_expr(@_, -ident)); |
215 | } |
216 | |
89bbac1d |
217 | sub _expand_insert_clause_values { |
218 | my ($self, $data) = @_; |
6da32de8 |
219 | if (ref($data) eq 'HASH' and (keys(%$data))[0] =~ /^-/) { |
220 | return $self->expand_expr($data); |
221 | } |
e5d02bc7 |
222 | return $data if ref($data) eq 'HASH' and $data->{-row}; |
89bbac1d |
223 | my ($f_aqt, $v_aqt) = $self->_expand_insert_values($data); |
bea59460 |
224 | return (from => { -values => $v_aqt }, ($f_aqt ? (fields => $f_aqt) : ())); |
89bbac1d |
225 | } |
226 | |
8f306bb1 |
227 | 1; |