|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=item * Support of functions in C |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=item * C/C support (via extensions to the order_by parameter) |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=item * Support of C<...FOR UPDATE> type of select statement modifiers |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=back |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
|
33
|
|
|
|
|
|
|
|
|
34
|
215
|
|
|
|
|
103695
|
use base qw/ |
|
35
|
|
|
|
|
|
|
DBIx::Class::SQLMaker::LimitDialects |
|
36
|
|
|
|
|
|
|
SQL::Abstract |
|
37
|
|
|
|
|
|
|
DBIx::Class |
|
38
|
215
|
|
|
215
|
|
899
|
/; |
|
|
215
|
|
|
|
|
452
|
|
|
39
|
215
|
|
|
215
|
|
1368
|
use mro 'c3'; |
|
|
215
|
|
|
|
|
525
|
|
|
|
215
|
|
|
|
|
1586
|
|
|
40
|
|
|
|
|
|
|
|
|
41
|
215
|
|
|
215
|
|
7700
|
use Sub::Name 'subname'; |
|
|
215
|
|
|
|
|
552
|
|
|
|
215
|
|
|
|
|
10126
|
|
|
42
|
215
|
|
|
215
|
|
1045
|
use DBIx::Class::Carp; |
|
|
215
|
|
|
|
|
814
|
|
|
|
215
|
|
|
|
|
1709
|
|
|
43
|
215
|
|
|
215
|
|
1097
|
use namespace::clean; |
|
|
215
|
|
|
|
|
500
|
|
|
|
215
|
|
|
|
|
925
|
|
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/); |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _quoting_enabled { |
|
48
|
0
|
0
|
0
|
0
|
|
0
|
( defined $_[0]->{quote_char} and length $_[0]->{quote_char} ) ? 1 : 0 |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# for when I need a normalized l/r pair |
|
52
|
|
|
|
|
|
|
sub _quote_chars { |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# in case we are called in the old !!$sm->_quote_chars fashion |
|
55
|
3162
|
0
|
0
|
3162
|
|
7035
|
return () if !wantarray and ( ! defined $_[0]->{quote_char} or ! length $_[0]->{quote_char} ); |
|
|
|
|
33
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
map |
|
58
|
6324
|
100
|
|
|
|
18693
|
{ defined $_ ? $_ : '' } |
|
59
|
3162
|
100
|
|
|
|
9931
|
( ref $_[0]->{quote_char} ? (@{$_[0]->{quote_char}}) : ( ($_[0]->{quote_char}) x 2 ) ) |
|
|
2064
|
|
|
|
|
4906
|
|
|
60
|
|
|
|
|
|
|
; |
|
61
|
|
|
|
|
|
|
} |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# FIXME when we bring in the storage weaklink, check its schema |
|
64
|
|
|
|
|
|
|
# weaklink and channel through $schema->throw_exception |
|
65
|
150
|
|
|
150
|
0
|
606
|
sub throw_exception { DBIx::Class::Exception->throw($_[1]) } |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
BEGIN { |
|
68
|
|
|
|
|
|
|
# reinstall the belch()/puke() functions of SQL::Abstract with custom versions |
|
69
|
|
|
|
|
|
|
# that use DBIx::Class::Carp/DBIx::Class::Exception instead of plain Carp |
|
70
|
215
|
|
|
215
|
|
76037
|
no warnings qw/redefine/; |
|
|
215
|
|
|
|
|
548
|
|
|
|
215
|
|
|
|
|
33571
|
|
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
*SQL::Abstract::belch = subname 'SQL::Abstract::belch' => sub (@) { |
|
73
|
60
|
|
|
60
|
|
103766
|
my($func) = (caller(1))[3]; |
|
74
|
60
|
|
|
|
|
1643
|
carp "[$func] Warning: ", @_; |
|
75
|
215
|
|
|
215
|
|
4700
|
}; |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
*SQL::Abstract::puke = subname 'SQL::Abstract::puke' => sub (@) { |
|
78
|
149
|
|
|
149
|
|
29834
|
my($func) = (caller(1))[3]; |
|
79
|
149
|
|
|
|
|
6404
|
__PACKAGE__->throw_exception("[$func] Fatal: " . join ('', @_)); |
|
80
|
215
|
|
|
|
|
531505
|
}; |
|
81
|
|
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# the "oh noes offset/top without limit" constant |
|
84
|
|
|
|
|
|
|
# limited to 31 bits for sanity (and consistency, |
|
85
|
|
|
|
|
|
|
# since it may be handed to the like of sprintf %u) |
|
86
|
|
|
|
|
|
|
# |
|
87
|
|
|
|
|
|
|
# Also *some* builds of SQLite fail the test |
|
88
|
|
|
|
|
|
|
# some_column BETWEEN ? AND ?: 1, 4294967295 |
|
89
|
|
|
|
|
|
|
# with the proper integer bind attrs |
|
90
|
|
|
|
|
|
|
# |
|
91
|
|
|
|
|
|
|
# Implemented as a method, since ::Storage::DBI also |
|
92
|
|
|
|
|
|
|
# refers to it (i.e. for the case of software_limit or |
|
93
|
|
|
|
|
|
|
# as the value to abuse with MSSQL ordered subqueries) |
|
94
|
|
|
|
|
|
|
sub __max_int () { 0x7FFFFFFF }; |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# we ne longer need to check this - DBIC has ways of dealing with it |
|
97
|
|
|
|
|
|
|
# specifically ::Storage::DBI::_resolve_bindattrs() |
|
98
|
|
|
|
|
|
|
sub _assert_bindval_matches_bindtype () { 1 }; |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# poor man's de-qualifier |
|
101
|
|
|
|
|
|
|
sub _quote { |
|
102
|
136315
|
100
|
66
|
136315
|
|
7825448
|
$_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] ) |
|
103
|
|
|
|
|
|
|
? $_[1] =~ / ([^\.]+) $ /x |
|
104
|
|
|
|
|
|
|
: $_[1] |
|
105
|
|
|
|
|
|
|
); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub _where_op_NEST { |
|
109
|
2
|
|
|
2
|
|
269
|
carp_unique ("-nest in search conditions is deprecated, you most probably wanted:\n" |
|
110
|
|
|
|
|
|
|
.q|{..., -and => [ \%cond0, \@cond1, \'cond2', \[ 'cond3', [ col => bind ] ], etc. ], ... }| |
|
111
|
|
|
|
|
|
|
); |
|
112
|
|
|
|
|
|
|
|
|
113
|
2
|
|
|
|
|
49
|
shift->next::method(@_); |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# Handle limit-dialect selection |
|
117
|
|
|
|
|
|
|
sub select { |
|
118
|
7859
|
|
|
7859
|
1
|
73960
|
my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_; |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
|
121
|
7859
|
|
|
|
|
18653
|
($fields, @{$self->{select_bind}}) = $self->_recurse_fields($fields); |
|
|
7858
|
|
|
|
|
21373
|
|
|
122
|
|
|
|
|
|
|
|
|
123
|
7858
|
100
|
|
|
|
17645
|
if (defined $offset) { |
|
124
|
133
|
50
|
33
|
|
|
973
|
$self->throw_exception('A supplied offset must be a non-negative integer') |
|
125
|
|
|
|
|
|
|
if ( $offset =~ /\D/ or $offset < 0 ); |
|
126
|
|
|
|
|
|
|
} |
|
127
|
7858
|
|
100
|
|
|
25096
|
$offset ||= 0; |
|
128
|
|
|
|
|
|
|
|
|
129
|
7858
|
100
|
|
|
|
20006
|
if (defined $limit) { |
|
|
|
50
|
|
|
|
|
|
|
130
|
1674
|
50
|
33
|
|
|
8586
|
$self->throw_exception('A supplied limit must be a positive integer') |
|
131
|
|
|
|
|
|
|
if ( $limit =~ /\D/ or $limit <= 0 ); |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
elsif ($offset) { |
|
134
|
0
|
|
|
|
|
0
|
$limit = $self->__max_int; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
|
138
|
7858
|
|
|
|
|
9101
|
my ($sql, @bind); |
|
139
|
7858
|
100
|
|
|
|
11818
|
if ($limit) { |
|
140
|
|
|
|
|
|
|
# this is legacy code-flow from SQLA::Limit, it is not set in stone |
|
141
|
|
|
|
|
|
|
|
|
142
|
1674
|
|
|
|
|
4720
|
($sql, @bind) = $self->next::method ($table, $fields, $where); |
|
143
|
|
|
|
|
|
|
|
|
144
|
1674
|
|
|
|
|
141750
|
my $limiter; |
|
145
|
|
|
|
|
|
|
|
|
146
|
1674
|
100
|
|
|
|
7623
|
if( $limiter = $self->can ('emulate_limit') ) { |
|
147
|
1
|
|
|
|
|
5
|
carp_unique( |
|
148
|
|
|
|
|
|
|
'Support for the legacy emulate_limit() mechanism inherited from ' |
|
149
|
|
|
|
|
|
|
. 'SQL::Abstract::Limit has been deprecated, and will be removed when ' |
|
150
|
|
|
|
|
|
|
. 'DBIC transitions to Data::Query. If your code uses this type of ' |
|
151
|
|
|
|
|
|
|
. 'limit specification please file an RT and provide the source of ' |
|
152
|
|
|
|
|
|
|
. 'your emulate_limit() implementation, so an acceptable upgrade-path ' |
|
153
|
|
|
|
|
|
|
. 'can be devised' |
|
154
|
|
|
|
|
|
|
); |
|
155
|
|
|
|
|
|
|
} |
|
156
|
|
|
|
|
|
|
else { |
|
157
|
1673
|
50
|
|
|
|
6611
|
my $dialect = $self->limit_dialect |
|
158
|
|
|
|
|
|
|
or $self->throw_exception( "Unable to generate SQL-limit - no limit dialect specified on $self" ); |
|
159
|
|
|
|
|
|
|
|
|
160
|
1673
|
50
|
|
|
|
17536
|
$limiter = $self->can ("_$dialect") |
|
161
|
|
|
|
|
|
|
or $self->throw_exception(__PACKAGE__ . " does not implement the requested dialect '$dialect'"); |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
$sql = $self->$limiter ( |
|
165
|
|
|
|
|
|
|
$sql, |
|
166
|
1674
|
50
|
|
|
|
2830
|
{ %{$rs_attrs||{}}, _selector_sql => $fields }, |
|
|
1674
|
|
|
|
|
20559
|
|
|
167
|
|
|
|
|
|
|
$limit, |
|
168
|
|
|
|
|
|
|
$offset |
|
169
|
|
|
|
|
|
|
); |
|
170
|
|
|
|
|
|
|
} |
|
171
|
|
|
|
|
|
|
else { |
|
172
|
6184
|
|
|
|
|
17308
|
($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs); |
|
173
|
|
|
|
|
|
|
} |
|
174
|
|
|
|
|
|
|
|
|
175
|
7855
|
|
|
|
|
101544
|
push @{$self->{where_bind}}, @bind; |
|
|
7855
|
|
|
|
|
19574
|
|
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# this *must* be called, otherwise extra binds will remain in the sql-maker |
|
178
|
7855
|
|
|
|
|
18831
|
my @all_bind = $self->_assemble_binds; |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
$sql .= $self->_lock_select ($rs_attrs->{for}) |
|
181
|
7855
|
100
|
|
|
|
19024
|
if $rs_attrs->{for}; |
|
182
|
|
|
|
|
|
|
|
|
183
|
7855
|
50
|
|
|
|
37520
|
return wantarray ? ($sql, @all_bind) : $sql; |
|
184
|
|
|
|
|
|
|
} |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub _assemble_binds { |
|
187
|
7855
|
|
|
7855
|
|
9009
|
my $self = shift; |
|
188
|
7855
|
100
|
|
|
|
13041
|
return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/pre_select select from where group having order limit/); |
|
|
62840
|
|
|
|
|
39122
|
|
|
|
62840
|
|
|
|
|
189726
|
|
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
my $for_syntax = { |
|
192
|
|
|
|
|
|
|
update => 'FOR UPDATE', |
|
193
|
|
|
|
|
|
|
shared => 'FOR SHARE', |
|
194
|
|
|
|
|
|
|
}; |
|
195
|
|
|
|
|
|
|
sub _lock_select { |
|
196
|
2
|
|
|
2
|
|
5
|
my ($self, $type) = @_; |
|
197
|
|
|
|
|
|
|
|
|
198
|
2
|
|
|
|
|
2
|
my $sql; |
|
199
|
2
|
100
|
|
|
|
8
|
if (ref($type) eq 'SCALAR') { |
|
200
|
1
|
|
|
|
|
5
|
$sql = "FOR $$type"; |
|
201
|
|
|
|
|
|
|
} |
|
202
|
|
|
|
|
|
|
else { |
|
203
|
1
|
|
33
|
|
|
5
|
$sql = $for_syntax->{$type} || $self->throw_exception( "Unknown SELECT .. FOR type '$type' requested" ); |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
2
|
|
|
|
|
7
|
return " $sql"; |
|
207
|
|
|
|
|
|
|
} |
|
208
|
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Handle default inserts |
|
210
|
|
|
|
|
|
|
sub insert { |
|
211
|
|
|
|
|
|
|
# optimized due to hotttnesss |
|
212
|
|
|
|
|
|
|
# my ($self, $table, $data, $options) = @_; |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# SQLA will emit INSERT INTO $table ( ) VALUES ( ) |
|
215
|
|
|
|
|
|
|
# which is sadly understood only by MySQL. Change default behavior here, |
|
216
|
|
|
|
|
|
|
# until SQLA2 comes with proper dialect support |
|
217
|
9146
|
100
|
66
|
9146
|
1
|
37159
|
if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) { |
|
|
9146
|
|
33
|
|
|
33862
|
|
|
218
|
2
|
|
|
|
|
4
|
my @bind; |
|
219
|
2
|
|
|
|
|
8
|
my $sql = sprintf( |
|
220
|
|
|
|
|
|
|
'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1]) |
|
221
|
|
|
|
|
|
|
); |
|
222
|
|
|
|
|
|
|
|
|
223
|
2
|
50
|
50
|
|
|
114
|
if ( ($_[3]||{})->{returning} ) { |
|
224
|
0
|
|
|
|
|
0
|
my $s; |
|
225
|
0
|
|
|
|
|
0
|
($s, @bind) = $_[0]->_insert_returning ($_[3]); |
|
226
|
0
|
|
|
|
|
0
|
$sql .= $s; |
|
227
|
|
|
|
|
|
|
} |
|
228
|
|
|
|
|
|
|
|
|
229
|
2
|
|
|
|
|
10
|
return ($sql, @bind); |
|
230
|
|
|
|
|
|
|
} |
|
231
|
|
|
|
|
|
|
|
|
232
|
9144
|
|
|
|
|
24244
|
next::method(@_); |
|
233
|
|
|
|
|
|
|
} |
|
234
|
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub _recurse_fields { |
|
236
|
52684
|
|
|
52684
|
|
51974
|
my ($self, $fields) = @_; |
|
237
|
52684
|
|
|
|
|
50067
|
my $ref = ref $fields; |
|
238
|
52684
|
100
|
|
|
|
102920
|
return $self->_quote($fields) unless $ref; |
|
239
|
9721
|
100
|
|
|
|
20317
|
return $$fields if $ref eq 'SCALAR'; |
|
240
|
|
|
|
|
|
|
|
|
241
|
9637
|
100
|
33
|
|
|
19408
|
if ($ref eq 'ARRAY') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
242
|
8341
|
|
|
|
|
8809
|
my (@select, @bind); |
|
243
|
8341
|
|
|
|
|
15220
|
for my $field (@$fields) { |
|
244
|
37312
|
|
|
|
|
53218
|
my ($select, @new_bind) = $self->_recurse_fields($field); |
|
245
|
37311
|
|
|
|
|
589272
|
push @select, $select; |
|
246
|
37311
|
|
|
|
|
46823
|
push @bind, @new_bind; |
|
247
|
|
|
|
|
|
|
} |
|
248
|
8340
|
|
|
|
|
32034
|
return (join(', ', @select), @bind); |
|
249
|
|
|
|
|
|
|
} |
|
250
|
|
|
|
|
|
|
elsif ($ref eq 'HASH') { |
|
251
|
875
|
|
|
|
|
3521
|
my %hash = %$fields; # shallow copy |
|
252
|
|
|
|
|
|
|
|
|
253
|
875
|
|
|
|
|
2237
|
my $as = delete $hash{-as}; # if supplied |
|
254
|
|
|
|
|
|
|
|
|
255
|
875
|
|
|
|
|
1872
|
my ($func, $rhs, @toomany) = %hash; |
|
256
|
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# there should be only one pair |
|
258
|
875
|
50
|
|
|
|
2278
|
if (@toomany) { |
|
259
|
0
|
|
|
|
|
0
|
$self->throw_exception( "Malformed select argument - too many keys in hash: " . join (',', keys %$fields ) ); |
|
260
|
|
|
|
|
|
|
} |
|
261
|
|
|
|
|
|
|
|
|
262
|
875
|
100
|
100
|
|
|
3345
|
if (lc ($func) eq 'distinct' && ref $rhs eq 'ARRAY' && @$rhs > 1) { |
|
|
|
|
66
|
|
|
|
|
|
263
|
1
|
|
|
|
|
13
|
$self->throw_exception ( |
|
264
|
|
|
|
|
|
|
'The select => { distinct => ... } syntax is not supported for multiple columns.' |
|
265
|
|
|
|
|
|
|
.' Instead please use { group_by => [ qw/' . (join ' ', @$rhs) . '/ ] }' |
|
266
|
|
|
|
|
|
|
.' or { select => [ qw/' . (join ' ', @$rhs) . '/ ], distinct => 1 }' |
|
267
|
|
|
|
|
|
|
); |
|
268
|
|
|
|
|
|
|
} |
|
269
|
|
|
|
|
|
|
|
|
270
|
874
|
|
|
|
|
2684
|
my ($rhs_sql, @rhs_bind) = $self->_recurse_fields($rhs); |
|
271
|
874
|
100
|
|
|
|
20992
|
my $select = sprintf ('%s( %s )%s', |
|
272
|
|
|
|
|
|
|
$self->_sqlcase($func), |
|
273
|
|
|
|
|
|
|
$rhs_sql, |
|
274
|
|
|
|
|
|
|
$as |
|
275
|
|
|
|
|
|
|
? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) ) |
|
276
|
|
|
|
|
|
|
: '' |
|
277
|
|
|
|
|
|
|
); |
|
278
|
|
|
|
|
|
|
|
|
279
|
874
|
|
|
|
|
10355
|
return ($select, @rhs_bind); |
|
280
|
|
|
|
|
|
|
} |
|
281
|
|
|
|
|
|
|
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) { |
|
282
|
421
|
|
|
|
|
386
|
return @{$$fields}; |
|
|
421
|
|
|
|
|
1627
|
|
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
else { |
|
285
|
0
|
|
|
|
|
0
|
$self->throw_exception( $ref . qq{ unexpected in _recurse_fields()} ); |
|
286
|
|
|
|
|
|
|
} |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# this used to be a part of _order_by but is broken out for clarity. |
|
291
|
|
|
|
|
|
|
# What we have been doing forever is hijacking the $order arg of |
|
292
|
|
|
|
|
|
|
# SQLA::select to pass in arbitrary pieces of data (first the group_by, |
|
293
|
|
|
|
|
|
|
# then pretty much the entire resultset attr-hash, as more and more |
|
294
|
|
|
|
|
|
|
# things in the SQLA space need to have more info about the $rs they |
|
295
|
|
|
|
|
|
|
# create SQL for. The alternative would be to keep expanding the |
|
296
|
|
|
|
|
|
|
# signature of _select with more and more positional parameters, which |
|
297
|
|
|
|
|
|
|
# is just gross. All hail SQLA2! |
|
298
|
|
|
|
|
|
|
sub _parse_rs_attrs { |
|
299
|
10096
|
|
|
10096
|
|
81352
|
my ($self, $arg) = @_; |
|
300
|
|
|
|
|
|
|
|
|
301
|
10096
|
|
|
|
|
12793
|
my $sql = ''; |
|
302
|
|
|
|
|
|
|
|
|
303
|
10096
|
100
|
|
|
|
22606
|
if ($arg->{group_by}) { |
|
304
|
478
|
50
|
|
|
|
1388
|
if ( my ($group_sql, @group_bind) = $self->_recurse_fields($arg->{group_by}) ) { |
|
305
|
478
|
|
|
|
|
1325
|
$sql .= $self->_sqlcase(' group by ') . $group_sql; |
|
306
|
478
|
|
|
|
|
2198
|
push @{$self->{group_bind}}, @group_bind; |
|
|
478
|
|
|
|
|
1131
|
|
|
307
|
|
|
|
|
|
|
} |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
10096
|
100
|
|
|
|
20885
|
if (defined $arg->{having}) { |
|
311
|
99
|
|
|
|
|
299
|
my ($frag, @bind) = $self->_recurse_where($arg->{having}); |
|
312
|
99
|
|
|
|
|
4622
|
push(@{$self->{having_bind}}, @bind); |
|
|
99
|
|
|
|
|
288
|
|
|
313
|
99
|
|
|
|
|
259
|
$sql .= $self->_sqlcase(' having ') . $frag; |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
|
|
316
|
10096
|
100
|
|
|
|
19745
|
if (defined $arg->{order_by}) { |
|
317
|
3845
|
|
|
|
|
9050
|
$sql .= $self->_order_by ($arg->{order_by}); |
|
318
|
|
|
|
|
|
|
} |
|
319
|
|
|
|
|
|
|
|
|
320
|
10093
|
|
|
|
|
35305
|
return $sql; |
|
321
|
|
|
|
|
|
|
} |
|
322
|
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub _order_by { |
|
324
|
10190
|
|
|
10190
|
|
386757
|
my ($self, $arg) = @_; |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# check that we are not called in legacy mode (order_by as 4th argument) |
|
327
|
10190
|
100
|
100
|
|
|
50459
|
if (ref $arg eq 'HASH' and not grep { $_ =~ /^-(?:desc|asc)/i } keys %$arg ) { |
|
|
69395
|
|
|
|
|
89599
|
|
|
328
|
6178
|
|
|
|
|
15364
|
return $self->_parse_rs_attrs ($arg); |
|
329
|
|
|
|
|
|
|
} |
|
330
|
|
|
|
|
|
|
else { |
|
331
|
4012
|
|
|
|
|
10323
|
my ($sql, @bind) = $self->next::method($arg); |
|
332
|
4009
|
|
|
|
|
374520
|
push @{$self->{order_bind}}, @bind; |
|
|
4009
|
|
|
|
|
9889
|
|
|
333
|
4009
|
|
|
|
|
11553
|
return $sql; |
|
334
|
|
|
|
|
|
|
} |
|
335
|
|
|
|
|
|
|
} |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _split_order_chunk { |
|
338
|
1562
|
|
|
1562
|
|
1867
|
my ($self, $chunk) = @_; |
|
339
|
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
# strip off sort modifiers, but always succeed, so $1 gets reset |
|
341
|
1562
|
|
|
|
|
10118
|
$chunk =~ s/ (?: \s+ (ASC|DESC) )? \s* $//ix; |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
return ( |
|
344
|
1562
|
100
|
100
|
|
|
9644
|
$chunk, |
|
345
|
|
|
|
|
|
|
( $1 and uc($1) eq 'DESC' ) ? 1 : 0, |
|
346
|
|
|
|
|
|
|
); |
|
347
|
|
|
|
|
|
|
} |
|
348
|
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub _table { |
|
350
|
|
|
|
|
|
|
# optimized due to hotttnesss |
|
351
|
|
|
|
|
|
|
# my ($self, $from) = @_; |
|
352
|
18497
|
100
|
|
18497
|
|
224670
|
if (my $ref = ref $_[1] ) { |
|
353
|
8921
|
100
|
66
|
|
|
25070
|
if ($ref eq 'ARRAY') { |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
354
|
7851
|
|
|
|
|
10229
|
return $_[0]->_recurse_from(@{$_[1]}); |
|
|
7851
|
|
|
|
|
24065
|
|
|
355
|
|
|
|
|
|
|
} |
|
356
|
|
|
|
|
|
|
elsif ($ref eq 'HASH') { |
|
357
|
0
|
|
|
|
|
0
|
return $_[0]->_recurse_from($_[1]); |
|
358
|
|
|
|
|
|
|
} |
|
359
|
1
|
|
|
|
|
6
|
elsif ($ref eq 'REF' && ref ${$_[1]} eq 'ARRAY') { |
|
360
|
1
|
|
|
|
|
2
|
my ($sql, @bind) = @{ ${$_[1]} }; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
2
|
|
|
361
|
1
|
|
|
|
|
1
|
push @{$_[0]->{from_bind}}, @bind; |
|
|
1
|
|
|
|
|
3
|
|
|
362
|
1
|
|
|
|
|
3
|
return $sql |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
} |
|
365
|
10645
|
|
|
|
|
27352
|
return $_[0]->next::method ($_[1]); |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub _generate_join_clause { |
|
369
|
3282
|
|
|
3282
|
|
3968
|
my ($self, $join_type) = @_; |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
$join_type = $self->{_default_jointype} |
|
372
|
3282
|
100
|
|
|
|
7369
|
if ! defined $join_type; |
|
373
|
|
|
|
|
|
|
|
|
374
|
3282
|
100
|
|
|
|
12579
|
return sprintf ('%s JOIN ', |
|
375
|
|
|
|
|
|
|
$join_type ? $self->_sqlcase($join_type) : '' |
|
376
|
|
|
|
|
|
|
); |
|
377
|
|
|
|
|
|
|
} |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub _recurse_from { |
|
380
|
8973
|
|
|
8973
|
|
9849
|
my $self = shift; |
|
381
|
8973
|
|
|
|
|
20794
|
return join (' ', $self->_gen_from_blocks(@_) ); |
|
382
|
|
|
|
|
|
|
} |
|
383
|
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub _gen_from_blocks { |
|
385
|
8979
|
|
|
8979
|
|
13789
|
my ($self, $from, @joins) = @_; |
|
386
|
|
|
|
|
|
|
|
|
387
|
8979
|
|
|
|
|
20804
|
my @fchunks = $self->_from_chunk_to_sql($from); |
|
388
|
|
|
|
|
|
|
|
|
389
|
8979
|
|
|
|
|
153963
|
for (@joins) { |
|
390
|
3284
|
|
|
|
|
5087
|
my ($to, $on) = @$_; |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# check whether a join type exists |
|
393
|
3284
|
100
|
|
|
|
7231
|
my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to; |
|
394
|
3284
|
|
|
|
|
2967
|
my $join_type; |
|
395
|
3284
|
100
|
66
|
|
|
17920
|
if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) { |
|
396
|
1742
|
|
|
|
|
2912
|
$join_type = $to_jt->{-join_type}; |
|
397
|
1742
|
|
|
|
|
5227
|
$join_type =~ s/^\s+ | \s+$//xg; |
|
398
|
|
|
|
|
|
|
} |
|
399
|
|
|
|
|
|
|
|
|
400
|
3284
|
|
|
|
|
7298
|
my @j = $self->_generate_join_clause( $join_type ); |
|
401
|
|
|
|
|
|
|
|
|
402
|
3284
|
100
|
|
|
|
16337
|
if (ref $to eq 'ARRAY') { |
|
403
|
2
|
|
|
|
|
5
|
push(@j, '(', $self->_recurse_from(@$to), ')'); |
|
404
|
|
|
|
|
|
|
} |
|
405
|
|
|
|
|
|
|
else { |
|
406
|
3282
|
|
|
|
|
5708
|
push(@j, $self->_from_chunk_to_sql($to)); |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
3284
|
|
|
|
|
63910
|
my ($sql, @bind) = $self->_join_condition($on); |
|
410
|
3284
|
|
|
|
|
296454
|
push(@j, ' ON ', $sql); |
|
411
|
3284
|
|
|
|
|
4593
|
push @{$self->{from_bind}}, @bind; |
|
|
3284
|
|
|
|
|
5476
|
|
|
412
|
|
|
|
|
|
|
|
|
413
|
3284
|
|
|
|
|
13002
|
push @fchunks, join '', @j; |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
8979
|
|
|
|
|
35185
|
return @fchunks; |
|
417
|
|
|
|
|
|
|
} |
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub _from_chunk_to_sql { |
|
420
|
24522
|
|
|
24522
|
|
24722
|
my ($self, $fromspec) = @_; |
|
421
|
|
|
|
|
|
|
|
|
422
|
24522
|
|
|
|
|
20097
|
return join (' ', do { |
|
423
|
24522
|
100
|
66
|
|
|
78258
|
if (! ref $fromspec) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
424
|
9008
|
|
|
|
|
15924
|
$self->_quote($fromspec); |
|
425
|
|
|
|
|
|
|
} |
|
426
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'SCALAR') { |
|
427
|
3005
|
|
|
|
|
9996
|
$$fromspec; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'REF' and ref $$fromspec eq 'ARRAY') { |
|
430
|
248
|
|
|
|
|
323
|
push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec]; |
|
|
248
|
|
|
|
|
803
|
|
|
|
248
|
|
|
|
|
528
|
|
|
431
|
248
|
|
|
|
|
1217
|
$$fromspec->[0]; |
|
432
|
|
|
|
|
|
|
} |
|
433
|
|
|
|
|
|
|
elsif (ref $fromspec eq 'HASH') { |
|
434
|
|
|
|
|
|
|
my ($as, $table, $toomuch) = ( map |
|
435
|
12261
|
|
|
|
|
32417
|
{ $_ => $fromspec->{$_} } |
|
436
|
12261
|
|
|
|
|
34096
|
( grep { $_ !~ /^\-/ } keys %$fromspec ) |
|
|
49357
|
|
|
|
|
101691
|
|
|
437
|
|
|
|
|
|
|
); |
|
438
|
|
|
|
|
|
|
|
|
439
|
12261
|
50
|
|
|
|
26908
|
$self->throw_exception( "Only one table/as pair expected in from-spec but an exra '$toomuch' key present" ) |
|
440
|
|
|
|
|
|
|
if defined $toomuch; |
|
441
|
|
|
|
|
|
|
|
|
442
|
12261
|
|
|
|
|
22897
|
($self->_from_chunk_to_sql($table), $self->_quote($as) ); |
|
443
|
|
|
|
|
|
|
} |
|
444
|
|
|
|
|
|
|
else { |
|
445
|
0
|
|
|
|
|
0
|
$self->throw_exception('Unsupported from refkind: ' . ref $fromspec ); |
|
446
|
|
|
|
|
|
|
} |
|
447
|
|
|
|
|
|
|
}); |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
sub _join_condition { |
|
451
|
3284
|
|
|
3284
|
|
4248
|
my ($self, $cond) = @_; |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# Backcompat for the old days when a plain hashref |
|
454
|
|
|
|
|
|
|
# { 't1.col1' => 't2.col2' } meant ON t1.col1 = t2.col2 |
|
455
|
3284
|
100
|
33
|
|
|
33587
|
if ( |
|
|
|
50
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
456
|
|
|
|
|
|
|
ref $cond eq 'HASH' |
|
457
|
|
|
|
|
|
|
and |
|
458
|
|
|
|
|
|
|
keys %$cond == 1 |
|
459
|
|
|
|
|
|
|
and |
|
460
|
|
|
|
|
|
|
(keys %$cond)[0] =~ /\./ |
|
461
|
|
|
|
|
|
|
and |
|
462
|
|
|
|
|
|
|
! ref ( (values %$cond)[0] ) |
|
463
|
|
|
|
|
|
|
) { |
|
464
|
13
|
|
|
|
|
58
|
carp_unique( |
|
465
|
|
|
|
|
|
|
"ResultSet {from} structures with conditions not conforming to the " |
|
466
|
|
|
|
|
|
|
. "SQL::Abstract syntax are deprecated: you either need to stop abusing " |
|
467
|
|
|
|
|
|
|
. "{from} altogether, or express the condition properly using the " |
|
468
|
|
|
|
|
|
|
. "{ -ident => ... } operator" |
|
469
|
|
|
|
|
|
|
); |
|
470
|
13
|
|
|
|
|
62
|
$cond = { keys %$cond => { -ident => values %$cond } } |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
elsif ( ref $cond eq 'ARRAY' ) { |
|
473
|
|
|
|
|
|
|
# do our own ORing so that the hashref-shim above is invoked |
|
474
|
0
|
|
|
|
|
0
|
my @parts; |
|
475
|
|
|
|
|
|
|
my @binds; |
|
476
|
0
|
|
|
|
|
0
|
foreach my $c (@$cond) { |
|
477
|
0
|
|
|
|
|
0
|
my ($sql, @bind) = $self->_join_condition($c); |
|
478
|
0
|
|
|
|
|
0
|
push @binds, @bind; |
|
479
|
0
|
|
|
|
|
0
|
push @parts, $sql; |
|
480
|
|
|
|
|
|
|
} |
|
481
|
0
|
|
|
|
|
0
|
return join(' OR ', @parts), @binds; |
|
482
|
|
|
|
|
|
|
} |
|
483
|
|
|
|
|
|
|
|
|
484
|
3284
|
|
|
|
|
8380
|
return $self->_recurse_where($cond); |
|
485
|
|
|
|
|
|
|
} |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# This is hideously ugly, but SQLA does not understand multicol IN expressions |
|
488
|
|
|
|
|
|
|
# FIXME TEMPORARY - DQ should have native syntax for this |
|
489
|
|
|
|
|
|
|
# moved here to raise API questions |
|
490
|
|
|
|
|
|
|
# |
|
491
|
|
|
|
|
|
|
# !!! EXPERIMENTAL API !!! WILL CHANGE !!! |
|
492
|
|
|
|
|
|
|
sub _where_op_multicolumn_in { |
|
493
|
1
|
|
|
1
|
|
2
|
my ($self, $lhs, $rhs) = @_; |
|
494
|
|
|
|
|
|
|
|
|
495
|
1
|
50
|
33
|
|
|
11
|
if (! ref $lhs or ref $lhs eq 'ARRAY') { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
496
|
1
|
|
|
|
|
2
|
my (@sql, @bind); |
|
497
|
1
|
50
|
|
|
|
4
|
for (ref $lhs ? @$lhs : $lhs) { |
|
498
|
4
|
50
|
0
|
|
|
53
|
if (! ref $_) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
499
|
4
|
|
|
|
|
7
|
push @sql, $self->_quote($_); |
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
elsif (ref $_ eq 'SCALAR') { |
|
502
|
0
|
|
|
|
|
0
|
push @sql, $$_; |
|
503
|
|
|
|
|
|
|
} |
|
504
|
|
|
|
|
|
|
elsif (ref $_ eq 'REF' and ref $$_ eq 'ARRAY') { |
|
505
|
0
|
|
|
|
|
0
|
my ($s, @b) = @$$_; |
|
506
|
0
|
|
|
|
|
0
|
push @sql, $s; |
|
507
|
0
|
|
|
|
|
0
|
push @bind, @b; |
|
508
|
|
|
|
|
|
|
} |
|
509
|
|
|
|
|
|
|
else { |
|
510
|
0
|
|
|
|
|
0
|
$self->throw_exception("ARRAY of @{[ ref $_ ]}es unsupported for multicolumn IN lhs..."); |
|
|
0
|
|
|
|
|
0
|
|
|
511
|
|
|
|
|
|
|
} |
|
512
|
|
|
|
|
|
|
} |
|
513
|
1
|
|
|
|
|
15
|
$lhs = \[ join(', ', @sql), @bind]; |
|
514
|
|
|
|
|
|
|
} |
|
515
|
|
|
|
|
|
|
elsif (ref $lhs eq 'SCALAR') { |
|
516
|
0
|
|
|
|
|
0
|
$lhs = \[ $$lhs ]; |
|
517
|
|
|
|
|
|
|
} |
|
518
|
|
|
|
|
|
|
elsif (ref $lhs eq 'REF' and ref $$lhs eq 'ARRAY' ) { |
|
519
|
|
|
|
|
|
|
# noop |
|
520
|
|
|
|
|
|
|
} |
|
521
|
|
|
|
|
|
|
else { |
|
522
|
0
|
|
|
|
|
0
|
$self->throw_exception( ref($lhs) . "es unsupported for multicolumn IN lhs..."); |
|
523
|
|
|
|
|
|
|
} |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# is this proper...? |
|
526
|
1
|
|
|
|
|
4
|
$rhs = \[ $self->_recurse_where($rhs) ]; |
|
527
|
|
|
|
|
|
|
|
|
528
|
1
|
|
|
|
|
51
|
for ($lhs, $rhs) { |
|
529
|
2
|
100
|
|
|
|
13
|
$$_->[0] = "( $$_->[0] )" |
|
530
|
|
|
|
|
|
|
unless $$_->[0] =~ /^ \s* \( .* \) \s* $/xs; |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
1
|
|
|
|
|
12
|
\[ join( ' IN ', shift @$$lhs, shift @$$rhs ), @$$lhs, @$$rhs ]; |
|
534
|
|
|
|
|
|
|
} |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
Check the list of L. |
|
539
|
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
This module is free software L |
|
543
|
|
|
|
|
|
|
by the L. You can |
|
544
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
|
545
|
|
|
|
|
|
|
L. |
|
546
|
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=cut |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
1; |