support)
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=item * Support of functions in C |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=item * C/C support (via extensions to the order_by parameter) |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=item * A rudimentary multicolumn IN operator |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=item * Support of C<...FOR UPDATE> type of select statement modifiers |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=back |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 ROADMAP |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Some maintainer musings on the current state of SQL generation within DBIC as |
|
37
|
|
|
|
|
|
|
of Oct 2015 |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head2 Folding of most (or all) of L into DBIC |
|
40
|
|
|
|
|
|
|
|
|
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). |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Given that SQLA has a B distinct life on its own, and is used within an |
|
48
|
|
|
|
|
|
|
order of magnitude more projects compared to DBIC, it is prudent to B |
|
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
|
|
52
|
|
|
|
|
|
|
longer depend on SQLA> at all. |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
B 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 namespace. |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
This work (if undertaken) will take into consideration the following |
|
59
|
|
|
|
|
|
|
constraints: |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=over |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=item Main API compatibility |
|
64
|
|
|
|
|
|
|
|
|
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 or L |
|
68
|
|
|
|
|
|
|
or even worse L will definitely remain |
|
69
|
|
|
|
|
|
|
unsupported, the rest of the tests should pass (within reason). |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item Ability to plug back an SQL::Abstract (or derivative) |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
During the initial work on L 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 from regressions in the future. |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
|
85
|
|
|
|
|
|
|
|
|
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. |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 Relationship to L |
|
91
|
|
|
|
|
|
|
|
|
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 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. |
|
102
|
|
|
|
|
|
|
|
|
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. |
|
108
|
|
|
|
|
|
|
|
|
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. |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
In the short term, after one more pass over the ResultSet internals is |
|
118
|
|
|
|
|
|
|
undertaken I, 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. |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |
|
125
|
|
|
|
|
|
|
|
|
126
|
220
|
|
|
|
|
87267
|
use base qw/ |
|
127
|
|
|
|
|
|
|
DBIx::Class::SQLMaker::LimitDialects |
|
128
|
|
|
|
|
|
|
SQL::Abstract |
|
129
|
|
|
|
|
|
|
DBIx::Class |
|
130
|
220
|
|
|
220
|
|
1216
|
/; |
|
|
220
|
|
|
|
|
479
|
|
|
131
|
220
|
|
|
220
|
|
9669
|
use mro 'c3'; |
|
|
220
|
|
|
|
|
503
|
|
|
|
220
|
|
|
|
|
1778
|
|
|
132
|
|
|
|
|
|
|
|
|
133
|
220
|
|
|
220
|
|
7200
|
use DBIx::Class::Carp; |
|
|
220
|
|
|
|
|
540
|
|
|
|
220
|
|
|
|
|
1906
|
|
|
134
|
220
|
|
|
220
|
|
1422
|
use DBIx::Class::_Util 'set_subname'; |
|
|
220
|
|
|
|
|
529
|
|
|
|
220
|
|
|
|
|
13083
|
|
|
135
|
220
|
|
|
220
|
|
1381
|
use SQL::Abstract 'is_literal_value'; |
|
|
220
|
|
|
|
|
541
|
|
|
|
220
|
|
|
|
|
8855
|
|
|
136
|
220
|
|
|
220
|
|
1401
|
use namespace::clean; |
|
|
220
|
|
|
|
|
494
|
|
|
|
220
|
|
|
|
|
1902
|
|
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/); |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _quoting_enabled { |
|
141
|
0
|
0
|
0
|
0
|
|
0
|
( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0 |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# for when I need a normalized l/r pair |
|
145
|
|
|
|
|
|
|
sub _quote_chars { |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# in case we are called in the old !!$sm->_quote_chars fashion |
|
148
|
2003
|
0
|
0
|
2003
|
|
6195
|
return () if !wantarray and ( ! defined $_[0]->{quote_char} or ! length $_[0]->{quote_char} ); |
|
|
|
|
33
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
map |
|
151
|
4006
|
100
|
|
|
|
15143
|
{ defined $_ ? $_ : '' } |
|
152
|
2003
|
100
|
|
|
|
10780
|
( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) ) |
|
|
1019
|
|
|
|
|
3685
|
|
|
153
|
|
|
|
|
|
|
; |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# FIXME when we bring in the storage weaklink, check its schema |
|
157
|
|
|
|
|
|
|
# weaklink and channel through $schema->throw_exception |
|
158
|
150
|
|
|
150
|
0
|
614
|
sub throw_exception { DBIx::Class::Exception->throw($_[1]) } |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
BEGIN { |
|
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
|
220
|
|
|
220
|
|
97747
|
no warnings qw/redefine/; |
|
|
220
|
|
|
|
|
602
|
|
|
|
220
|
|
|
|
|
36589
|
|
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
*SQL::Abstract::belch = set_subname 'SQL::Abstract::belch' => sub (@) { |
|
166
|
60
|
|
|
60
|
|
81091
|
my($func) = (caller(1))[3]; |
|
167
|
60
|
|
|
|
|
1519
|
carp "[$func] Warning: ", @_; |
|
168
|
220
|
|
|
220
|
|
2314
|
}; |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
*SQL::Abstract::puke = set_subname 'SQL::Abstract::puke' => sub (@) { |
|
171
|
149
|
|
|
149
|
|
37992
|
my($func) = (caller(1))[3]; |
|
172
|
149
|
|
|
|
|
6765
|
__PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_)); |
|
173
|
220
|
|
|
|
|
1483
|
}; |
|
174
|
|
|
|
|
|
|
} |
|
175
|
|
|
|
|
|
|
|
|
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) |
|
179
|
|
|
|
|
|
|
# |
|
180
|
|
|
|
|
|
|
# Also *some* builds of SQLite fail the test |
|
181
|
|
|
|
|
|
|
# some_column BETWEEN ? AND ?: 1, 4294967295 |
|
182
|
|
|
|
|
|
|
# with the proper integer bind attrs |
|
183
|
|
|
|
|
|
|
# |
|
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 }; |
|
188
|
|
|
|
|
|
|
|
|
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 }; |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# poor man's de-qualifier |
|
194
|
|
|
|
|
|
|
sub _quote { |
|
195
|
140401
|
100
|
66
|
140401
|
|
12970354
|
$_[0]->next::method( ( $_[0]{_dequalify_idents} and defined $_[1] and ! ref $_[1] ) |
|
196
|
|
|
|
|
|
|
? $_[1] =~ / ([^\.]+) $ /x |
|
197
|
|
|
|
|
|
|
: $_[1] |
|
198
|
|
|
|
|
|
|
); |
|
199
|
|
|
|
|
|
|
} |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _where_op_NEST { |
|
202
|
2
|
|
|
2
|
|
344
|
carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n" |
|
203
|
|
|
|
|
|
|
.q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }| |
|
204
|
|
|
|
|
|
|
); |
|
205
|
|
|
|
|
|
|
|
|
206
|
2
|
|
|
|
|
76
|
shift->next::method(@_); |
|
207
|
|
|
|
|
|
|
} |
|
208
|
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Handle limit-dialect selection |
|
210
|
|
|
|
|
|
|
sub select { |
|
211
|
7951
|
|
|
7951
|
1
|
103041
|
my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_; |
|
212
|
|
|
|
|
|
|
|
|
213
|
7951
|
100
|
|
|
|
43670
|
($fields, @{$self->{select_bind}}) = length ref $fields |
|
|
7950
|
|
|
|
|
33519
|
|
|
214
|
|
|
|
|
|
|
? $self->_recurse_fields( $fields ) |
|
215
|
|
|
|
|
|
|
: $self->_quote( $fields ) |
|
216
|
|
|
|
|
|
|
; |
|
217
|
|
|
|
|
|
|
|
|
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) |
|
221
|
7950
|
100
|
|
|
|
28173
|
not length $fields |
|
222
|
|
|
|
|
|
|
and |
|
223
|
|
|
|
|
|
|
# FIXME - some day we need to enable this, but too many things break |
|
224
|
|
|
|
|
|
|
# ( notably S::L ) |
|
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 |
|
228
|
|
|
|
|
|
|
# $fields = 42 |
|
229
|
|
|
|
|
|
|
# and |
|
230
|
|
|
|
|
|
|
carp_unique ( |
|
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()" |
|
234
|
|
|
|
|
|
|
); |
|
235
|
|
|
|
|
|
|
|
|
236
|
7950
|
100
|
|
|
|
26303
|
if (defined $offset) { |
|
237
|
133
|
50
|
33
|
|
|
837
|
$self->throw_exception('A supplied offset must be a non-negative integer') |
|
238
|
|
|
|
|
|
|
if ( $offset =~ /[^0-9]/ or $offset < 0 ); |
|
239
|
|
|
|
|
|
|
} |
|
240
|
7950
|
|
100
|
|
|
38423
|
$offset ||= 0; |
|
241
|
|
|
|
|
|
|
|
|
242
|
7950
|
100
|
|
|
|
28192
|
if (defined $limit) { |
|
|
|
50
|
|
|
|
|
|
|
243
|
1716
|
50
|
33
|
|
|
11455
|
$self->throw_exception('A supplied limit must be a positive integer') |
|
244
|
|
|
|
|
|
|
if ( $limit =~ /[^0-9]/ or $limit <= 0 ); |
|
245
|
|
|
|
|
|
|
} |
|
246
|
|
|
|
|
|
|
elsif ($offset) { |
|
247
|
0
|
|
|
|
|
0
|
$limit = $self->__max_int; |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
|
251
|
7950
|
|
|
|
|
17362
|
my ($sql, @bind); |
|
252
|
7950
|
100
|
|
|
|
18874
|
if ($limit) { |
|
253
|
|
|
|
|
|
|
# this is legacy code-flow from SQLA::Limit, it is not set in stone |
|
254
|
|
|
|
|
|
|
|
|
255
|
1716
|
|
|
|
|
6469
|
($sql, @bind) = $self->next::method ($table, $fields, $where); |
|
256
|
|
|
|
|
|
|
|
|
257
|
1716
|
|
|
|
|
209978
|
my $limiter; |
|
258
|
|
|
|
|
|
|
|
|
259
|
1716
|
100
|
|
|
|
10215
|
if( $limiter = $self->can ('emulate_limit') ) { |
|
260
|
1
|
|
|
|
|
5
|
carp_unique( |
|
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 ' |
|
267
|
|
|
|
|
|
|
. 'can be devised' |
|
268
|
|
|
|
|
|
|
); |
|
269
|
|
|
|
|
|
|
} |
|
270
|
|
|
|
|
|
|
else { |
|
271
|
1715
|
50
|
|
|
|
10274
|
my $dialect = $self->limit_dialect |
|
272
|
|
|
|
|
|
|
or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" ); |
|
273
|
|
|
|
|
|
|
|
|
274
|
1715
|
50
|
|
|
|
26952
|
$limiter = $self->can ("_$dialect") |
|
275
|
|
|
|
|
|
|
or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); |
|
276
|
|
|
|
|
|
|
} |
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
$sql = $self->$limiter ( |
|
279
|
|
|
|
|
|
|
$sql, |
|
280
|
1716
|
50
|
|
|
|
5298
|
{ %{$rs_attrs||{}}, _selector_sql => $fields }, |
|
|
1716
|
|
|
|
|
25011
|
|
|
281
|
|
|
|
|
|
|
$limit, |
|
282
|
|
|
|
|
|
|
$offset |
|
283
|
|
|
|
|
|
|
); |
|
284
|
|
|
|
|
|
|
} |
|
285
|
|
|
|
|
|
|
else { |
|
286
|
6234
|
|
|
|
|
27410
|
($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs); |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
|
|
289
|
7947
|
|
|
|
|
165134
|
push @{$self->{where_bind}}, @bind; |
|
|
7947
|
|
|
|
|
28400
|
|
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# this *must* be called, otherwise extra binds will remain in the sql-maker |
|
292
|
7947
|
|
|
|
|
29363
|
my @all_bind = $self->_assemble_binds; |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
$sql .= $self->_lock_select ($rs_attrs->{for}) |
|
295
|
7947
|
100
|
|
|
|
32858
|
if $rs_attrs->{for}; |
|
296
|
|
|
|
|
|
|
|
|
297
|
7947
|
50
|
|
|
|
47359
|
return wantarray ? ($sql, @all_bind) : $sql; |
|
298
|
|
|
|
|
|
|
} |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub _assemble_binds { |
|
301
|
7947
|
|
|
7947
|
|
16275
|
my $self = shift; |
|
302
|
7947
|
100
|
|
|
|
21139
|
return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/); |
|
|
63576
|
|
|
|
|
88388
|
|
|
|
63576
|
|
|
|
|
226059
|
|
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
my $for_syntax = { |
|
306
|
|
|
|
|
|
|
update => 'FOR UPDATE', |
|
307
|
|
|
|
|
|
|
shared => 'FOR SHARE', |
|
308
|
|
|
|
|
|
|
}; |
|
309
|
|
|
|
|
|
|
sub _lock_select { |
|
310
|
2
|
|
|
2
|
|
4
|
my ($self, $type) = @_; |
|
311
|
|
|
|
|
|
|
|
|
312
|
2
|
|
|
|
|
3
|
my $sql; |
|
313
|
2
|
100
|
|
|
|
5
|
if (ref($type) eq 'SCALAR') { |
|
314
|
1
|
|
|
|
|
3
|
$sql = "FOR $$type"; |
|
315
|
|
|
|
|
|
|
} |
|
316
|
|
|
|
|
|
|
else { |
|
317
|
1
|
|
33
|
|
|
3
|
$sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); |
|
318
|
|
|
|
|
|
|
} |
|
319
|
|
|
|
|
|
|
|
|
320
|
2
|
|
|
|
|
5
|
return " $sql"; |
|
321
|
|
|
|
|
|
|
} |
|
322
|
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Handle default inserts |
|
324
|
|
|
|
|
|
|
sub insert { |
|
325
|
|
|
|
|
|
|
# optimized due to hotttnesss |
|
326
|
|
|
|
|
|
|
# my ($self, $table, $data, $options) = @_; |
|
327
|
|
|
|
|
|
|
|
|
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
|
9237
|
100
|
66
|
9237
|
1
|
44715
|
if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) { |
|
|
9237
|
|
66
|
|
|
44893
|
|
|
332
|
2
|
|
|
|
|
4
|
my @bind; |
|
333
|
2
|
|
|
|
|
11
|
my $sql = sprintf( |
|
334
|
|
|
|
|
|
|
'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1]) |
|
335
|
|
|
|
|
|
|
); |
|
336
|
|
|
|
|
|
|
|
|
337
|
2
|
50
|
50
|
|
|
87
|
if ( ($_[3]||{})->{returning} ) { |
|
338
|
0
|
|
|
|
|
0
|
my $s; |
|
339
|
0
|
|
|
|
|
0
|
($s, @bind) = $_[0]->_insert_returning ($_[3]); |
|
340
|
0
|
|
|
|
|
0
|
$sql .= $s; |
|
341
|
|
|
|
|
|
|
} |
|
342
|
|
|
|
|
|
|
|
|
343
|
2
|
|
|
|
|
10
|
return ($sql, @bind); |
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
|
|
346
|
9235
|
|
|
|
|
32187
|
next::method(@_); |
|
347
|
|
|
|
|
|
|
} |
|
348
|
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub _recurse_fields { |
|
350
|
9816
|
|
|
9816
|
|
29681
|
my ($self, $fields) = @_; |
|
351
|
|
|
|
|
|
|
|
|
352
|
9816
|
100
|
|
|
|
47027
|
if( not length ref $fields ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
353
|
2
|
|
|
|
|
6
|
return $self->_quote( $fields ); |
|
354
|
|
|
|
|
|
|
} |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
elsif( my $lit = is_literal_value( $fields ) ) { |
|
357
|
505
|
|
|
|
|
5599
|
return @$lit |
|
358
|
|
|
|
|
|
|
} |
|
359
|
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
elsif( ref $fields eq 'ARRAY' ) { |
|
361
|
8425
|
|
|
|
|
74360
|
my (@select, @bind, @bind_fragment); |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
( |
|
364
|
|
|
|
|
|
|
( $select[ $#select + 1 ], @bind_fragment ) = length ref $_ |
|
365
|
|
|
|
|
|
|
? $self->_recurse_fields( $_ ) |
|
366
|
|
|
|
|
|
|
: $self->_quote( $_ ) |
|
367
|
|
|
|
|
|
|
), |
|
368
|
|
|
|
|
|
|
( push @bind, @bind_fragment ) |
|
369
|
8425
|
100
|
|
|
|
51383
|
for @$fields; |
|
370
|
|
|
|
|
|
|
|
|
371
|
8424
|
|
|
|
|
202815
|
return (join(', ', @select), @bind); |
|
372
|
|
|
|
|
|
|
} |
|
373
|
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# FIXME - really crappy handling of functions |
|
375
|
|
|
|
|
|
|
elsif ( ref $fields eq 'HASH') { |
|
376
|
884
|
|
|
|
|
8631
|
my %hash = %$fields; # shallow copy |
|
377
|
|
|
|
|
|
|
|
|
378
|
884
|
|
|
|
|
2458
|
my $as = delete $hash{-as}; # if supplied |
|
379
|
|
|
|
|
|
|
|
|
380
|
884
|
|
|
|
|
2768
|
my ($func, $rhs, @toomany) = %hash; |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# there should be only one pair |
|
383
|
884
|
50
|
|
|
|
2760
|
$self->throw_exception( |
|
384
|
|
|
|
|
|
|
"Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) |
|
385
|
|
|
|
|
|
|
) if @toomany; |
|
386
|
|
|
|
|
|
|
|
|
387
|
884
|
100
|
100
|
|
|
4176
|
$self->throw_exception ( |
|
|
|
|
66
|
|
|
|
|
|
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 }' |
|
391
|
|
|
|
|
|
|
) if ( |
|
392
|
|
|
|
|
|
|
lc ($func) eq 'distinct' |
|
393
|
|
|
|
|
|
|
and |
|
394
|
|
|
|
|
|
|
ref $rhs eq 'ARRAY' |
|
395
|
|
|
|
|
|
|
and |
|
396
|
|
|
|
|
|
|
@$rhs > 1 |
|
397
|
|
|
|
|
|
|
); |
|
398
|
|
|
|
|
|
|
|
|
399
|
883
|
100
|
|
|
|
3863
|
my ($rhs_sql, @rhs_bind) = length ref $rhs |
|
400
|
|
|
|
|
|
|
? $self->_recurse_fields($rhs) |
|
401
|
|
|
|
|
|
|
: $self->_quote($rhs) |
|
402
|
|
|
|
|
|
|
; |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
return( |
|
405
|
883
|
100
|
|
|
|
24735
|
sprintf( '%s( %s )%s', |
|
406
|
|
|
|
|
|
|
$self->_sqlcase($func), |
|
407
|
|
|
|
|
|
|
$rhs_sql, |
|
408
|
|
|
|
|
|
|
$as |
|
409
|
|
|
|
|
|
|
? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) ) |
|
410
|
|
|
|
|
|
|
: '' |
|
411
|
|
|
|
|
|
|
), |
|
412
|
|
|
|
|
|
|
@rhs_bind |
|
413
|
|
|
|
|
|
|
); |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
else { |
|
417
|
0
|
|
|
|
|
0
|
$self->throw_exception( ref($fields) . ' unexpected in _recurse_fields()' ); |
|
418
|
|
|
|
|
|
|
} |
|
419
|
|
|
|
|
|
|
} |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
|
|
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 |
|
429
|
|
|
|
|
|
|
# is just gross. |
|
430
|
|
|
|
|
|
|
# |
|
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
|
10098
|
|
|
10098
|
|
112041
|
my ($self, $arg) = @_; |
|
435
|
|
|
|
|
|
|
|
|
436
|
10098
|
|
|
|
|
19742
|
my $sql = ''; |
|
437
|
10098
|
|
|
|
|
17560
|
my @sqlbind; |
|
438
|
|
|
|
|
|
|
|
|
439
|
10098
|
100
|
66
|
|
|
37290
|
if ( |
|
440
|
|
|
|
|
|
|
$arg->{group_by} |
|
441
|
|
|
|
|
|
|
and |
|
442
|
|
|
|
|
|
|
@sqlbind = $self->_recurse_fields($arg->{group_by}) |
|
443
|
|
|
|
|
|
|
) { |
|
444
|
470
|
|
|
|
|
1652
|
$sql .= $self->_sqlcase(' group by ') . shift @sqlbind; |
|
445
|
470
|
|
|
|
|
2856
|
push @{$self->{group_bind}}, @sqlbind; |
|
|
470
|
|
|
|
|
1357
|
|
|
446
|
|
|
|
|
|
|
} |
|
447
|
|
|
|
|
|
|
|
|
448
|
10098
|
100
|
66
|
|
|
32763
|
if ( |
|
449
|
|
|
|
|
|
|
$arg->{having} |
|
450
|
|
|
|
|
|
|
and |
|
451
|
|
|
|
|
|
|
@sqlbind = $self->_recurse_where($arg->{having}) |
|
452
|
|
|
|
|
|
|
) { |
|
453
|
97
|
|
|
|
|
6289
|
$sql .= $self->_sqlcase(' having ') . shift @sqlbind; |
|
454
|
97
|
|
|
|
|
653
|
push(@{$self->{having_bind}}, @sqlbind); |
|
|
97
|
|
|
|
|
297
|
|
|
455
|
|
|
|
|
|
|
} |
|
456
|
|
|
|
|
|
|
|
|
457
|
10098
|
100
|
|
|
|
29326
|
if ($arg->{order_by}) { |
|
458
|
|
|
|
|
|
|
# unlike the 2 above, _order_by injects into @{...bind...} for us |
|
459
|
3886
|
|
|
|
|
15048
|
$sql .= $self->_order_by ($arg->{order_by}); |
|
460
|
|
|
|
|
|
|
} |
|
461
|
|
|
|
|
|
|
|
|
462
|
10095
|
|
|
|
|
44057
|
return $sql; |
|
463
|
|
|
|
|
|
|
} |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub _order_by { |
|
466
|
10281
|
|
|
10281
|
|
540138
|
my ($self, $arg) = @_; |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# check that we are not called in legacy mode (order_by as 4th argument) |
|
469
|
|
|
|
|
|
|
( |
|
470
|
|
|
|
|
|
|
ref $arg eq 'HASH' |
|
471
|
|
|
|
|
|
|
and |
|
472
|
|
|
|
|
|
|
not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg |
|
473
|
|
|
|
|
|
|
) |
|
474
|
|
|
|
|
|
|
? $self->_parse_rs_attrs ($arg) |
|
475
|
10281
|
100
|
100
|
|
|
65063
|
: do { |
|
476
|
4053
|
|
|
|
|
15848
|
my ($sql, @bind) = $self->next::method($arg); |
|
477
|
4050
|
|
|
|
|
562181
|
push @{$self->{order_bind}}, @bind; |
|
|
4050
|
|
|
|
|
13938
|
|
|
478
|
4050
|
|
|
|
|
14355
|
$sql; # RV |
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
; |
|
481
|
|
|
|
|
|
|
} |
|
482
|
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
sub _split_order_chunk { |
|
484
|
682
|
|
|
682
|
|
1459
|
my ($self, $chunk) = @_; |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# strip off sort modifiers, but always succeed, so $1 gets reset |
|
487
|
682
|
|
|
|
|
4700
|
$chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix; |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
return ( |
|
490
|
682
|
100
|
100
|
|
|
4037
|
$chunk, |
|
491
|
|
|
|
|
|
|
( $1 and uc($1) eq 'DESC' ) ? 1 : 0, |
|
492
|
|
|
|
|
|
|
); |
|
493
|
|
|
|
|
|
|
} |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
sub _table { |
|
496
|
|
|
|
|
|
|
# optimized due to hotttnesss |
|
497
|
|
|
|
|
|
|
# my ($self, $from) = @_; |
|
498
|
18690
|
100
|
|
18690
|
|
317465
|
if (my $ref = ref $_[1] ) { |
|
499
|
9018
|
100
|
66
|
|
|
36157
|
if ($ref eq 'ARRAY') { |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
500
|
7943
|
|
|
|
|
16897
|
return $_[0]->_recurse_from(@{$_[1]}); |
|
|
7943
|
|
|
|
|
33737
|
|
|
501
|
|
|
|
|
|
|
} |
|
502
|
|
|
|
|
|
|
elsif ($ref eq 'HASH') { |
|
503
|
0
|
|
|
|
|
0
|
return $_[0]->_recurse_from($_[1]); |
|
504
|
|
|
|
|
|
|
} |
|
505
|
1
|
|
|
|
|
7
|
elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') { |
|
506
|
1
|
|
|
|
|
6
|
my ($sql, @bind) = @{ ${$_[1]} }; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
7
|
|
|
507
|
1
|
|
|
|
|
4
|
push @{$_[0]->{from_bind}}, @bind; |
|
|
1
|
|
|
|
|
8
|
|
|
508
|
1
|
|
|
|
|
6
|
return $sql |
|
509
|
|
|
|
|
|
|
} |
|
510
|
|
|
|
|
|
|
} |
|
511
|
10746
|
|
|
|
|
35836
|
return $_[0]->next::method ($_[1]); |
|
512
|
|
|
|
|
|
|
} |
|
513
|
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub _generate_join_clause { |
|
515
|
3310
|
|
|
3310
|
|
7334
|
my ($self, $join_type) = @_; |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
$join_type = $self->{_default_jointype} |
|
518
|
3310
|
100
|
|
|
|
11459
|
if ! defined $join_type; |
|
519
|
|
|
|
|
|
|
|
|
520
|
3310
|
100
|
|
|
|
16218
|
return sprintf ('%s JOIN ', |
|
521
|
|
|
|
|
|
|
$join_type ? $self->_sqlcase($join_type) : '' |
|
522
|
|
|
|
|
|
|
); |
|
523
|
|
|
|
|
|
|
} |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
sub _recurse_from { |
|
526
|
9020
|
|
|
9020
|
|
18280
|
my $self = shift; |
|
527
|
9020
|
|
|
|
|
30846
|
return join (' ', $self->_gen_from_blocks(@_) ); |
|
528
|
|
|
|
|
|
|
} |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub _gen_from_blocks { |
|
531
|
9026
|
|
|
9026
|
|
25175
|
my ($self, $from, @joins) = @_; |
|
532
|
|
|
|
|
|
|
|
|
533
|
9026
|
|
|
|
|
30739
|
my @fchunks = $self->_from_chunk_to_sql($from); |
|
534
|
|
|
|
|
|
|
|
|
535
|
9026
|
|
|
|
|
197229
|
for (@joins) { |
|
536
|
3312
|
|
|
|
|
8279
|
my ($to, $on) = @$_; |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# check whether a join type exists |
|
539
|
3312
|
100
|
|
|
|
12624
|
my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to; |
|
540
|
3312
|
|
|
|
|
6891
|
my $join_type; |
|
541
|
3312
|
100
|
66
|
|
|
17803
|
if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) { |
|
542
|
1699
|
|
|
|
|
3458
|
$join_type = $to_jt->{-join_type}; |
|
543
|
1699
|
|
|
|
|
6573
|
$join_type =~ s/^\s+ | \s+$//xg; |
|
544
|
|
|
|
|
|
|
} |
|
545
|
|
|
|
|
|
|
|
|
546
|
3312
|
|
|
|
|
9775
|
my @j = $self->_generate_join_clause( $join_type ); |
|
547
|
|
|
|
|
|
|
|
|
548
|
3312
|
100
|
|
|
|
20637
|
if (ref $to eq 'ARRAY') { |
|
549
|
2
|
|
|
|
|
11
|
push(@j, '(', $self->_recurse_from(@$to), ')'); |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
else { |
|
552
|
3310
|
|
|
|
|
7830
|
push(@j, $self->_from_chunk_to_sql($to)); |
|
553
|
|
|
|
|
|
|
} |
|
554
|
|
|
|
|
|
|
|
|
555
|
3312
|
|
|
|
|
84477
|
my ($sql, @bind) = $self->_join_condition($on); |
|
556
|
3312
|
|
|
|
|
411330
|
push(@j, ' ON ', $sql); |
|
557
|
3312
|
|
|
|
|
6268
|
push @{$self->{from_bind}}, @bind; |
|
|
3312
|
|
|
|
|
7674
|
|
|
558
|
|
|
|
|
|
|
|
|
559
|
3312
|
|
|
|
|
14723
|
push @fchunks, join '', @j; |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
|
|
562
|
9026
|
|
|
|
|
44569
|
return @fchunks; |
|
563
|
|
|
|
|
|
|
} |
|
564
|
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub _from_chunk_to_sql { |
|
566
|
24672
|
|
|
24672
|
|
48346
|
my ($self, $fromspec) = @_; |
|
567
|
|
|
|
|
|
|
|
|
568
|
24672
|
|
|
|
|
38193
|
return join (' ', do { |
|
569
|
24672
|
100
|
66
|
|
|
97519
|
if (! ref $fromspec) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
570
|
9117
|
|
|
|
|
23326
|
$self->_quote($fromspec); |
|
571
|
|
|
|
|
|
|
} |
|
572
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'SCALAR') { |
|
573
|
2968
|
|
|
|
|
12474
|
$$fromspec; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') { |
|
576
|
251
|
|
|
|
|
511
|
push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec]; |
|
|
251
|
|
|
|
|
1074
|
|
|
|
251
|
|
|
|
|
723
|
|
|
577
|
251
|
|
|
|
|
1368
|
$$fromspec->[0]; |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'HASH') { |
|
580
|
|
|
|
|
|
|
my ($as, $table, $toomuch) = ( map |
|
581
|
12336
|
|
|
|
|
48396
|
{ $_ => $fromspec->{$_} } |
|
582
|
12336
|
|
|
|
|
47367
|
( grep { $_ !~ /^\-/ } keys %$fromspec ) |
|
|
49641
|
|
|
|
|
150927
|
|
|
583
|
|
|
|
|
|
|
); |
|
584
|
|
|
|
|
|
|
|
|
585
|
12336
|
50
|
|
|
|
37792
|
$self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" ) |
|
586
|
|
|
|
|
|
|
if defined $toomuch; |
|
587
|
|
|
|
|
|
|
|
|
588
|
12336
|
|
|
|
|
38836
|
($self->_from_chunk_to_sql($table), $self->_quote($as) ); |
|
589
|
|
|
|
|
|
|
} |
|
590
|
|
|
|
|
|
|
else { |
|
591
|
0
|
|
|
|
|
0
|
$self->throw_exception('Unsupported from refkind: ' . ref $fromspec ); |
|
592
|
|
|
|
|
|
|
} |
|
593
|
|
|
|
|
|
|
}); |
|
594
|
|
|
|
|
|
|
} |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub _join_condition { |
|
597
|
3312
|
|
|
3312
|
|
7429
|
my ($self, $cond) = @_; |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# Backcompat for the old days when a plain hashref |
|
600
|
|
|
|
|
|
|
# { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2 |
|
601
|
3312
|
100
|
33
|
|
|
32119
|
if ( |
|
|
|
50
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
602
|
|
|
|
|
|
|
ref $cond eq 'HASH' |
|
603
|
|
|
|
|
|
|
and |
|
604
|
|
|
|
|
|
|
keys %$cond == 1 |
|
605
|
|
|
|
|
|
|
and |
|
606
|
|
|
|
|
|
|
(keys %$cond)[0] =~ /\./ |
|
607
|
|
|
|
|
|
|
and |
|
608
|
|
|
|
|
|
|
! ref ( (values %$cond)[0] ) |
|
609
|
|
|
|
|
|
|
) { |
|
610
|
13
|
|
|
|
|
82
|
carp_unique( |
|
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" |
|
615
|
|
|
|
|
|
|
); |
|
616
|
13
|
|
|
|
|
80
|
$cond = { keys %$cond => { -ident => values %$cond } } |
|
617
|
|
|
|
|
|
|
} |
|
618
|
|
|
|
|
|
|
elsif ( ref $cond eq 'ARRAY' ) { |
|
619
|
|
|
|
|
|
|
# do our own ORing so that the hashref-shim above is invoked |
|
620
|
0
|
|
|
|
|
0
|
my @parts; |
|
621
|
|
|
|
|
|
|
my @binds; |
|
622
|
0
|
|
|
|
|
0
|
foreach my $c (@$cond) { |
|
623
|
0
|
|
|
|
|
0
|
my ($sql, @bind) = $self->_join_condition($c); |
|
624
|
0
|
|
|
|
|
0
|
push @binds, @bind; |
|
625
|
0
|
|
|
|
|
0
|
push @parts, $sql; |
|
626
|
|
|
|
|
|
|
} |
|
627
|
0
|
|
|
|
|
0
|
return join(' OR ', @parts), @binds; |
|
628
|
|
|
|
|
|
|
} |
|
629
|
|
|
|
|
|
|
|
|
630
|
3312
|
|
|
|
|
11297
|
return $self->_recurse_where($cond); |
|
631
|
|
|
|
|
|
|
} |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# !!! EXPERIMENTAL API !!! WILL CHANGE !!! |
|
634
|
|
|
|
|
|
|
# |
|
635
|
|
|
|
|
|
|
# This is rather odd, but vanilla SQLA does not have support for multicolumn IN |
|
636
|
|
|
|
|
|
|
# expressions |
|
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? |
|
641
|
|
|
|
|
|
|
# |
|
642
|
|
|
|
|
|
|
# !!! EXPERIMENTAL API !!! WILL CHANGE !!! |
|
643
|
|
|
|
|
|
|
sub _where_op_multicolumn_in { |
|
644
|
1
|
|
|
1
|
|
4
|
my ($self, $lhs, $rhs) = @_; |
|
645
|
|
|
|
|
|
|
|
|
646
|
1
|
50
|
33
|
|
|
7
|
if (! ref $lhs or ref $lhs eq 'ARRAY') { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
647
|
1
|
|
|
|
|
3
|
my (@sql, @bind); |
|
648
|
1
|
50
|
|
|
|
5
|
for (ref $lhs ? @$lhs : $lhs) { |
|
649
|
4
|
50
|
0
|
|
|
51
|
if (! ref $_) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
650
|
4
|
|
|
|
|
8
|
push @sql, $self->_quote($_); |
|
651
|
|
|
|
|
|
|
} |
|
652
|
|
|
|
|
|
|
elsif (ref $_ eq 'SCALAR') { |
|
653
|
0
|
|
|
|
|
0
|
push @sql, $$_; |
|
654
|
|
|
|
|
|
|
} |
|
655
|
|
|
|
|
|
|
elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') { |
|
656
|
0
|
|
|
|
|
0
|
my ($s, @b) = @$$_; |
|
657
|
0
|
|
|
|
|
0
|
push @sql, $s; |
|
658
|
0
|
|
|
|
|
0
|
push @bind, @b; |
|
659
|
|
|
|
|
|
|
} |
|
660
|
|
|
|
|
|
|
else { |
|
661
|
0
|
|
|
|
|
0
|
$self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs..."); |
|
|
0
|
|
|
|
|
0
|
|
|
662
|
|
|
|
|
|
|
} |
|
663
|
|
|
|
|
|
|
} |
|
664
|
1
|
|
|
|
|
17
|
$lhs = \[ join(', ', @sql), @bind]; |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
elsif (ref $lhs eq 'SCALAR') { |
|
667
|
0
|
|
|
|
|
0
|
$lhs = \[ $$lhs ]; |
|
668
|
|
|
|
|
|
|
} |
|
669
|
|
|
|
|
|
|
elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) { |
|
670
|
|
|
|
|
|
|
# noop |
|
671
|
|
|
|
|
|
|
} |
|
672
|
|
|
|
|
|
|
else { |
|
673
|
0
|
|
|
|
|
0
|
$self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs..."); |
|
674
|
|
|
|
|
|
|
} |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# is this proper...? |
|
677
|
1
|
|
|
|
|
4
|
$rhs = \[ $self->_recurse_where($rhs) ]; |
|
678
|
|
|
|
|
|
|
|
|
679
|
1
|
|
|
|
|
50
|
for ($lhs, $rhs) { |
|
680
|
2
|
100
|
|
|
|
38
|
$$_->[0] = "( $$_->[0] )" |
|
681
|
|
|
|
|
|
|
unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs; |
|
682
|
|
|
|
|
|
|
} |
|
683
|
|
|
|
|
|
|
|
|
684
|
1
|
|
|
|
|
20
|
\[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ]; |
|
685
|
|
|
|
|
|
|
} |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Check the list of L. |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
This module is free software L |
|
694
|
|
|
|
|
|
|
by the L. You can |
|
695
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
|
696
|
|
|
|
|
|
|
L. |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=cut |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
1; |