line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SQL::Abstract::Limit;
|
2
|
5
|
|
|
5
|
|
329696
|
use strict;
|
|
5
|
|
|
|
|
44
|
|
|
5
|
|
|
|
|
137
|
|
3
|
5
|
|
|
5
|
|
23
|
use warnings;
|
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
107
|
|
4
|
5
|
|
|
5
|
|
22
|
use Carp();
|
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
74
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
2086
|
use DBI::Const::GetInfoType ();
|
|
5
|
|
|
|
|
26244
|
|
|
5
|
|
|
|
|
147
|
|
7
|
|
|
|
|
|
|
|
8
|
5
|
|
|
5
|
|
3485
|
use SQL::Abstract 1.20;
|
|
5
|
|
|
|
|
52953
|
|
|
5
|
|
|
|
|
334
|
|
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
49
|
use base 'SQL::Abstract';
|
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
12790
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
SQL::Abstract::Limit - portable LIMIT emulation
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.142';
|
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
|
155413
|
my $self = shift;
|
157
|
11
|
|
|
|
|
25
|
my $table = shift;
|
158
|
11
|
|
|
|
|
19
|
my $fields = shift;
|
159
|
11
|
|
|
|
|
19
|
my $where = shift; # if ref( $_[0] ) eq 'HASH';
|
160
|
|
|
|
|
|
|
|
161
|
11
|
|
|
|
|
37
|
my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
|
162
|
|
|
|
|
|
|
|
163
|
11
|
|
50
|
|
|
34
|
$fields ||= '*'; # in case someone supplies '' or undef
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# with no LIMIT parameters, defer to SQL::Abstract
|
166
|
11
|
100
|
|
|
|
36
|
return $self->SUPER::select( $table, $fields, $where, $order ) unless $rows;
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# with LIMIT parameters, get the basic SQL without the ORDER BY clause
|
169
|
9
|
|
|
|
|
50
|
my ( $sql, @bind ) = $self->SUPER::select( $table, $fields, $where );
|
170
|
|
|
|
|
|
|
|
171
|
9
|
|
|
|
|
162
|
my $syntax_name = $self->_find_syntax( $syntax );
|
172
|
|
|
|
|
|
|
|
173
|
9
|
|
|
|
|
25
|
$sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
|
174
|
|
|
|
|
|
|
|
175
|
9
|
100
|
|
|
|
91
|
return wantarray ? ( $sql, @bind ) : $sql;
|
176
|
|
|
|
|
|
|
}
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item where( [ $where, [ \@order, [ $rows, [ $offset ], [ $dialect ] ] ] ] )
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Same as C, but accepts additional C<$rows>, C<$offset>
|
181
|
|
|
|
|
|
|
and C<$dialect> parameters.
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Some SQL dialects support syntaxes that can be applied as simple phrases
|
184
|
|
|
|
|
|
|
tacked on to the end of the WHERE clause. These are:
|
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
LimitOffset
|
187
|
|
|
|
|
|
|
LimitXY
|
188
|
|
|
|
|
|
|
LimitYX
|
189
|
|
|
|
|
|
|
RowsTo
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
This method returns a modified WHERE clause, if the limit syntax is set to one
|
192
|
|
|
|
|
|
|
of these options (either in the call to C or in the constructor), and
|
193
|
|
|
|
|
|
|
if C<$rows> is passed in.
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Dies via C if you try to use it for other syntaxes.
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
C<$order> is required if C<$rows> is set.
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
C<$where> is required if any other parameters are specified. It can be a hashref
|
200
|
|
|
|
|
|
|
or an arrayref, or C.
|
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Returns a regular C clause if no limits are set.
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=cut
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub where
|
207
|
|
|
|
|
|
|
{
|
208
|
12
|
|
|
12
|
1
|
2826
|
my $self = shift;
|
209
|
12
|
|
|
|
|
46
|
my $where = shift; # if ref( $_[0] ) eq 'HASH';
|
210
|
|
|
|
|
|
|
|
211
|
12
|
|
|
|
|
40
|
my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
|
212
|
|
|
|
|
|
|
|
213
|
12
|
|
|
|
|
24
|
my ( $sql, @bind );
|
214
|
|
|
|
|
|
|
|
215
|
12
|
50
|
|
|
|
31
|
if ( defined $rows )
|
216
|
|
|
|
|
|
|
{
|
217
|
0
|
|
|
|
|
0
|
( $sql, @bind ) = $self->SUPER::where( $where );
|
218
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
0
|
my $syntax_name = $self->_find_syntax( $syntax );
|
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
0
|
Carp::croak( "can't build a stand-alone WHERE clause for $syntax_name" )
|
222
|
|
|
|
|
|
|
unless $syntax_name =~ /(?:LimitOffset|LimitXY|LimitYX|RowsTo)/i;
|
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
$sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
|
225
|
|
|
|
|
|
|
}
|
226
|
|
|
|
|
|
|
else
|
227
|
|
|
|
|
|
|
{
|
228
|
|
|
|
|
|
|
#
|
229
|
12
|
|
|
|
|
45
|
( $sql, @bind ) = $self->SUPER::where( $where, $order );
|
230
|
|
|
|
|
|
|
}
|
231
|
|
|
|
|
|
|
|
232
|
12
|
100
|
|
|
|
9274
|
return wantarray ? ( $sql, @bind ) : $sql;
|
233
|
|
|
|
|
|
|
}
|
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub _get_args {
|
236
|
23
|
|
|
23
|
|
32
|
my $self = shift;
|
237
|
|
|
|
|
|
|
|
238
|
23
|
|
|
|
|
39
|
my $order = shift;
|
239
|
23
|
|
|
|
|
32
|
my $rows = shift;
|
240
|
23
|
100
|
66
|
|
|
128
|
my $offset = shift if ( defined $_[0] && $_[0] =~ /^\d+$/ );
|
241
|
23
|
|
66
|
|
|
75
|
my $syntax = shift || $self->_default_limit_syntax;
|
242
|
|
|
|
|
|
|
|
243
|
23
|
|
|
|
|
77
|
return $order, $rows, $offset, $syntax;
|
244
|
|
|
|
|
|
|
}
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=item insert
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item update
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item delete
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item values
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item generate
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
See L for these methods.
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
C and C are not provided with any C emulation in this
|
259
|
|
|
|
|
|
|
release, and no support is planned at the moment. But patches would be welcome.
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=back
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=cut
|
264
|
|
|
|
|
|
|
|
265
|
16
|
100
|
|
16
|
|
75
|
sub _default_limit_syntax { $_[0]->{limit_dialect} || 'GenericSubQ' }
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub _emulate_limit {
|
268
|
9
|
|
|
9
|
|
26
|
my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
|
269
|
|
|
|
|
|
|
|
270
|
9
|
|
50
|
|
|
23
|
$offset ||= 0;
|
271
|
|
|
|
|
|
|
|
272
|
9
|
50
|
|
|
|
46
|
Carp::croak( "rows must be a number (got $rows)" ) unless $rows =~ /^\d+$/;
|
273
|
9
|
50
|
|
|
|
33
|
Carp::croak( "offset must be a number (got $offset)" ) unless $offset =~ /^\d+$/;
|
274
|
|
|
|
|
|
|
|
275
|
9
|
|
66
|
|
|
58
|
my $method = $self->can( 'emulate_limit' ) || "_$syntax";
|
276
|
|
|
|
|
|
|
|
277
|
9
|
|
|
|
|
48
|
$sql = $self->$method( $sql, $order, $rows, $offset );
|
278
|
|
|
|
|
|
|
|
279
|
9
|
|
|
|
|
27
|
return $sql;
|
280
|
|
|
|
|
|
|
}
|
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub _find_syntax
|
283
|
|
|
|
|
|
|
{
|
284
|
9
|
|
|
9
|
|
21
|
my ($self, $syntax) = @_;
|
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# $syntax is a dialect name, database name, $dbh, or CDBI class or object
|
287
|
|
|
|
|
|
|
|
288
|
9
|
50
|
|
|
|
26
|
Carp::croak('no syntax') unless $syntax;
|
289
|
|
|
|
|
|
|
|
290
|
9
|
|
|
|
|
14
|
my $db;
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# note: tests arranged so that the eval isn't run against a scalar $syntax
|
293
|
|
|
|
|
|
|
# see rt #15000
|
294
|
9
|
50
|
|
|
|
24
|
if (ref $syntax) # a $dbh or a CDBI object
|
295
|
|
|
|
|
|
|
{
|
296
|
0
|
0
|
|
|
|
0
|
if ( UNIVERSAL::isa($syntax => 'Class::DBI') )
|
|
|
0
|
|
|
|
|
|
297
|
|
|
|
|
|
|
{
|
298
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_cdbi($syntax);
|
299
|
|
|
|
|
|
|
}
|
300
|
0
|
|
|
|
|
0
|
elsif ( eval { $syntax->{Driver}->{Name} } ) # or use isa DBI::db ?
|
301
|
|
|
|
|
|
|
{
|
302
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_dbh($syntax);
|
303
|
|
|
|
|
|
|
}
|
304
|
|
|
|
|
|
|
}
|
305
|
|
|
|
|
|
|
else # string - CDBI class, db name, or dialect name
|
306
|
|
|
|
|
|
|
{
|
307
|
9
|
50
|
|
|
|
76
|
if (exists $SyntaxMap{lc $syntax})
|
|
|
50
|
|
|
|
|
|
308
|
|
|
|
|
|
|
{
|
309
|
|
|
|
|
|
|
# the name of a database
|
310
|
0
|
|
|
|
|
0
|
$db = $syntax;
|
311
|
|
|
|
|
|
|
}
|
312
|
|
|
|
|
|
|
elsif (UNIVERSAL::isa($syntax => 'Class::DBI'))
|
313
|
|
|
|
|
|
|
{
|
314
|
|
|
|
|
|
|
# a CDBI class
|
315
|
0
|
|
|
|
|
0
|
$db = $self->_find_database_from_cdbi($syntax);
|
316
|
|
|
|
|
|
|
}
|
317
|
|
|
|
|
|
|
else
|
318
|
|
|
|
|
|
|
{
|
319
|
|
|
|
|
|
|
# or it's already a syntax dialect
|
320
|
9
|
|
|
|
|
25
|
return $syntax;
|
321
|
|
|
|
|
|
|
}
|
322
|
|
|
|
|
|
|
}
|
323
|
|
|
|
|
|
|
|
324
|
0
|
0
|
|
|
|
0
|
return $self->_find_syntax_from_database($db) if $db;
|
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# if you get here, you might like to provide a patch to determine the
|
327
|
|
|
|
|
|
|
# syntax model for your object or ref e.g. by getting at the $dbh stored in it
|
328
|
0
|
|
|
|
|
0
|
warn "can't determine syntax model for $syntax - using default";
|
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
|
|
0
|
return $self->_default_limit_syntax;
|
331
|
|
|
|
|
|
|
}
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# most of this code modified from DBIx::AnyDBD::rebless
|
334
|
|
|
|
|
|
|
sub _find_database_from_dbh {
|
335
|
0
|
|
|
0
|
|
0
|
my ( $self, $dbh ) = @_;
|
336
|
|
|
|
|
|
|
|
337
|
0
|
|
0
|
|
|
0
|
my $driver = ucfirst( $dbh->{Driver}->{Name} ) || Carp::croak( "no driver in $dbh" );
|
338
|
|
|
|
|
|
|
|
339
|
0
|
0
|
|
|
|
0
|
if ( $driver eq 'Proxy' )
|
340
|
|
|
|
|
|
|
{
|
341
|
|
|
|
|
|
|
# Looking into the internals of DBD::Proxy is maybe a little questionable
|
342
|
0
|
|
|
|
|
0
|
( $driver ) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/;
|
343
|
|
|
|
|
|
|
}
|
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# what about DBD::JDBC ?
|
346
|
0
|
|
|
|
|
0
|
my ( $odbc, $ado ) = ( $driver eq 'ODBC', $driver eq 'ADO' );
|
347
|
|
|
|
|
|
|
|
348
|
0
|
0
|
0
|
|
|
0
|
if ( $odbc || $ado )
|
349
|
|
|
|
|
|
|
{
|
350
|
0
|
|
|
|
|
0
|
my $name;
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# $name = $dbh->func( 17, 'GetInfo' ) if $odbc;
|
353
|
0
|
0
|
|
|
|
0
|
$name = $dbh->get_info( $DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_NAME} ) if $odbc;
|
354
|
0
|
0
|
|
|
|
0
|
$name = $dbh->{ado_conn}->Properties->Item( 'DBMS Name' )->Value if $ado;
|
355
|
|
|
|
|
|
|
|
356
|
0
|
0
|
|
|
|
0
|
die "can't determine driver name for ODBC or ADO handle: $dbh" unless $name;
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
CASE: {
|
359
|
0
|
0
|
|
|
|
0
|
$driver = 'MSSQL', last CASE if $name eq 'Microsoft SQL Server';
|
|
0
|
|
|
|
|
0
|
|
360
|
0
|
0
|
|
|
|
0
|
$driver = 'Sybase', last CASE if $name eq 'SQL Server';
|
361
|
0
|
0
|
|
|
|
0
|
$driver = 'Oracle', last CASE if $name =~ /Oracle/;
|
362
|
0
|
0
|
|
|
|
0
|
$driver = 'ASAny', last CASE if $name eq 'Adaptive Server Anywhere';
|
363
|
0
|
0
|
|
|
|
0
|
$driver = 'AdabasD', last CASE if $name eq 'ADABAS D';
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# this should catch Access (ACCESS) and Informix (Informix)
|
366
|
0
|
|
|
|
|
0
|
$driver = lc( $name );
|
367
|
0
|
|
|
|
|
0
|
$driver =~ s/\b(\w)/uc($1)/eg;
|
|
0
|
|
|
|
|
0
|
|
368
|
0
|
|
|
|
|
0
|
$driver =~ s/\s+/_/g;
|
369
|
|
|
|
|
|
|
}
|
370
|
|
|
|
|
|
|
}
|
371
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
0
|
die "couldn't find DBD driver in $dbh" unless $driver;
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# $driver now holds a string identifying the database server - in the future,
|
375
|
|
|
|
|
|
|
# it might return an object with extra information e.g. version
|
376
|
0
|
|
|
|
|
0
|
return $driver;
|
377
|
|
|
|
|
|
|
}
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# $cdbi can be a class or object
|
380
|
|
|
|
|
|
|
sub _find_database_from_cdbi
|
381
|
|
|
|
|
|
|
{
|
382
|
0
|
|
|
0
|
|
0
|
my ($self, $cdbi) = @_;
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# inherits from Ima::DBI
|
385
|
0
|
|
|
|
|
0
|
my ($dbh) = $cdbi->db_handles;
|
386
|
|
|
|
|
|
|
|
387
|
0
|
0
|
|
|
|
0
|
Carp::croak "no \$dbh in $cdbi" unless $dbh;
|
388
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
0
|
return $self->_find_database_from_dbh($dbh);
|
390
|
|
|
|
|
|
|
}
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# currently expects a string (database moniker), but this may become an object
|
393
|
|
|
|
|
|
|
# with e.g. version string etc.
|
394
|
|
|
|
|
|
|
sub _find_syntax_from_database {
|
395
|
0
|
|
|
0
|
|
0
|
my ( $self, $db ) = @_;
|
396
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
my $syntax = $SyntaxMap{ lc( $db ) };
|
398
|
|
|
|
|
|
|
|
399
|
0
|
0
|
|
|
|
0
|
return $syntax if $syntax;
|
400
|
|
|
|
|
|
|
|
401
|
0
|
0
|
|
|
|
0
|
my $msg = defined $syntax ?
|
402
|
|
|
|
|
|
|
"no dialect known for $db - using GenericSubQ dialect" :
|
403
|
|
|
|
|
|
|
"unknown database $db - using GenericSubQ dialect";
|
404
|
|
|
|
|
|
|
|
405
|
0
|
|
|
|
|
0
|
warn $msg;
|
406
|
|
|
|
|
|
|
|
407
|
0
|
|
|
|
|
0
|
return 'GenericSubQ';
|
408
|
|
|
|
|
|
|
}
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# DBIx::SearchBuilder LIMIT emulation:
|
411
|
|
|
|
|
|
|
# Oracle - RowNum
|
412
|
|
|
|
|
|
|
# Pg - LimitOffset
|
413
|
|
|
|
|
|
|
# Sybase - doesn't emulate
|
414
|
|
|
|
|
|
|
# Informix - First - but can only retrieve 1st page
|
415
|
|
|
|
|
|
|
# SQLite - default
|
416
|
|
|
|
|
|
|
# MySQL - default
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# default - LIMIT $offset, $rows
|
419
|
|
|
|
|
|
|
# or LIMIT $rows
|
420
|
|
|
|
|
|
|
# if $offset == 0
|
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# DBIx::Compat also tries, but only for the easy ones
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# ---------------------------------
|
426
|
|
|
|
|
|
|
# LIMIT emulation routines
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# utility for some emulations
|
429
|
|
|
|
|
|
|
sub _order_directions {
|
430
|
3
|
|
|
3
|
|
9
|
my ( $self, $order ) = @_;
|
431
|
|
|
|
|
|
|
|
432
|
3
|
50
|
|
|
|
8
|
return unless $order;
|
433
|
|
|
|
|
|
|
|
434
|
3
|
|
|
|
|
7
|
my $ref = ref $order;
|
435
|
|
|
|
|
|
|
|
436
|
3
|
|
|
|
|
5
|
my @order;
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
CASE: {
|
439
|
3
|
50
|
|
|
|
7
|
@order = @$order, last CASE if $ref eq 'ARRAY';
|
|
3
|
|
|
|
|
16
|
|
440
|
0
|
0
|
|
|
|
0
|
@order = ( $order ), last CASE unless $ref;
|
441
|
0
|
0
|
|
|
|
0
|
@order = ( $$order ), last CASE if $ref eq 'SCALAR';
|
442
|
0
|
|
|
|
|
0
|
Carp::croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY";
|
443
|
|
|
|
|
|
|
}
|
444
|
|
|
|
|
|
|
|
445
|
3
|
|
|
|
|
6
|
my ( $order_by_up, $order_by_down );
|
446
|
|
|
|
|
|
|
|
447
|
3
|
|
|
|
|
10
|
foreach my $spec ( @order )
|
448
|
|
|
|
|
|
|
{
|
449
|
6
|
|
|
|
|
15
|
my @spec = split ' ', $spec;
|
450
|
6
|
50
|
|
|
|
17
|
Carp::croak( "bad column order spec: $spec" ) if @spec > 2;
|
451
|
6
|
50
|
|
|
|
17
|
push( @spec, 'ASC' ) unless @spec == 2;
|
452
|
6
|
|
|
|
|
14
|
my ( $col, $up ) = @spec; # or maybe down
|
453
|
6
|
|
|
|
|
11
|
$up = uc( $up );
|
454
|
6
|
50
|
|
|
|
29
|
Carp::croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/;
|
455
|
6
|
|
|
|
|
16
|
$order_by_up .= ", $col $up";
|
456
|
6
|
50
|
|
|
|
18
|
my $down = $up eq 'ASC' ? 'DESC' : 'ASC';
|
457
|
6
|
|
|
|
|
19
|
$order_by_down .= ", $col $down";
|
458
|
|
|
|
|
|
|
}
|
459
|
|
|
|
|
|
|
|
460
|
3
|
|
|
|
|
21
|
s/^,/ORDER BY/ for ( $order_by_up, $order_by_down );
|
461
|
|
|
|
|
|
|
|
462
|
3
|
|
|
|
|
11
|
return $order_by_up, $order_by_down;
|
463
|
|
|
|
|
|
|
}
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# From http://phplens.com/lens/adodb/tips_portable_sql.htm
|
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# When writing SQL to retrieve the first 10 rows for paging, you could write...
|
468
|
|
|
|
|
|
|
# Database SQL Syntax
|
469
|
|
|
|
|
|
|
# DB2 select * from table fetch first 10 rows only
|
470
|
|
|
|
|
|
|
# Informix select first 10 * from table
|
471
|
|
|
|
|
|
|
# Microsoft SQL Server and Access select top 10 * from table
|
472
|
|
|
|
|
|
|
# MySQL and PostgreSQL select * from table limit 10
|
473
|
|
|
|
|
|
|
# Oracle 8i select * from (select * from table) where rownum <= 10
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=head2 Limit emulation
|
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
The following dialects are available for emulating the LIMIT clause. In each
|
478
|
|
|
|
|
|
|
case, C<$sql> represents the SQL statement generated by C,
|
479
|
|
|
|
|
|
|
minus the ORDER BY clause, e.g.
|
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
SELECT foo, bar FROM my_table WHERE some_conditions
|
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
C<$sql_after_select> represents C<$sql> with the leading C |
484
|
|
|
|
|
|
|
removed.
|
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
C represents the sort column(s) and direction(s) specified in
|
487
|
|
|
|
|
|
|
the C parameter.
|
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
C represents the opposite sort.
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
C<$last = $rows + $offset>
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=over 4
|
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=item LimitOffset
|
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=over 8
|
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=item Syntax
|
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows OFFSET $offset
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
or
|
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows
|
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
if C<$offset == 0>.
|
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item Databases
|
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
PostgreSQL
|
512
|
|
|
|
|
|
|
SQLite
|
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=back
|
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=cut
|
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
sub _LimitOffset {
|
519
|
1
|
|
|
1
|
|
6
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
520
|
1
|
|
|
|
|
7
|
$sql .= $self->_order_by( $order ) . " LIMIT $rows";
|
521
|
1
|
50
|
|
|
|
253
|
$sql .= " OFFSET $offset" if +$offset;
|
522
|
1
|
|
|
|
|
4
|
return $sql;
|
523
|
|
|
|
|
|
|
}
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=item LimitXY
|
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=over 8
|
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
=item Syntax
|
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $offset, $rows
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
or
|
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows
|
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
if C<$offset == 0>.
|
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=item Databases
|
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
MySQL
|
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=back
|
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=cut
|
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub _LimitXY {
|
548
|
1
|
|
|
1
|
|
5
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
549
|
1
|
|
|
|
|
5
|
$sql .= $self->_order_by( $order ) . " LIMIT ";
|
550
|
1
|
50
|
|
|
|
260
|
$sql .= "$offset, " if +$offset;
|
551
|
1
|
|
|
|
|
3
|
$sql .= $rows;
|
552
|
1
|
|
|
|
|
3
|
return $sql;
|
553
|
|
|
|
|
|
|
}
|
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=item LimitYX
|
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=over 8
|
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=item Syntax
|
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows, $offset
|
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
or
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up LIMIT $rows
|
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
if C<$offset == 0>.
|
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=item Databases
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
SQLite understands this syntax, or LimitOffset. If autodetecting the
|
572
|
|
|
|
|
|
|
dialect, it will be set to LimitOffset.
|
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=back
|
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=cut
|
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
sub _LimitYX {
|
579
|
0
|
|
|
0
|
|
0
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
580
|
0
|
|
|
|
|
0
|
$sql .= $self->_order_by( $order ) . " LIMIT $rows";
|
581
|
0
|
0
|
|
|
|
0
|
$sql .= " $offset" if +$offset;
|
582
|
0
|
|
|
|
|
0
|
return $sql;
|
583
|
|
|
|
|
|
|
}
|
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=item RowsTo
|
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=over 8
|
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=item Syntax
|
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up ROWS $offset TO $last
|
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=item Databases
|
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
InterBase
|
596
|
|
|
|
|
|
|
FireBird
|
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=back
|
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=cut
|
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
# InterBase/FireBird
|
603
|
|
|
|
|
|
|
sub _RowsTo {
|
604
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
605
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset;
|
606
|
1
|
|
|
|
|
5
|
$sql .= $self->_order_by( $order ) . " ROWS $offset TO $last";
|
607
|
1
|
|
|
|
|
229
|
return $sql;
|
608
|
|
|
|
|
|
|
}
|
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=item Top
|
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=over 8
|
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=item Syntax
|
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
SELECT * FROM
|
617
|
|
|
|
|
|
|
(
|
618
|
|
|
|
|
|
|
SELECT TOP $rows * FROM
|
619
|
|
|
|
|
|
|
(
|
620
|
|
|
|
|
|
|
SELECT TOP $last $sql_after_select
|
621
|
|
|
|
|
|
|
ORDER BY order_cols_up
|
622
|
|
|
|
|
|
|
) AS foo
|
623
|
|
|
|
|
|
|
ORDER BY order_cols_down
|
624
|
|
|
|
|
|
|
) AS bar
|
625
|
|
|
|
|
|
|
ORDER BY order_cols_up
|
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=item Databases
|
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
SQL/Server
|
631
|
|
|
|
|
|
|
MS Access
|
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=back
|
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=cut
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub _Top {
|
638
|
1
|
|
|
1
|
|
5
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
639
|
|
|
|
|
|
|
|
640
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset;
|
641
|
|
|
|
|
|
|
|
642
|
1
|
|
|
|
|
5
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
|
643
|
|
|
|
|
|
|
|
644
|
1
|
|
|
|
|
5
|
$sql =~ s/^\s*(SELECT|select)//;
|
645
|
|
|
|
|
|
|
|
646
|
1
|
|
|
|
|
7
|
$sql = <<"";
|
647
|
|
|
|
|
|
|
SELECT * FROM
|
648
|
|
|
|
|
|
|
(
|
649
|
|
|
|
|
|
|
SELECT TOP $rows * FROM
|
650
|
|
|
|
|
|
|
(
|
651
|
|
|
|
|
|
|
SELECT TOP $last $sql $order_by_up
|
652
|
|
|
|
|
|
|
) AS foo
|
653
|
|
|
|
|
|
|
$order_by_down
|
654
|
|
|
|
|
|
|
) AS bar
|
655
|
|
|
|
|
|
|
$order_by_up
|
656
|
|
|
|
|
|
|
|
657
|
1
|
|
|
|
|
3
|
return $sql;
|
658
|
|
|
|
|
|
|
}
|
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=item RowNum
|
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=over 8
|
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=item Syntax
|
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Oracle numbers rows from 1, not zero, so here $offset has been incremented by 1.
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
SELECT * FROM
|
671
|
|
|
|
|
|
|
(
|
672
|
|
|
|
|
|
|
SELECT A.*, ROWNUM r FROM
|
673
|
|
|
|
|
|
|
(
|
674
|
|
|
|
|
|
|
$sql ORDER BY order_cols_up
|
675
|
|
|
|
|
|
|
) A
|
676
|
|
|
|
|
|
|
WHERE ROWNUM <= $last
|
677
|
|
|
|
|
|
|
) B
|
678
|
|
|
|
|
|
|
WHERE r >= $offset
|
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=item Databases
|
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Oracle
|
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=back
|
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut
|
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub _RowNum {
|
689
|
1
|
|
|
1
|
|
4
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
# Oracle orders from 1 not zero
|
692
|
1
|
|
|
|
|
3
|
$offset++;
|
693
|
|
|
|
|
|
|
|
694
|
1
|
|
|
|
|
6
|
my $last = $rows + $offset;
|
695
|
|
|
|
|
|
|
|
696
|
1
|
|
|
|
|
5
|
my $order_by = $self->_order_by( $order );
|
697
|
|
|
|
|
|
|
|
698
|
1
|
|
|
|
|
237
|
$sql = <<"";
|
699
|
|
|
|
|
|
|
SELECT * FROM
|
700
|
|
|
|
|
|
|
(
|
701
|
|
|
|
|
|
|
SELECT A.*, ROWNUM r FROM
|
702
|
|
|
|
|
|
|
(
|
703
|
|
|
|
|
|
|
$sql $order_by
|
704
|
|
|
|
|
|
|
) A
|
705
|
|
|
|
|
|
|
WHERE ROWNUM < $last
|
706
|
|
|
|
|
|
|
) B
|
707
|
|
|
|
|
|
|
WHERE r >= $offset
|
708
|
|
|
|
|
|
|
|
709
|
1
|
|
|
|
|
5
|
return $sql;
|
710
|
|
|
|
|
|
|
}
|
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# DBIx::SearchBuilder::Handle::Oracle does this:
|
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
# Transform an SQL query from:
|
715
|
|
|
|
|
|
|
#
|
716
|
|
|
|
|
|
|
# SELECT main.*
|
717
|
|
|
|
|
|
|
# FROM Tickets main
|
718
|
|
|
|
|
|
|
# WHERE ((main.EffectiveId = main.id))
|
719
|
|
|
|
|
|
|
# AND ((main.Type = 'ticket'))
|
720
|
|
|
|
|
|
|
# AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
|
721
|
|
|
|
|
|
|
# AND ( (main.Queue = '1') ) )
|
722
|
|
|
|
|
|
|
#
|
723
|
|
|
|
|
|
|
# to:
|
724
|
|
|
|
|
|
|
#
|
725
|
|
|
|
|
|
|
# SELECT * FROM (
|
726
|
|
|
|
|
|
|
# SELECT limitquery.*,rownum limitrownum FROM (
|
727
|
|
|
|
|
|
|
# SELECT main.*
|
728
|
|
|
|
|
|
|
# FROM Tickets main
|
729
|
|
|
|
|
|
|
# WHERE ((main.EffectiveId = main.id))
|
730
|
|
|
|
|
|
|
# AND ((main.Type = 'ticket'))
|
731
|
|
|
|
|
|
|
# AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
|
732
|
|
|
|
|
|
|
# AND ( (main.Queue = '1') ) )
|
733
|
|
|
|
|
|
|
# ) limitquery WHERE rownum <= 50
|
734
|
|
|
|
|
|
|
# ) WHERE limitrownum >= 1
|
735
|
|
|
|
|
|
|
#
|
736
|
|
|
|
|
|
|
#if ($per_page) {
|
737
|
|
|
|
|
|
|
# # Oracle orders from 1 not zero
|
738
|
|
|
|
|
|
|
# $first++;
|
739
|
|
|
|
|
|
|
# # Make current query a sub select
|
740
|
|
|
|
|
|
|
# $$statementref = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= " . ($first + $per_page - 1) . " ) WHERE limitrownum >= " . $first;
|
741
|
|
|
|
|
|
|
#}
|
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
# DBIx::SQLEngine::Driver::Oracle does this:
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
#sub sql_limit {
|
746
|
|
|
|
|
|
|
# my $self = shift;
|
747
|
|
|
|
|
|
|
# my ( $limit, $offset, $sql, @params ) = @_;
|
748
|
|
|
|
|
|
|
#
|
749
|
|
|
|
|
|
|
# # remove tablealiases and group-functions from outer query properties
|
750
|
|
|
|
|
|
|
# my ($properties) = ($sql =~ /^\s*SELECT\s(.*?)\sFROM\s/i);
|
751
|
|
|
|
|
|
|
# $properties =~ s/[^\s]+\s*as\s*//ig;
|
752
|
|
|
|
|
|
|
# $properties =~ s/\w+\.//g;
|
753
|
|
|
|
|
|
|
#
|
754
|
|
|
|
|
|
|
# $offset ||= 0;
|
755
|
|
|
|
|
|
|
# my $position = ( $offset + $limit );
|
756
|
|
|
|
|
|
|
#
|
757
|
|
|
|
|
|
|
# $sql = <<"";
|
758
|
|
|
|
|
|
|
#SELECT $properties FROM (
|
759
|
|
|
|
|
|
|
# SELECT $properties, ROWNUM AS sqle_position FROM (
|
760
|
|
|
|
|
|
|
# $sql
|
761
|
|
|
|
|
|
|
# )
|
762
|
|
|
|
|
|
|
#)
|
763
|
|
|
|
|
|
|
#WHERE sqle_position > $offset AND sqle_position <= $position
|
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
#
|
767
|
|
|
|
|
|
|
# return ($sql, @params);
|
768
|
|
|
|
|
|
|
#}
|
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=item FetchFirst
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=over 8
|
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item Syntax
|
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
SELECT * FROM (
|
777
|
|
|
|
|
|
|
SELECT * FROM (
|
778
|
|
|
|
|
|
|
$sql
|
779
|
|
|
|
|
|
|
ORDER BY order_cols_up
|
780
|
|
|
|
|
|
|
FETCH FIRST $last ROWS ONLY
|
781
|
|
|
|
|
|
|
) foo
|
782
|
|
|
|
|
|
|
ORDER BY order_cols_down
|
783
|
|
|
|
|
|
|
FETCH FIRST $rows ROWS ONLY
|
784
|
|
|
|
|
|
|
) bar
|
785
|
|
|
|
|
|
|
ORDER BY order_cols_up
|
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=item Databases
|
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
IBM DB2
|
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=back
|
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=cut
|
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
sub _FetchFirst {
|
796
|
1
|
|
|
1
|
|
5
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
797
|
|
|
|
|
|
|
|
798
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset;
|
799
|
|
|
|
|
|
|
|
800
|
1
|
|
|
|
|
5
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
|
801
|
|
|
|
|
|
|
|
802
|
1
|
|
|
|
|
8
|
$sql = <<"";
|
803
|
|
|
|
|
|
|
SELECT * FROM (
|
804
|
|
|
|
|
|
|
SELECT * FROM (
|
805
|
|
|
|
|
|
|
$sql
|
806
|
|
|
|
|
|
|
$order_by_up
|
807
|
|
|
|
|
|
|
FETCH FIRST $last ROWS ONLY
|
808
|
|
|
|
|
|
|
) foo
|
809
|
|
|
|
|
|
|
$order_by_down
|
810
|
|
|
|
|
|
|
FETCH FIRST $rows ROWS ONLY
|
811
|
|
|
|
|
|
|
) bar
|
812
|
|
|
|
|
|
|
$order_by_up
|
813
|
|
|
|
|
|
|
|
814
|
1
|
|
|
|
|
3
|
return $sql;
|
815
|
|
|
|
|
|
|
}
|
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=item GenericSubQ
|
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
When all else fails, this should work for many databases, but it is probably
|
820
|
|
|
|
|
|
|
fairly slow.
|
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
This method relies on having a column with unique values as the first column in
|
823
|
|
|
|
|
|
|
the C |
824
|
|
|
|
|
|
|
results will be sorted by that unique column, so any C<$order> parameter is
|
825
|
|
|
|
|
|
|
ignored, unless it matches the unique column, in which case the direction of
|
826
|
|
|
|
|
|
|
the sort is honored.
|
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=over 8
|
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=item Syntax
|
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
SELECT field_list FROM $table X WHERE where_clause AND
|
833
|
|
|
|
|
|
|
(
|
834
|
|
|
|
|
|
|
SELECT COUNT(*) FROM $table WHERE $pk > X.$pk
|
835
|
|
|
|
|
|
|
)
|
836
|
|
|
|
|
|
|
BETWEEN $offset AND $last
|
837
|
|
|
|
|
|
|
ORDER BY $pk $asc_desc
|
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
C<$pk> is the first column in C.
|
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
C<$asc_desc> is the opposite direction to that specified in the method call. So
|
842
|
|
|
|
|
|
|
if you want the final results sorted C, say so, and it gets flipped
|
843
|
|
|
|
|
|
|
internally, but the results come out as you'd expect. I think.
|
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
The C clause is replaced with C $rows> if
|
846
|
|
|
|
|
|
|
<$offset == 0>.
|
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=item Databases
|
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
Sybase
|
851
|
|
|
|
|
|
|
Anything not otherwise known to this module.
|
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=back
|
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=cut
|
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
sub _GenericSubQ {
|
858
|
1
|
|
|
1
|
|
5
|
my ( $self, $sql, $order, $rows, $offset ) = @_;
|
859
|
|
|
|
|
|
|
|
860
|
1
|
|
|
|
|
3
|
my $last = $rows + $offset;
|
861
|
|
|
|
|
|
|
|
862
|
1
|
|
|
|
|
5
|
my $order_by = $self->_order_by( $order );
|
863
|
|
|
|
|
|
|
|
864
|
1
|
|
|
|
|
232
|
my ( $pk, $table ) = $sql =~ /^\s*SELECT\s+(\w+),?.*\sFROM\s+([\w]+)/i;
|
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
#warn "pk: $pk";
|
867
|
|
|
|
|
|
|
#warn "table: $table";
|
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
# get specified sort order and swap it to get the expected output (I think?)
|
870
|
1
|
|
|
|
|
40
|
my ( $asc_desc ) = $order_by =~ /\b$pk\s+(ASC|DESC)\s*/i;
|
871
|
1
|
50
|
|
|
|
6
|
$asc_desc = 'ASC' unless defined $asc_desc;
|
872
|
1
|
|
|
|
|
3
|
$asc_desc = uc( $asc_desc );
|
873
|
1
|
50
|
|
|
|
6
|
$asc_desc = $asc_desc eq 'ASC' ? 'DESC' : 'ASC';
|
874
|
|
|
|
|
|
|
|
875
|
1
|
|
|
|
|
18
|
$sql =~ s/FROM $table /FROM $table X /;
|
876
|
|
|
|
|
|
|
|
877
|
1
|
50
|
|
|
|
6
|
my $limit = $offset ? "BETWEEN $offset AND $last" : "< $rows";
|
878
|
|
|
|
|
|
|
|
879
|
1
|
|
|
|
|
28
|
$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
|
|
|
|
|
6
|
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
|
|
|
|
|
4
|
my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
|
1013
|
|
|
|
|
|
|
|
1014
|
1
|
|
|
|
|
7
|
$sql =~ s/^\s*(SELECT|select)//;
|
1015
|
|
|
|
|
|
|
|
1016
|
1
|
|
|
|
|
7
|
$sql = "select skip $offset limit $rows ".$sql." ".$self->_order_by( $order );
|
1017
|
|
|
|
|
|
|
|
1018
|
1
|
|
|
|
|
230
|
return $sql;
|
1019
|
|
|
|
|
|
|
}
|
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
1;
|
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
__END__
|