line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SQL::Abstract::Limit; |
2
|
5
|
|
|
5
|
|
177276
|
use strict; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
206
|
|
3
|
5
|
|
|
5
|
|
30
|
use warnings; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
141
|
|
4
|
5
|
|
|
5
|
|
30
|
use Carp(); |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
88
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
8051
|
use DBI::Const::GetInfoType (); |
|
5
|
|
|
|
|
64682
|
|
|
5
|
|
|
|
|
169
|
|
7
|
|
|
|
|
|
|
|
8
|
5
|
|
|
5
|
|
8198
|
use SQL::Abstract 1.20; |
|
5
|
|
|
|
|
57681
|
|
|
5
|
|
|
|
|
188
|
|
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
57
|
use base 'SQL::Abstract'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
23942
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
SQL::Abstract::Limit - portable LIMIT emulation |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.141'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# additions / error reports welcome ! |
21
|
|
|
|
|
|
|
our %SyntaxMap = ( mssql => 'Top', |
22
|
|
|
|
|
|
|
access => 'Top', |
23
|
|
|
|
|
|
|
sybase => 'GenericSubQ', |
24
|
|
|
|
|
|
|
oracle => 'RowNum', |
25
|
|
|
|
|
|
|
db2 => 'FetchFirst', |
26
|
|
|
|
|
|
|
ingres => '', |
27
|
|
|
|
|
|
|
adabasd => '', |
28
|
|
|
|
|
|
|
informix => 'Skip', |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# asany => '', |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# more recent MySQL versions support LimitOffset as well |
33
|
|
|
|
|
|
|
mysql => 'LimitXY', |
34
|
|
|
|
|
|
|
mysqlpp => 'LimitXY', |
35
|
|
|
|
|
|
|
maxdb => 'LimitXY', # MySQL |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
pg => 'LimitOffset', |
38
|
|
|
|
|
|
|
pgpp => 'LimitOffset', |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sqlite => 'LimitOffset', |
41
|
|
|
|
|
|
|
sqlite2 => 'LimitOffset', |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
interbase => 'RowsTo', |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
unify => '', |
46
|
|
|
|
|
|
|
primebase => '', |
47
|
|
|
|
|
|
|
mimer => '', |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# anything that uses SQL::Statement can use LimitXY, I think |
50
|
|
|
|
|
|
|
sprite => 'LimitXY', |
51
|
|
|
|
|
|
|
wtsprite => 'LimitXY', |
52
|
|
|
|
|
|
|
anydata => 'LimitXY', |
53
|
|
|
|
|
|
|
csv => 'LimitXY', |
54
|
|
|
|
|
|
|
ram => 'LimitXY', |
55
|
|
|
|
|
|
|
dbm => 'LimitXY', |
56
|
|
|
|
|
|
|
excel => 'LimitXY', |
57
|
|
|
|
|
|
|
google => 'LimitXY', |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 SYNOPSIS |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
use SQL::Abstract::Limit; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $sql = SQL::Abstract::Limit->new( limit_dialect => 'LimitOffset' );; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# or autodetect from a DBI $dbh: |
68
|
|
|
|
|
|
|
my $sql = SQL::Abstract::Limit->new( limit_dialect => $dbh ); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# or from a Class::DBI class: |
71
|
|
|
|
|
|
|
my $sql = SQL::Abstract::Limit->new( limit_dialect => 'My::CDBI::App' ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# or object: |
74
|
|
|
|
|
|
|
my $obj = My::CDBI::App->retrieve( $id ); |
75
|
|
|
|
|
|
|
my $sql = SQL::Abstract::Limit->new( limit_dialect => $obj ); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# generate SQL: |
78
|
|
|
|
|
|
|
my ( $stmt, @bind ) = $sql->select( $table, \@fields, \%where, \@order, $limit, $offset ); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Then, use these in your DBI statements |
81
|
|
|
|
|
|
|
my $sth = $dbh->prepare( $stmt ); |
82
|
|
|
|
|
|
|
$sth->execute( @bind ); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# Just generate the WHERE clause (only available for some syntaxes) |
85
|
|
|
|
|
|
|
my ( $stmt, @bind ) = $sql->where( \%where, \@order, $limit, $offset ); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 DESCRIPTION |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Portability layer for LIMIT emulation. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=over 4 |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=item new( case => 'lower', cmp => 'like', logic => 'and', convert => 'upper', limit_dialect => 'Top' ) |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
All settings are optional. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=over 8 |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item limit_dialect |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Sets the default syntax model to use for emulating a C |
102
|
|
|
|
|
|
|
clause. Default setting is C. You can still pass other syntax |
103
|
|
|
|
|
|
|
settings in method calls, this just sets the default. Possible values are: |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
LimitOffset PostgreSQL, SQLite |
106
|
|
|
|
|
|
|
LimitXY MySQL, MaxDB, anything that uses SQL::Statement |
107
|
|
|
|
|
|
|
LimitYX SQLite (optional) |
108
|
|
|
|
|
|
|
RowsTo InterBase/FireBird |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Top SQL/Server, MS Access |
111
|
|
|
|
|
|
|
RowNum Oracle |
112
|
|
|
|
|
|
|
FetchFirst DB2 |
113
|
|
|
|
|
|
|
Skip Informix |
114
|
|
|
|
|
|
|
GenericSubQ Sybase, plus any databases not recognised by this module |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
$dbh a DBI database handle |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
CDBI subclass |
119
|
|
|
|
|
|
|
CDBI object |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
other DBI-based thing |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
The first group are implemented by appending a short clause to the end of the |
124
|
|
|
|
|
|
|
statement. The second group require more intricate wrapping of the original |
125
|
|
|
|
|
|
|
statement in subselects. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
You can pass a L database handle, and the module will figure out which |
128
|
|
|
|
|
|
|
dialect to use. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
You can pass a L subclass or object, and the module will |
131
|
|
|
|
|
|
|
find the C<$dbh> and use it to find the dialect. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Anything else based on L can be easily added by locating the C<$dbh>. |
134
|
|
|
|
|
|
|
Patches or suggestions welcome. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=back |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Other options are described in L. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item select( $table, \@fields, $where, [ \@order, [ $rows, [ $offset ], [ $dialect ] ] ] ) |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Same as C, but accepts additional C<$rows>, C<$offset> |
143
|
|
|
|
|
|
|
and C<$dialect> parameters. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
The C<$order> parameter is required if C<$rows> is specified. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
The C<$fields> parameter is required, but can be set to C, C<''> or |
148
|
|
|
|
|
|
|
C<'*'> (all these get set to C<'*'>). |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
The C<$where> parameter is also required. It can be a hashref |
151
|
|
|
|
|
|
|
or an arrayref, or C. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub select { |
156
|
11
|
|
|
11
|
1
|
267658
|
my $self = shift; |
157
|
11
|
|
|
|
|
114
|
my $table = $self->_table(shift); |
158
|
11
|
|
|
|
|
1286
|
my $fields = shift; |
159
|
11
|
|
|
|
|
23
|
my $where = shift; # if ref( $_[0] ) eq 'HASH'; |
160
|
|
|
|
|
|
|
|
161
|
11
|
|
|
|
|
61
|
my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ ); |
162
|
|
|
|
|
|
|
|
163
|
11
|
|
50
|
|
|
46
|
$fields ||= '*'; # in case someone supplies '' or undef |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# with no LIMIT parameters, defer to SQL::Abstract [ don't know why the first way fails ] |
166
|
|
|
|
|
|
|
# return $self->SUPER::select( $table, $fields, $where, $order ) unless $rows; |
167
|
11
|
100
|
|
|
|
64
|
return SQL::Abstract->new->select( $table, $fields, $where, $order ) unless $rows; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# with LIMIT parameters, get the basic SQL without the ORDER BY clause |
170
|
9
|
|
|
|
|
74
|
my ( $sql, @bind ) = $self->SUPER::select( $table, $fields, $where ); |
171
|
|
|
|
|
|
|
|
172
|
9
|
|
|
|
|
649
|
my $syntax_name = $self->_find_syntax( $syntax ); |
173
|
|
|
|
|
|
|
|
174
|
9
|
|
|
|
|
46
|
$sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset ); |
175
|
|
|
|
|
|
|
|
176
|
9
|
100
|
|
|
|
123
|
return wantarray ? ( $sql, @bind ) : $sql; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item where( [ $where, [ \@order, [ $rows, [ $offset ], [ $dialect ] ] ] ] ) |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Same as C, but accepts additional C<$rows>, C<$offset> |
182
|
|
|
|
|
|
|
and C<$dialect> parameters. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Some SQL dialects support syntaxes that can be applied as simple phrases |
185
|
|
|
|
|
|
|
tacked on to the end of the WHERE clause. These are: |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
LimitOffset |
188
|
|
|
|
|
|
|
LimitXY |
189
|
|
|
|
|
|
|
LimitYX |
190
|
|
|
|
|
|
|
RowsTo |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
This method returns a modified WHERE clause, if the limit syntax is set to one |
193
|
|
|
|
|
|
|
of these options (either in the call to C or in the constructor), and |
194
|
|
|
|
|
|
|
if C<$rows> is passed in. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Dies via C if you try to use it for other syntaxes. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
C<$order> is required if C<$rows> is set. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
C<$where> is required if any other parameters are specified. It can be a hashref |
201
|
|
|
|
|
|
|
or an arrayref, or C. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
Returns a regular C clause if no limits are set. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=cut |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub where |
208
|
|
|
|
|
|
|
{ |
209
|
10
|
|
|
10
|
1
|
3090
|
my $self = shift; |
210
|
10
|
|
|
|
|
25
|
my $where = shift; # if ref( $_[0] ) eq 'HASH'; |
211
|
|
|
|
|
|
|
|
212
|
10
|
|
|
|
|
33
|
my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ ); |
213
|
|
|
|
|
|
|
|
214
|
10
|
|
|
|
|
22
|
my ( $sql, @bind ); |
215
|
|
|
|
|
|
|
|
216
|
10
|
50
|
|
|
|
30
|
if ( $rows ) |
217
|
|
|
|
|
|
|
{ |
218
|
0
|
|
|
|
|
0
|
( $sql, @bind ) = $self->SUPER::where( $where ); |
219
|
|
|
|
|
|
|
|
220
|
0
|
|
|
|
|
0
|
my $syntax_name = $self->_find_syntax( $syntax ); |
221
|
|
|
|
|
|
|
|
222
|
0
|
0
|
|
|
|
0
|
Carp::croak( "can't build a stand-alone WHERE clause for $syntax_name" ) |
223
|
|
|
|
|
|
|
unless $syntax_name =~ /(?:LimitOffset|LimitXY|LimitYX|RowsTo)/i; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
0
|
$sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset ); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
else |
228
|
|
|
|
|
|
|
{ |
229
|
|
|
|
|
|
|
# |
230
|
10
|
|
|
|
|
75
|
( $sql, @bind ) = $self->SUPER::where( $where, $order ); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
10
|
100
|
|
|
|
11992
|
return wantarray ? ( $sql, @bind ) : $sql; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub _get_args { |
237
|
21
|
|
|
21
|
|
36
|
my $self = shift; |
238
|
|
|
|
|
|
|
|
239
|
21
|
|
|
|
|
41
|
my $order = shift; |
240
|
21
|
|
|
|
|
35
|
my $rows = shift; |
241
|
21
|
100
|
66
|
|
|
139
|
my $offset = shift if ( $_[0] && $_[0] =~ /^\d+$/ ); |
242
|
21
|
|
66
|
|
|
104
|
my $syntax = shift || $self->_default_limit_syntax; |
243
|
|
|
|
|
|
|
|
244
|
21
|
|
|
|
|
82
|
return $order, $rows, $offset, $syntax; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item insert |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item update |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=item delete |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item values |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item generate |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
See L for these methods. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
C and C are not provided with any C emulation in this |
260
|
|
|
|
|
|
|
release, and no support is planned at the moment. But patches would be welcome. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=back |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=cut |
265
|
|
|
|
|
|
|
|
266
|
14
|
100
|
|
14
|
|
92
|
sub _default_limit_syntax { $_[0]->{limit_dialect} || 'GenericSubQ' } |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _emulate_limit { |
269
|
9
|
|
|
9
|
|
25
|
my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_; |
270
|
|
|
|
|
|
|
|
271
|
9
|
|
50
|
|
|
32
|
$offset ||= 0; |
272
|
|
|
|
|
|
|
|
273
|
9
|
50
|
|
|
|
54
|
Carp::croak( "rows must be a number (got $rows)" ) unless $rows =~ /^\d+$/; |
274
|
9
|
50
|
|
|
|
50
|
Carp::croak( "offset must be a number (got $offset)" ) unless $offset =~ /^\d+$/; |
275
|
|
|
|
|
|
|
|
276
|
9
|
|
66
|
|
|
76
|
my $method = $self->can( 'emulate_limit' ) || "_$syntax"; |
277
|
|
|
|
|
|
|
|
278
|
9
|
|
|
|
|
160
|
$sql = $self->$method( $sql, $order, $rows, $offset ); |
279
|
|
|
|
|
|
|
|
280
|
9
|
|
|
|
|
30
|
return $sql; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub _find_syntax |
284
|
|
|
|
|
|
|
{ |
285
|
9
|
|
|
9
|
|
21
|
my ($self, $syntax) = @_; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# $syntax is a dialect name, database name, $dbh, or CDBI class or object |
288
|
|
|
|
|
|
|
|
289
|
9
|
50
|
|
|
|
32
|
Carp::croak('no syntax') unless $syntax; |
290
|
|
|
|
|
|
|
|
291
|
9
|
|
|
|
|
19
|
my $db; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# note: tests arranged so that the eval isn't run against a scalar $syntax |
294
|
|
|
|
|
|
|
# see rt #15000 |
295
|
9
|
50
|
|
|
|
25
|
if (ref $syntax) # a $dbh or a CDBI object |
296
|
|
|
|
|
|
|
{ |
297
|
0
|
0
|
|
|
|
0
|
if ( UNIVERSAL::isa($syntax => 'Class::DBI') ) |
|
|
0
|
|
|
|
|
|
298
|
|
|
|
|
|
|
{ |
299
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_cdbi($syntax); |
300
|
|
|
|
|
|
|
} |
301
|
0
|
|
|
|
|
0
|
elsif ( eval { $syntax->{Driver}->{Name} } ) # or use isa DBI::db ? |
302
|
|
|
|
|
|
|
{ |
303
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_dbh($syntax); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else # string - CDBI class, db name, or dialect name |
307
|
|
|
|
|
|
|
{ |
308
|
9
|
50
|
|
|
|
88
|
if (exists $SyntaxMap{lc $syntax}) |
|
|
50
|
|
|
|
|
|
309
|
|
|
|
|
|
|
{ |
310
|
|
|
|
|
|
|
# the name of a database |
311
|
0
|
|
|
|
|
0
|
$db = $syntax; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
elsif (UNIVERSAL::isa($syntax => 'Class::DBI')) |
314
|
|
|
|
|
|
|
{ |
315
|
|
|
|
|
|
|
# a CDBI class |
316
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_cdbi($syntax); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
else |
319
|
|
|
|
|
|
|
{ |
320
|
|
|
|
|
|
|
# or it's already a syntax dialect |
321
|
9
|
|
|
|
|
26
|
return $syntax; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
0
|
0
|
|
|
|
0
|
return $self->_find_syntax_from_database($db) if $db; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# if you get here, you might like to provide a patch to determine the |
328
|
|
|
|
|
|
|
# syntax model for your object or ref e.g. by getting at the $dbh stored in it |
329
|
0
|
|
|
|
|
0
|
warn "can't determine syntax model for $syntax - using default"; |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
0
|
return $self->_default_limit_syntax; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# most of this code modified from DBIx::AnyDBD::rebless |
335
|
|
|
|
|
|
|
sub _find_database_from_dbh { |
336
|
0
|
|
|
0
|
|
0
|
my ( $self, $dbh ) = @_; |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
0
|
|
|
0
|
my $driver = ucfirst( $dbh->{Driver}->{Name} ) || Carp::croak( "no driver in $dbh" ); |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
0
|
if ( $driver eq 'Proxy' ) |
341
|
|
|
|
|
|
|
{ |
342
|
|
|
|
|
|
|
# Looking into the internals of DBD::Proxy is maybe a little questionable |
343
|
0
|
|
|
|
|
0
|
( $driver ) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# what about DBD::JDBC ? |
347
|
0
|
|
|
|
|
0
|
my ( $odbc, $ado ) = ( $driver eq 'ODBC', $driver eq 'ADO' ); |
348
|
|
|
|
|
|
|
|
349
|
0
|
0
|
0
|
|
|
0
|
if ( $odbc || $ado ) |
350
|
|
|
|
|
|
|
{ |
351
|
0
|
|
|
|
|
0
|
my $name; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# $name = $dbh->func( 17, 'GetInfo' ) if $odbc; |
354
|
0
|
0
|
|
|
|
0
|
$name = $dbh->get_info( $DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_NAME} ) if $odbc; |
355
|
0
|
0
|
|
|
|
0
|
$name = $dbh->{ado_conn}->Properties->Item( 'DBMS Name' )->Value if $ado; |
356
|
|
|
|
|
|
|
|
357
|
0
|
0
|
|
|
|
0
|
die "can't determine driver name for ODBC or ADO handle: $dbh" unless $name; |
358
|
|
|
|
|
|
|
|
359
|
0
|
0
|
|
|
|
0
|
CASE: { |
360
|
0
|
|
|
|
|
0
|
$driver = 'MSSQL', last CASE if $name eq 'Microsoft SQL Server'; |
361
|
0
|
0
|
|
|
|
0
|
$driver = 'Sybase', last CASE if $name eq 'SQL Server'; |
362
|
0
|
0
|
|
|
|
0
|
$driver = 'Oracle', last CASE if $name =~ /Oracle/; |
363
|
0
|
0
|
|
|
|
0
|
$driver = 'ASAny', last CASE if $name eq 'Adaptive Server Anywhere'; |
364
|
0
|
0
|
|
|
|
0
|
$driver = 'AdabasD', last CASE if $name eq 'ADABAS D'; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# this should catch Access (ACCESS) and Informix (Informix) |
367
|
0
|
|
|
|
|
0
|
$driver = lc( $name ); |
368
|
0
|
|
|
|
|
0
|
$driver =~ s/\b(\w)/uc($1)/eg; |
|
0
|
|
|
|
|
0
|
|
369
|
0
|
|
|
|
|
0
|
$driver =~ s/\s+/_/g; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
0
|
0
|
|
|
|
0
|
die "couldn't find DBD driver in $dbh" unless $driver; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# $driver now holds a string identifying the database server - in the future, |
376
|
|
|
|
|
|
|
# it might return an object with extra information e.g. version |
377
|
0
|
|
|
|
|
0
|
return $driver; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# $cdbi can be a class or object |
381
|
|
|
|
|
|
|
sub _find_database_from_cdbi |
382
|
|
|
|
|
|
|
{ |
383
|
0
|
|
|
0
|
|
0
|
my ($self, $cdbi) = @_; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# inherits from Ima::DBI |
386
|
0
|
|
|
|
|
0
|
my ($dbh) = $cdbi->db_handles; |
387
|
|
|
|
|
|
|
|
388
|
0
|
0
|
|
|
|
0
|
Carp::croak "no \$dbh in $cdbi" unless $dbh; |
389
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
0
|
return $self->_find_database_from_dbh($dbh); |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# currently expects a string (database moniker), but this may become an object |
394
|
|
|
|
|
|
|
# with e.g. version string etc. |
395
|
|
|
|
|
|
|
sub _find_syntax_from_database { |
396
|
0
|
|
|
0
|
|
0
|
my ( $self, $db ) = @_; |
397
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
0
|
my $syntax = $SyntaxMap{ lc( $db ) }; |
399
|
|
|
|
|
|
|
|
400
|
0
|
0
|
|
|
|
0
|
return $syntax if $syntax; |
401
|
|
|
|
|
|
|
|
402
|
0
|
0
|
|
|
|
0
|
my $msg = defined $syntax ? |
403
|
|
|
|
|
|
|
"no dialect known for $db - using GenericSubQ dialect" : |
404
|
|
|
|
|
|
|
"unknown database $db - using GenericSubQ dialect"; |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
0
|
warn $msg; |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
0
|
return 'GenericSubQ'; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# DBIx::SearchBuilder LIMIT emulation: |
412
|
|
|
|
|
|
|
# Oracle - RowNum |
413
|
|
|
|
|
|
|
# Pg - LimitOffset |
414
|
|
|
|
|
|
|
# Sybase - doesn't emulate |
415
|
|
|
|
|
|
|
# Informix - First - but can only retrieve 1st page |
416
|
|
|
|
|
|
|
# SQLite - default |
417
|
|
|
|
|
|
|
# MySQL - default |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# default - LIMIT $offset, $rows |
420
|
|
|
|
|
|
|
# or LIMIT $rows |
421
|
|
|
|
|
|
|
# if $offset == 0 |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# DBIx::Compat also tries, but only for the easy ones |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# --------------------------------- |
427
|
|
|
|
|
|
|
# LIMIT emulation routines |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# utility for some emulations |
430
|
|
|
|
|
|
|
sub _order_directions { |
431
|
3
|
|
|
3
|
|
7
|
my ( $self, $order ) = @_; |
432
|
|
|
|
|
|
|
|
433
|
3
|
50
|
|
|
|
9
|
return unless $order; |
434
|
|
|
|
|
|
|
|
435
|
3
|
|
|
|
|
8
|
my $ref = ref $order; |
436
|
|
|
|
|
|
|
|
437
|
3
|
|
|
|
|
5
|
my @order; |
438
|
|
|
|
|
|
|
|
439
|
3
|
50
|
|
|
|
22
|
CASE: { |
440
|
3
|
|
|
|
|
5
|
@order = @$order, last CASE if $ref eq 'ARRAY'; |
441
|
0
|
0
|
|
|
|
0
|
@order = ( $order ), last CASE unless $ref; |
442
|
0
|
0
|
|
|
|
0
|
@order = ( $$order ), last CASE if $ref eq 'SCALAR'; |
443
|
0
|
|
|
|
|
0
|
Carp::croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY"; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
3
|
|
|
|
|
4
|
my ( $order_by_up, $order_by_down ); |
447
|
|
|
|
|
|
|
|
448
|
3
|
|
|
|
|
10
|
foreach my $spec ( @order ) |
449
|
|
|
|
|
|
|
{ |
450
|
6
|
|
|
|
|
18
|
my @spec = split ' ', $spec; |
451
|
6
|
50
|
|
|
|
16
|
Carp::croak( "bad column order spec: $spec" ) if @spec > 2; |
452
|
6
|
50
|
|
|
|
20
|
push( @spec, 'ASC' ) unless @spec == 2; |
453
|
6
|
|
|
|
|
11
|
my ( $col, $up ) = @spec; # or maybe down |
454
|
6
|
|
|
|
|
12
|
$up = uc( $up ); |
455
|
6
|
50
|
|
|
|
31
|
Carp::croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/; |
456
|
6
|
|
|
|
|
14
|
$order_by_up .= ", $col $up"; |
457
|
6
|
50
|
|
|
|
16
|
my $down = $up eq 'ASC' ? 'DESC' : 'ASC'; |
458
|
6
|
|
|
|
|
22
|
$order_by_down .= ", $col $down"; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
3
|
|
|
|
|
26
|
s/^,/ORDER BY/ for ( $order_by_up, $order_by_down ); |
462
|
|
|
|
|
|
|
|
463
|
3
|
|
|
|
|
12
|
return $order_by_up, $order_by_down; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# From http://phplens.com/lens/adodb/tips_portable_sql.htm |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# When writing SQL to retrieve the first 10 rows for paging, you could write... |
469
|
|
|
|
|
|
|
# Database SQL Syntax |
470
|
|
|
|
|
|
|
# DB2 select * from table fetch first 10 rows only |
471
|
|
|
|
|
|
|
# Informix select first 10 * from table |
472
|
|
|
|
|
|
|
# Microsoft SQL Server and Access select top 10 * from table |
473
|
|
|
|
|
|
|
# MySQL and PostgreSQL select * from table limit 10 |
474
|
|
|
|
|
|
|
# Oracle 8i select * from (select * from table) where rownum <= 10 |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head2 Limit emulation |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
The following dialects are available for emulating the LIMIT clause. In each |
479
|
|
|
|
|
|
|
case, C<$sql> represents the SQL statement generated by C, |
480
|
|
|
|
|
|
|
minus the ORDER BY clause, e.g. |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
SELECT foo, bar FROM my_table WHERE some_conditions |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
C<$sql_after_select> represents C<$sql> with the leading C |
485
|
|
|
|
|
|
|
removed. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
C represents the sort column(s) and direction(s) specified in |
488
|
|
|
|
|
|
|
the C parameter. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
C represents the opposite sort. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
C<$last = $rows + $offset> |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=over 4 |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
=item LimitOffset |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=over 8 |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=item Syntax |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows OFFSET $offset |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
or |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
if C<$offset == 0>. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=item Databases |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
PostgreSQL |
513
|
|
|
|
|
|
|
SQLite |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=back |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=cut |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
sub _LimitOffset { |
520
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
521
|
1
|
|
|
|
|
29
|
$sql .= $self->_order_by( $order ) . " LIMIT $rows"; |
522
|
1
|
50
|
|
|
|
283
|
$sql .= " OFFSET $offset" if +$offset; |
523
|
1
|
|
|
|
|
8
|
return $sql; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=item LimitXY |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=over 8 |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=item Syntax |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $offset, $rows |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
or |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
if C<$offset == 0>. |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=item Databases |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
MySQL |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=back |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=cut |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
sub _LimitXY { |
549
|
1
|
|
|
1
|
|
3
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
550
|
1
|
|
|
|
|
7
|
$sql .= $self->_order_by( $order ) . " LIMIT "; |
551
|
1
|
50
|
|
|
|
245
|
$sql .= "$offset, " if +$offset; |
552
|
1
|
|
|
|
|
2
|
$sql .= $rows; |
553
|
1
|
|
|
|
|
3
|
return $sql; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=item LimitYX |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=over 8 |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=item Syntax |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows, $offset |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
or |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
if C<$offset == 0>. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=item Databases |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
SQLite understands this syntax, or LimitOffset. If autodetecting the |
573
|
|
|
|
|
|
|
dialect, it will be set to LimitOffset. |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=back |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=cut |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub _LimitYX { |
580
|
0
|
|
|
0
|
|
0
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
581
|
0
|
|
|
|
|
0
|
$sql .= $self->_order_by( $order ) . " LIMIT $rows"; |
582
|
0
|
0
|
|
|
|
0
|
$sql .= " $offset" if +$offset; |
583
|
0
|
|
|
|
|
0
|
return $sql; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=item RowsTo |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=over 8 |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=item Syntax |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up ROWS $offset TO $last |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=item Databases |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
InterBase |
597
|
|
|
|
|
|
|
FireBird |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=back |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=cut |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
# InterBase/FireBird |
604
|
|
|
|
|
|
|
sub _RowsTo { |
605
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
606
|
1
|
|
|
|
|
4
|
my $last = $rows + $offset; |
607
|
1
|
|
|
|
|
9
|
$sql .= $self->_order_by( $order ) . " ROWS $offset TO $last"; |
608
|
1
|
|
|
|
|
238
|
return $sql; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=item Top |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=over 8 |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=item Syntax |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
SELECT * FROM |
618
|
|
|
|
|
|
|
( |
619
|
|
|
|
|
|
|
SELECT TOP $rows * FROM |
620
|
|
|
|
|
|
|
( |
621
|
|
|
|
|
|
|
SELECT TOP $last $sql_after_select |
622
|
|
|
|
|
|
|
ORDER BY order_cols_up |
623
|
|
|
|
|
|
|
) AS foo |
624
|
|
|
|
|
|
|
ORDER BY order_cols_down |
625
|
|
|
|
|
|
|
) AS bar |
626
|
|
|
|
|
|
|
ORDER BY order_cols_up |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=item Databases |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
SQL/Server |
632
|
|
|
|
|
|
|
MS Access |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=back |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
=cut |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub _Top { |
639
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
640
|
|
|
|
|
|
|
|
641
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset; |
642
|
|
|
|
|
|
|
|
643
|
1
|
|
|
|
|
6
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order ); |
644
|
|
|
|
|
|
|
|
645
|
1
|
|
|
|
|
7
|
$sql =~ s/^\s*(SELECT|select)//; |
646
|
|
|
|
|
|
|
|
647
|
1
|
|
|
|
|
8
|
$sql = <<""; |
648
|
|
|
|
|
|
|
SELECT * FROM |
649
|
|
|
|
|
|
|
( |
650
|
|
|
|
|
|
|
SELECT TOP $rows * FROM |
651
|
|
|
|
|
|
|
( |
652
|
|
|
|
|
|
|
SELECT TOP $last $sql $order_by_up |
653
|
|
|
|
|
|
|
) AS foo |
654
|
|
|
|
|
|
|
$order_by_down |
655
|
|
|
|
|
|
|
) AS bar |
656
|
|
|
|
|
|
|
$order_by_up |
657
|
|
|
|
|
|
|
|
658
|
1
|
|
|
|
|
3
|
return $sql; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item RowNum |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=over 8 |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=item Syntax |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Oracle numbers rows from 1, not zero, so here $offset has been incremented by 1. |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
SELECT * FROM |
672
|
|
|
|
|
|
|
( |
673
|
|
|
|
|
|
|
SELECT A.*, ROWNUM r FROM |
674
|
|
|
|
|
|
|
( |
675
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up |
676
|
|
|
|
|
|
|
) A |
677
|
|
|
|
|
|
|
WHERE ROWNUM <= $last |
678
|
|
|
|
|
|
|
) B |
679
|
|
|
|
|
|
|
WHERE r >= $offset |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=item Databases |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Oracle |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=back |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=cut |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub _RowNum { |
690
|
1
|
|
|
1
|
|
3
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
# Oracle orders from 1 not zero |
693
|
1
|
|
|
|
|
3
|
$offset++; |
694
|
|
|
|
|
|
|
|
695
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset; |
696
|
|
|
|
|
|
|
|
697
|
1
|
|
|
|
|
7
|
my $order_by = $self->_order_by( $order ); |
698
|
|
|
|
|
|
|
|
699
|
1
|
|
|
|
|
249
|
$sql = <<""; |
700
|
|
|
|
|
|
|
SELECT * FROM |
701
|
|
|
|
|
|
|
( |
702
|
|
|
|
|
|
|
SELECT A.*, ROWNUM r FROM |
703
|
|
|
|
|
|
|
( |
704
|
|
|
|
|
|
|
$sql $order_by |
705
|
|
|
|
|
|
|
) A |
706
|
|
|
|
|
|
|
WHERE ROWNUM < $last |
707
|
|
|
|
|
|
|
) B |
708
|
|
|
|
|
|
|
WHERE r >= $offset |
709
|
|
|
|
|
|
|
|
710
|
1
|
|
|
|
|
3
|
return $sql; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
# DBIx::SearchBuilder::Handle::Oracle does this: |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# Transform an SQL query from: |
716
|
|
|
|
|
|
|
# |
717
|
|
|
|
|
|
|
# SELECT main.* |
718
|
|
|
|
|
|
|
# FROM Tickets main |
719
|
|
|
|
|
|
|
# WHERE ((main.EffectiveId = main.id)) |
720
|
|
|
|
|
|
|
# AND ((main.Type = 'ticket')) |
721
|
|
|
|
|
|
|
# AND ( ( (main.Status = 'new')OR(main.Status = 'open') ) |
722
|
|
|
|
|
|
|
# AND ( (main.Queue = '1') ) ) |
723
|
|
|
|
|
|
|
# |
724
|
|
|
|
|
|
|
# to: |
725
|
|
|
|
|
|
|
# |
726
|
|
|
|
|
|
|
# SELECT * FROM ( |
727
|
|
|
|
|
|
|
# SELECT limitquery.*,rownum limitrownum FROM ( |
728
|
|
|
|
|
|
|
# SELECT main.* |
729
|
|
|
|
|
|
|
# FROM Tickets main |
730
|
|
|
|
|
|
|
# WHERE ((main.EffectiveId = main.id)) |
731
|
|
|
|
|
|
|
# AND ((main.Type = 'ticket')) |
732
|
|
|
|
|
|
|
# AND ( ( (main.Status = 'new')OR(main.Status = 'open') ) |
733
|
|
|
|
|
|
|
# AND ( (main.Queue = '1') ) ) |
734
|
|
|
|
|
|
|
# ) limitquery WHERE rownum <= 50 |
735
|
|
|
|
|
|
|
# ) WHERE limitrownum >= 1 |
736
|
|
|
|
|
|
|
# |
737
|
|
|
|
|
|
|
#if ($per_page) { |
738
|
|
|
|
|
|
|
# # Oracle orders from 1 not zero |
739
|
|
|
|
|
|
|
# $first++; |
740
|
|
|
|
|
|
|
# # Make current query a sub select |
741
|
|
|
|
|
|
|
# $$statementref = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= " . ($first + $per_page - 1) . " ) WHERE limitrownum >= " . $first; |
742
|
|
|
|
|
|
|
#} |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
# DBIx::SQLEngine::Driver::Oracle does this: |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
#sub sql_limit { |
747
|
|
|
|
|
|
|
# my $self = shift; |
748
|
|
|
|
|
|
|
# my ( $limit, $offset, $sql, @params ) = @_; |
749
|
|
|
|
|
|
|
# |
750
|
|
|
|
|
|
|
# # remove tablealiases and group-functions from outer query properties |
751
|
|
|
|
|
|
|
# my ($properties) = ($sql =~ /^\s*SELECT\s(.*?)\sFROM\s/i); |
752
|
|
|
|
|
|
|
# $properties =~ s/[^\s]+\s*as\s*//ig; |
753
|
|
|
|
|
|
|
# $properties =~ s/\w+\.//g; |
754
|
|
|
|
|
|
|
# |
755
|
|
|
|
|
|
|
# $offset ||= 0; |
756
|
|
|
|
|
|
|
# my $position = ( $offset + $limit ); |
757
|
|
|
|
|
|
|
# |
758
|
|
|
|
|
|
|
# $sql = <<""; |
759
|
|
|
|
|
|
|
#SELECT $properties FROM ( |
760
|
|
|
|
|
|
|
# SELECT $properties, ROWNUM AS sqle_position FROM ( |
761
|
|
|
|
|
|
|
# $sql |
762
|
|
|
|
|
|
|
# ) |
763
|
|
|
|
|
|
|
#) |
764
|
|
|
|
|
|
|
#WHERE sqle_position > $offset AND sqle_position <= $position |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
# |
768
|
|
|
|
|
|
|
# return ($sql, @params); |
769
|
|
|
|
|
|
|
#} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=item FetchFirst |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=over 8 |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
=item Syntax |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
SELECT * FROM ( |
778
|
|
|
|
|
|
|
SELECT * FROM ( |
779
|
|
|
|
|
|
|
$sql |
780
|
|
|
|
|
|
|
ORDER BY order_cols_up |
781
|
|
|
|
|
|
|
FETCH FIRST $last ROWS ONLY |
782
|
|
|
|
|
|
|
) foo |
783
|
|
|
|
|
|
|
ORDER BY order_cols_down |
784
|
|
|
|
|
|
|
FETCH FIRST $rows ROWS ONLY |
785
|
|
|
|
|
|
|
) bar |
786
|
|
|
|
|
|
|
ORDER BY order_cols_up |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=item Databases |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
IBM DB2 |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=back |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=cut |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
sub _FetchFirst { |
797
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
798
|
|
|
|
|
|
|
|
799
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset; |
800
|
|
|
|
|
|
|
|
801
|
1
|
|
|
|
|
6
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order ); |
802
|
|
|
|
|
|
|
|
803
|
1
|
|
|
|
|
7
|
$sql = <<""; |
804
|
|
|
|
|
|
|
SELECT * FROM ( |
805
|
|
|
|
|
|
|
SELECT * FROM ( |
806
|
|
|
|
|
|
|
$sql |
807
|
|
|
|
|
|
|
$order_by_up |
808
|
|
|
|
|
|
|
FETCH FIRST $last ROWS ONLY |
809
|
|
|
|
|
|
|
) foo |
810
|
|
|
|
|
|
|
$order_by_down |
811
|
|
|
|
|
|
|
FETCH FIRST $rows ROWS ONLY |
812
|
|
|
|
|
|
|
) bar |
813
|
|
|
|
|
|
|
$order_by_up |
814
|
|
|
|
|
|
|
|
815
|
1
|
|
|
|
|
3
|
return $sql; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=item GenericSubQ |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
When all else fails, this should work for many databases, but it is probably |
821
|
|
|
|
|
|
|
fairly slow. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
This method relies on having a column with unique values as the first column in |
824
|
|
|
|
|
|
|
the C |
825
|
|
|
|
|
|
|
results will be sorted by that unique column, so any C<$order> parameter is |
826
|
|
|
|
|
|
|
ignored, unless it matches the unique column, in which case the direction of |
827
|
|
|
|
|
|
|
the sort is honoured. |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=over 8 |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item Syntax |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
SELECT field_list FROM $table X WHERE where_clause AND |
834
|
|
|
|
|
|
|
( |
835
|
|
|
|
|
|
|
SELECT COUNT(*) FROM $table WHERE $pk > X.$pk |
836
|
|
|
|
|
|
|
) |
837
|
|
|
|
|
|
|
BETWEEN $offset AND $last |
838
|
|
|
|
|
|
|
ORDER BY $pk $asc_desc |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
C<$pk> is the first column in C. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
C<$asc_desc> is the opposite direction to that specified in the method call. So |
843
|
|
|
|
|
|
|
if you want the final results sorted C, say so, and it gets flipped |
844
|
|
|
|
|
|
|
internally, but the results come out as you'd expect. I think. |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
The C clause is replaced with C $rows> if |
847
|
|
|
|
|
|
|
<$offset == 0>. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item Databases |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Sybase |
852
|
|
|
|
|
|
|
Anything not otherwise known to this module. |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=back |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=cut |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
sub _GenericSubQ { |
859
|
1
|
|
|
1
|
|
3
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
860
|
|
|
|
|
|
|
|
861
|
1
|
|
|
|
|
4
|
my $last = $rows + $offset; |
862
|
|
|
|
|
|
|
|
863
|
1
|
|
|
|
|
9
|
my $order_by = $self->_order_by( $order ); |
864
|
|
|
|
|
|
|
|
865
|
1
|
|
|
|
|
312
|
my ( $pk, $table ) = $sql =~ /^\s*SELECT\s+(\w+),?.*\sFROM\s+([\w]+)/i; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
#warn "pk: $pk"; |
868
|
|
|
|
|
|
|
#warn "table: $table"; |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
# get specified sort order and swap it to get the expected output (I think?) |
871
|
1
|
|
|
|
|
48
|
my ( $asc_desc ) = $order_by =~ /\b$pk\s+(ASC|DESC)\s*/i; |
872
|
1
|
|
50
|
|
|
66
|
$asc_desc = uc( $asc_desc ) || 'ASC'; |
873
|
1
|
50
|
|
|
|
6
|
$asc_desc = $asc_desc eq 'ASC' ? 'DESC' : 'ASC'; |
874
|
|
|
|
|
|
|
|
875
|
1
|
|
|
|
|
23
|
$sql =~ s/FROM $table /FROM $table X /; |
876
|
|
|
|
|
|
|
|
877
|
1
|
50
|
|
|
|
7
|
my $limit = $offset ? "BETWEEN $offset AND $last" : "< $rows"; |
878
|
|
|
|
|
|
|
|
879
|
1
|
|
|
|
|
8
|
$sql = <<""; |
880
|
|
|
|
|
|
|
$sql AND |
881
|
|
|
|
|
|
|
( |
882
|
|
|
|
|
|
|
SELECT COUNT(*) FROM $table WHERE $pk > X.$pk |
883
|
|
|
|
|
|
|
) |
884
|
|
|
|
|
|
|
$limit |
885
|
|
|
|
|
|
|
ORDER BY $pk $asc_desc |
886
|
|
|
|
|
|
|
|
887
|
1
|
|
|
|
|
7
|
return $sql; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=begin notes |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
1st page: |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
SELECT id, field1, fieldn |
896
|
|
|
|
|
|
|
FROM table_xyz X |
897
|
|
|
|
|
|
|
WHERE |
898
|
|
|
|
|
|
|
( |
899
|
|
|
|
|
|
|
SELECT COUNT(*) FROM table_xyz WHERE id > X.id |
900
|
|
|
|
|
|
|
) |
901
|
|
|
|
|
|
|
< 100 |
902
|
|
|
|
|
|
|
ORDER BY id DESC |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Next page: |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
SELECT id, field1, fieldn |
907
|
|
|
|
|
|
|
FROM table_xyz X |
908
|
|
|
|
|
|
|
WHERE |
909
|
|
|
|
|
|
|
( |
910
|
|
|
|
|
|
|
SELECT COUNT(*) FROM table_xyz WHERE id > X.id |
911
|
|
|
|
|
|
|
) |
912
|
|
|
|
|
|
|
BETWEEN 100 AND 199 |
913
|
|
|
|
|
|
|
ORDER BY id DESC |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
http://expertanswercenter.techtarget.com/eac/knowledgebaseAnswer/0,,sid63_gci978197,00.html |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
We can adapt the generic Top N query to this task. I would not use the generic |
919
|
|
|
|
|
|
|
method when TOP or LIMIT is available, but you're right, the previous answer |
920
|
|
|
|
|
|
|
is incomplete without this. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
Using the same table and column names, the top 100 ids are given by: |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
SELECT id, field1, fieldn FROM table_xyz X |
925
|
|
|
|
|
|
|
WHERE ( SELECT COUNT(*) |
926
|
|
|
|
|
|
|
FROM table_xyz |
927
|
|
|
|
|
|
|
WHERE id > X.id ) < 100 |
928
|
|
|
|
|
|
|
ORDER BY id DESC |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
The subquery is correlated, which means that it will be evaluated for each row |
931
|
|
|
|
|
|
|
of the outer query. The subquery says "count the number of rows that have an |
932
|
|
|
|
|
|
|
id that is greater than this id." Note that the sort order is descending, so |
933
|
|
|
|
|
|
|
we are looking for ids that are greater, i.e. higher up in the result set. If |
934
|
|
|
|
|
|
|
that number is less than 100, then this row must be one of the top 100. Simple, |
935
|
|
|
|
|
|
|
eh? Unfortunately, it runs quite slowly. Furthermore, it takes ties into |
936
|
|
|
|
|
|
|
consideration, which is good, but this means that the number of rows returned |
937
|
|
|
|
|
|
|
isn't always going to be exactly 100 -- there will be extra rows if there are |
938
|
|
|
|
|
|
|
ties extending across the 100th place. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
Next, we need the second set of 100: |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
select id |
943
|
|
|
|
|
|
|
, field1 |
944
|
|
|
|
|
|
|
, fieldn |
945
|
|
|
|
|
|
|
from table_xyz X |
946
|
|
|
|
|
|
|
where ( select count(*) |
947
|
|
|
|
|
|
|
from table_xyz |
948
|
|
|
|
|
|
|
where id > X.id ) between 100 and 199 |
949
|
|
|
|
|
|
|
order by id desc |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
See the pattern? Note that the same caveat applies about ties that extend |
952
|
|
|
|
|
|
|
across 200th place. |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=end notes |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=begin notes |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=item First |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=over 8 |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=item Syntax |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
Looks to be identical to C, e.g. C |
966
|
|
|
|
|
|
|
probably be implemented in a very similar way, but not done yet. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=item Databases |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
Informix |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=back |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
sub _First { |
976
|
|
|
|
|
|
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
977
|
|
|
|
|
|
|
die 'FIRST not implemented'; |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
# fetch first 20 rows |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
# might need to add to regex in 'where' method |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
} |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=end notes |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=cut |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=item Skip |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=over 8 |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=item Syntax |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
select skip 5 limit 5 * from customer |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
which will take rows 6 through 10 in the select. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=item Databases |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
Informix |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=back |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
=cut |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
sub _Skip { |
1008
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_; |
1009
|
|
|
|
|
|
|
|
1010
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset; |
1011
|
|
|
|
|
|
|
|
1012
|
1
|
|
|
|
|
6
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order ); |
1013
|
|
|
|
|
|
|
|
1014
|
1
|
|
|
|
|
7
|
$sql =~ s/^\s*(SELECT|select)//; |
1015
|
|
|
|
|
|
|
|
1016
|
1
|
|
|
|
|
11
|
$sql = "select skip $offset limit $rows ".$sql." ".$self->_order_by( $order ); |
1017
|
|
|
|
|
|
|
|
1018
|
1
|
|
|
|
|
277
|
return $sql; |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
1; |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
__END__ |