← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:42 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/SQL/Abstract/Limit.pm
Statements Executed181
Total Time0.005582 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
4110.000230.06110SQL::Abstract::Limit::select
4110.000190.05967SQL::Abstract::Limit::where
8210.000110.00015SQL::Abstract::Limit::_get_args
12227.7e-57.7e-5SQL::Abstract::Limit::_default_limit_syntax
1114.3e-50.00012SQL::Abstract::Limit::_find_syntax
1114.2e-50.00013SQL::Abstract::Limit::_emulate_limit
1113.6e-57.1e-5SQL::Abstract::Limit::_LimitOffset
1113.1e-54.3e-5SQL::Abstract::Limit::_find_database_from_dbh
1111.3e-51.3e-5SQL::Abstract::Limit::_find_syntax_from_database
00000SQL::Abstract::Limit::BEGIN
00000SQL::Abstract::Limit::_FetchFirst
00000SQL::Abstract::Limit::_First
00000SQL::Abstract::Limit::_GenericSubQ
00000SQL::Abstract::Limit::_LimitXY
00000SQL::Abstract::Limit::_LimitYX
00000SQL::Abstract::Limit::_RowNum
00000SQL::Abstract::Limit::_RowsTo
00000SQL::Abstract::Limit::_Top
00000SQL::Abstract::Limit::_find_database_from_cdbi
00000SQL::Abstract::Limit::_order_directions

LineStmts.Exclusive
Time		Avg.Code
1package SQL::Abstract::Limit;
233.2e-51.1e-5use strict;
# spent 10µs making 1 call to strict::import
332.9e-59.7e-6use warnings;
# spent 27µs making 1 call to warnings::import
431.7e-55.7e-6use Carp();
5
630.001700.00057use DBI::Const::GetInfoType ();
7
830.000680.00023use SQL::Abstract 1.20;
# spent 27µs making 1 call to UNIVERSAL::VERSION # spent 12µs making 1 call to import
9
1030.002210.00074use base 'SQL::Abstract';
# spent 110µs making 1 call to base::import
11
12=head1 NAME
13
14SQL::Abstract::Limit - portable LIMIT emulation
15
16=cut
17
1812.0e-62.0e-6our $VERSION = '0.12';
19
20# additions / error reports welcome !
2112.3e-52.3e-5our %SyntaxMap = ( mssql => 'Top',
22 access => 'Top',
23 sybase => 'GenericSubQ',
24 oracle => 'RowNum',
25 db2 => 'FetchFirst',
26 ingres => '',
27 adabasd => '',
28 informix => 'First',
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
89Portability layer for LIMIT emulation.
90
91=over 4
92
93=item new( case => 'lower', cmp => 'like', logic => 'and', convert => 'upper', limit_dialect => 'Top' )
94
95All settings are optional.
96
97=over 8
98
99=item limit_dialect
100
101Sets the default syntax model to use for emulating a C<LIMIT $rows OFFSET $offset>
102clause. Default setting is C<GenericSubQ>. You can still pass other syntax
103settings 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 First Informix # not implemented yet
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
123The first group are implemented by appending a short clause to the end of the
124statement. The second group require more intricate wrapping of the original
125statement in subselects.
126
127You can pass a L<DBI|DBI> database handle, and the module will figure out which
128dialect to use.
129
130You can pass a L<Class::DBI|Class::DBI> subclass or object, and the module will
131find the C<$dbh> and use it to find the dialect.
132
133Anything else based on L<DBI|DBI> can be easily added by locating the C<$dbh>.
134Patches or suggestions welcome.
135
136=back
137
138Other options are described in L<SQL::Abstract|SQL::Abstract>.
139
140=item select( $table, \@fields, $where, [ \@order, [ $rows, [ $offset ], [ $dialect ] ] ] )
141
142Same as C<SQL::Abstract::select>, but accepts additional C<$rows>, C<$offset>
143and C<$dialect> parameters.
144
145The C<$order> parameter is required if C<$rows> is specified.
146
147The C<$fields> parameter is required, but can be set to C<undef>, C<''> or
148C<'*'> (all these get set to C<'*'>).
149
150The C<$where> parameter is also required. It can be a hashref
151or an arrayref, or C<undef>.
152
153=cut
154
155
# spent 61.1ms (232µs+60.9) within SQL::Abstract::Limit::select which was called 4 times, avg 15.3ms/call: # 4 times (232µs+60.9ms) by DBIC::SQL::Abstract::select or DBIx::Class::Storage::DBI::BEGIN at line 86 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm, avg 15.3ms/call
sub select {
15645.0e-61.2e-6 my $self = shift;
15743.1e-57.8e-6 my $table = $self->_table(shift);
# spent 362µs making 4 calls to DBIC::SQL::Abstract::_table, avg 90µs/call
15845.0e-61.2e-6 my $fields = shift;
15943.0e-67.5e-7 my $where = shift; # if ref( $_[0] ) eq 'HASH';
160
16145.9e-51.5e-5 my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
# spent 98µs making 4 calls to SQL::Abstract::Limit::_get_args, avg 24µs/call
162
16342.0e-65.0e-7 $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;
16744.0e-61.0e-6 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
17040.000143.5e-5 my ( $sql, @bind ) = $self->SUPER::select( $table, $fields, $where );
# spent 60.0ms making 4 calls to SQL::Abstract::select, avg 15.0ms/call
171
17243.8e-59.5e-6 my $syntax_name = $self->_find_syntax( $syntax );
# spent 90µs making 4 calls to DBIC::SQL::Abstract::_find_syntax, avg 22µs/call
173
17443.0e-57.5e-6 $sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
# spent 311µs making 4 calls to DBIC::SQL::Abstract::_emulate_limit, avg 78µs/call
175
17642.8e-57.0e-6 return wantarray ? ( $sql, @bind ) : $sql;
177}
178
179=item where( [ $where, [ \@order, [ $rows, [ $offset ], [ $dialect ] ] ] ] )
180
181Same as C<SQL::Abstract::where>, but accepts additional C<$rows>, C<$offset>
182and C<$dialect> parameters.
183
184Some SQL dialects support syntaxes that can be applied as simple phrases
185tacked on to the end of the WHERE clause. These are:
186
187 LimitOffset
188 LimitXY
189 LimitYX
190 RowsTo
191
192This method returns a modified WHERE clause, if the limit syntax is set to one
193of these options (either in the call to C<where> or in the constructor), and
194if C<$rows> is passed in.
195
196Dies via C<croak> if you try to use it for other syntaxes.
197
198C<$order> is required if C<$rows> is set.
199
200C<$where> is required if any other parameters are specified. It can be a hashref
201or an arrayref, or C<undef>.
202
203Returns a regular C<WHERE> clause if no limits are set.
204
205=cut
206
207sub where
208
# spent 59.7ms (187µs+59.5) within SQL::Abstract::Limit::where which was called 4 times, avg 14.9ms/call: # 4 times (187µs+59.5ms) by SQL::Abstract::select at line 541 of /wise/base/static/lib/perl5/site_perl/5.10.0/SQL/Abstract.pm, avg 14.9ms/call
{
20944.0e-61.0e-6 my $self = shift;
21044.0e-61.0e-6 my $where = shift; # if ref( $_[0] ) eq 'HASH';
211
21242.8e-57.0e-6 my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
# spent 53µs making 4 calls to SQL::Abstract::Limit::_get_args, avg 13µs/call
213
21444.0e-61.0e-6 my ( $sql, @bind );
215
21642.5e-56.3e-6 if ( $rows )
217 {
218 ( $sql, @bind ) = $self->SUPER::where( $where );
219
220 my $syntax_name = $self->_find_syntax( $syntax );
221
222 Carp::croak( "can't build a stand-alone WHERE clause for $syntax_name" )
223 unless $syntax_name =~ /(?:LimitOffset|LimitXY|LimitYX|RowsTo)/i;
224
225 $sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
226 }
227 else
228 {
229 #
23040.000102.6e-5 ( $sql, @bind ) = $self->SUPER::where( $where, $order );
# spent 59.4ms making 4 calls to SQL::Abstract::where, avg 14.9ms/call
231 }
232
23342.5e-56.2e-6 return wantarray ? ( $sql, @bind ) : $sql;
234}
235
236
# spent 151µs (105+46) within SQL::Abstract::Limit::_get_args which was called 8 times, avg 19µs/call: # 4 times (70µs+28µs) by SQL::Abstract::Limit::select at line 161, avg 24µs/call # 4 times (35µs+18µs) by SQL::Abstract::Limit::where at line 212, avg 13µs/call
sub _get_args {
23785.0e-66.2e-7 my $self = shift;
238
23988.0e-61.0e-6 my $order = shift;
24083.0e-63.8e-7 my $rows = shift;
24181.7e-52.1e-6 my $offset = shift if ( $_[0] && $_[0] =~ /^\d+$/ );
24284.5e-55.6e-6 my $syntax = shift || $self->_default_limit_syntax;
# spent 46µs making 8 calls to SQL::Abstract::Limit::_default_limit_syntax, avg 6µs/call
243
24481.6e-52.0e-6 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
257See L<SQL::Abstract|SQL::Abstract> for these methods.
258
259C<update> and C<delete> are not provided with any C<LIMIT> emulation in this
260release, and no support is planned at the moment. But patches would be welcome.
261
262=back
263
264=cut
265
266123.0e-52.5e-6
# spent 77µs within SQL::Abstract::Limit::_default_limit_syntax which was called 12 times, avg 6µs/call: # 8 times (46µs+0) by SQL::Abstract::Limit::_get_args at line 242, avg 6µs/call # 4 times (31µs+0) by DBIx::Class::Storage::DBI::_select at line 1119 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm, avg 8µs/call
sub _default_limit_syntax { $_[0]->{limit_dialect} || 'GenericSubQ' }
267
268
# spent 126µs (42+84) within SQL::Abstract::Limit::_emulate_limit which was called # once (42µs+84µs) by DBIx::Class::Storage::DBI::BEGIN or DBIC::SQL::Abstract::_emulate_limit at line 127 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm
sub _emulate_limit {
26915.0e-65.0e-6 my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
270
27111.0e-61.0e-6 $offset ||= 0;
272
27317.0e-67.0e-6 Carp::croak( "rows must be a number (got $rows)" ) unless $rows =~ /^\d+$/;
27413.0e-63.0e-6 Carp::croak( "offset must be a number (got $offset)" ) unless $offset =~ /^\d+$/;
275
27612.2e-52.2e-5 my $method = $self->can( 'emulate_limit' ) || "_$syntax";
# spent 13µs making 1 call to UNIVERSAL::can
277
27811.3e-51.3e-5 $sql = $self->$method( $sql, $order, $rows, $offset );
# spent 71µs making 1 call to SQL::Abstract::Limit::_LimitOffset
279
28012.0e-62.0e-6 return $sql;
281}
282
283sub _find_syntax
284
# spent 118µs (43+75) within SQL::Abstract::Limit::_find_syntax which was called # once (43µs+75µs) by DBIx::Class::Storage::DBI::BEGIN or DBIC::SQL::Abstract::_find_syntax at line 74 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Storage/DBI.pm
{
28511.0e-61.0e-6 my ($self, $syntax) = @_;
286
287 # $syntax is a dialect name, database name, $dbh, or CDBI class or object
288
289100 Carp::croak('no syntax') unless $syntax;
290
29111.0e-61.0e-6 my $db;
292
293 # note: tests arranged so that the eval isn't run against a scalar $syntax
294 # see rt #15000
29513.0e-63.0e-6 if (ref $syntax) # a $dbh or a CDBI object
296 {
29713.6e-53.6e-5 if ( UNIVERSAL::isa($syntax => 'Class::DBI') )
# spent 43µs making 1 call to SQL::Abstract::Limit::_find_database_from_dbh # spent 7µs making 1 call to UNIVERSAL::isa
298 {
299 $db = $self->_find_database_from_cdbi($syntax);
300 }
30112.1e-52.1e-5 elsif ( eval { $syntax->{Driver}->{Name} } ) # or use isa DBI::db ?
# spent 12µs making 2 calls to DBI::common::FETCH, avg 6µs/call
302 {
303 $db = $self->_find_database_from_dbh($syntax);
304 }
305 }
306 else # string - CDBI class, db name, or dialect name
307 {
308 if (exists $SyntaxMap{lc $syntax})
309 {
310 # the name of a database
311 $db = $syntax;
312 }
313 elsif (UNIVERSAL::isa($syntax => 'Class::DBI'))
314 {
315 # a CDBI class
316 $db = $self->_find_database_from_cdbi($syntax);
317 }
318 else
319 {
320 # or it's already a syntax dialect
321 return $syntax;
322 }
323 }
324
32511.1e-51.1e-5 return $self->_find_syntax_from_database($db) if $db;
# spent 13µs making 1 call to SQL::Abstract::Limit::_find_syntax_from_database
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 warn "can't determine syntax model for $syntax - using default";
330
331 return $self->_default_limit_syntax;
332}
333
334# most of this code modified from DBIx::AnyDBD::rebless
335
# spent 43µs (31+12) within SQL::Abstract::Limit::_find_database_from_dbh which was called # once (31µs+12µs) by SQL::Abstract::Limit::_find_syntax at line 297
sub _find_database_from_dbh {
33612.0e-62.0e-6 my ( $self, $dbh ) = @_;
337
33812.2e-52.2e-5 my $driver = ucfirst( $dbh->{Driver}->{Name} ) || Carp::croak( "no driver in $dbh" );
# spent 12µs making 2 calls to DBI::common::FETCH, avg 6µs/call
339
34011.0e-61.0e-6 if ( $driver eq 'Proxy' )
341 {
342 # Looking into the internals of DBD::Proxy is maybe a little questionable
343 ( $driver ) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/;
344 }
345
346 # what about DBD::JDBC ?
34713.0e-63.0e-6 my ( $odbc, $ado ) = ( $driver eq 'ODBC', $driver eq 'ADO' );
348
34911.0e-61.0e-6 if ( $odbc || $ado )
350 {
351 my $name;
352
353 # $name = $dbh->func( 17, 'GetInfo' ) if $odbc;
354 $name = $dbh->get_info( $DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_NAME} ) if $odbc;
355 $name = $dbh->{ado_conn}->Properties->Item( 'DBMS Name' )->Value if $ado;
356
357 die "can't determine driver name for ODBC or ADO handle: $dbh" unless $name;
358
359CASE: {
360 $driver = 'MSSQL', last CASE if $name eq 'Microsoft SQL Server';
361 $driver = 'Sybase', last CASE if $name eq 'SQL Server';
362 $driver = 'Oracle', last CASE if $name =~ /Oracle/;
363 $driver = 'ASAny', last CASE if $name eq 'Adaptive Server Anywhere';
364 $driver = 'AdabasD', last CASE if $name eq 'ADABAS D';
365
366 # this should catch Access (ACCESS) and Informix (Informix)
367 $driver = lc( $name );
368 $driver =~ s/\b(\w)/uc($1)/eg;
369 $driver =~ s/\s+/_/g;
370 }
371 }
372
373100 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
37712.0e-62.0e-6 return $driver;
378}
379
380# $cdbi can be a class or object
381sub _find_database_from_cdbi
382{
383 my ($self, $cdbi) = @_;
384
385 # inherits from Ima::DBI
386 my ($dbh) = $cdbi->db_handles;
387
388 Carp::croak "no \$dbh in $cdbi" unless $dbh;
389
390 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
# spent 13µs within SQL::Abstract::Limit::_find_syntax_from_database which was called # once (13µs+0) by SQL::Abstract::Limit::_find_syntax at line 325
sub _find_syntax_from_database {
39613.0e-63.0e-6 my ( $self, $db ) = @_;
397
39813.0e-63.0e-6 my $syntax = $SyntaxMap{ lc( $db ) };
399
40012.0e-62.0e-6 return $syntax if $syntax;
401
402 my $msg = defined $syntax ?
403 "no dialect known for $db - using GenericSubQ dialect" :
404 "unknown database $db - using GenericSubQ dialect";
405
406 warn $msg;
407
408 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
430sub _order_directions {
431 my ( $self, $order ) = @_;
432
433 return unless $order;
434
435 my $ref = ref $order;
436
437 my @order;
438
439CASE: {
440 @order = @$order, last CASE if $ref eq 'ARRAY';
441 @order = ( $order ), last CASE unless $ref;
442 @order = ( $$order ), last CASE if $ref eq 'SCALAR';
443 Carp::croak __PACKAGE__ . ": Unsupported data struct $ref for ORDER BY";
444}
445
446 my ( $order_by_up, $order_by_down );
447
448 foreach my $spec ( @order )
449 {
450 my @spec = split ' ', $spec;
451 Carp::croak( "bad column order spec: $spec" ) if @spec > 2;
452 push( @spec, 'ASC' ) unless @spec == 2;
453 my ( $col, $up ) = @spec; # or maybe down
454 $up = uc( $up );
455 Carp::croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/;
456 $order_by_up .= ", $col $up";
457 my $down = $up eq 'ASC' ? 'DESC' : 'ASC';
458 $order_by_down .= ", $col $down";
459 }
460
461 s/^,/ORDER BY/ for ( $order_by_up, $order_by_down );
462
463 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
478The following dialects are available for emulating the LIMIT clause. In each
479case, C<$sql> represents the SQL statement generated by C<SQL::Abstract::select>,
480minus the ORDER BY clause, e.g.
481
482 SELECT foo, bar FROM my_table WHERE some_conditions
483
484C<$sql_after_select> represents C<$sql> with the leading C<SELECT> keyword
485removed.
486
487C<order_cols_up> represents the sort column(s) and direction(s) specified in
488the C<order> parameter.
489
490C<order_cols_down> represents the opposite sort.
491
492C<$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
504or
505
506 $sql ORDER BY order_cols_up LIMIT $rows
507
508if C<$offset == 0>.
509
510=item Databases
511
512 PostgreSQL
513 SQLite
514
515=back
516
517=cut
518
519
# spent 71µs (36+35) within SQL::Abstract::Limit::_LimitOffset which was called # once (36µs+35µs) by SQL::Abstract::Limit::_emulate_limit at line 278
sub _LimitOffset {
52011.2e-51.2e-5 my ( $self, $sql, $order, $rows, $offset ) = @_;
52111.3e-51.3e-5 $sql .= $self->_order_by( $order ) . " LIMIT $rows";
# spent 35µs making 1 call to DBIC::SQL::Abstract::_order_by
52211.1e-51.1e-5 $sql .= " OFFSET $offset" if +$offset;
52312.0e-62.0e-6 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
534or
535
536 $sql ORDER BY order_cols_up LIMIT $rows
537
538if C<$offset == 0>.
539
540=item Databases
541
542 MySQL
543
544=back
545
546=cut
547
548sub _LimitXY {
549 my ( $self, $sql, $order, $rows, $offset ) = @_;
550 $sql .= $self->_order_by( $order ) . " LIMIT ";
551 $sql .= "$offset, " if +$offset;
552 $sql .= $rows;
553 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
564or
565
566 $sql ORDER BY order_cols_up LIMIT $rows
567
568if 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
579sub _LimitYX {
580 my ( $self, $sql, $order, $rows, $offset ) = @_;
581 $sql .= $self->_order_by( $order ) . " LIMIT $rows";
582 $sql .= " $offset" if +$offset;
583 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
604sub _RowsTo {
605 my ( $self, $sql, $order, $rows, $offset ) = @_;
606 my $last = $rows + $offset;
607 $sql .= $self->_order_by( $order ) . " ROWS $offset TO $last";
608 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
638sub _Top {
639 my ( $self, $sql, $order, $rows, $offset ) = @_;
640
641 my $last = $rows + $offset;
642
643 my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
644
645 $sql =~ s/^\s*(SELECT|select)//;
646
647 $sql = <<"";
648SELECT * 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 return $sql;
659}
660
661
662
663=item RowNum
664
665=over 8
666
667=item Syntax
668
669Oracle 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
689sub _RowNum {
690 my ( $self, $sql, $order, $rows, $offset ) = @_;
691
692 # Oracle orders from 1 not zero
693 $offset++;
694
695 my $last = $rows + $offset;
696
697 my $order_by = $self->_order_by( $order );
698
699 $sql = <<"";
700SELECT * FROM
701(
702 SELECT A.*, ROWNUM r FROM
703 (
704 $sql $order_by
705 ) A
706 WHERE ROWNUM < $last
707) B
708WHERE r >= $offset
709
710 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
790IBM DB2
791
792=back
793
794=cut
795
796sub _FetchFirst {
797 my ( $self, $sql, $order, $rows, $offset ) = @_;
798
799 my $last = $rows + $offset;
800
801 my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
802
803 $sql = <<"";
804SELECT * 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 return $sql;
816}
817
818=item GenericSubQ
819
820When all else fails, this should work for many databases, but it is probably
821fairly slow.
822
823This method relies on having a column with unique values as the first column in
824the C<SELECT> clause (i.e. the first column in the C<\@fields> parameter). The
825results will be sorted by that unique column, so any C<$order> parameter is
826ignored, unless it matches the unique column, in which case the direction of
827the 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
840C<$pk> is the first column in C<field_list>.
841
842C<$asc_desc> is the opposite direction to that specified in the method call. So
843if you want the final results sorted C<ASC>, say so, and it gets flipped
844internally, but the results come out as you'd expect. I think.
845
846The C<BETWEEN $offset AND $last> clause is replaced with C<E<lt> $rows> if
847<$offset == 0>.
848
849=item Databases
850
851Sybase
852Anything not otherwise known to this module.
853
854=back
855
856=cut
857
858sub _GenericSubQ {
859 my ( $self, $sql, $order, $rows, $offset ) = @_;
860
861 my $last = $rows + $offset;
862
863 my $order_by = $self->_order_by( $order );
864
865 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 my ( $asc_desc ) = $order_by =~ /\b$pk\s+(ASC|DESC)\s*/i;
872 $asc_desc = uc( $asc_desc ) || 'ASC';
873 $asc_desc = $asc_desc eq 'ASC' ? 'DESC' : 'ASC';
874
875 $sql =~ s/FROM $table /FROM $table X /;
876
877 my $limit = $offset ? "BETWEEN $offset AND $last" : "< $rows";
878
879 $sql = <<"";
880$sql AND
881(
882 SELECT COUNT(*) FROM $table WHERE $pk > X.$pk
883)
884$limit
885ORDER BY $pk $asc_desc
886
887 return $sql;
888}
889
890
891=begin notes
892
8931st 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
904Next 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
916http://expertanswercenter.techtarget.com/eac/knowledgebaseAnswer/0,,sid63_gci978197,00.html
917
918We can adapt the generic Top N query to this task. I would not use the generic
919method when TOP or LIMIT is available, but you're right, the previous answer
920is incomplete without this.
921
922Using the same table and column names, the top 100 ids are given by:
923
924SELECT 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
930The subquery is correlated, which means that it will be evaluated for each row
931of the outer query. The subquery says "count the number of rows that have an
932id that is greater than this id." Note that the sort order is descending, so
933we are looking for ids that are greater, i.e. higher up in the result set. If
934that number is less than 100, then this row must be one of the top 100. Simple,
935eh? Unfortunately, it runs quite slowly. Furthermore, it takes ties into
936consideration, which is good, but this means that the number of rows returned
937isn't always going to be exactly 100 -- there will be extra rows if there are
938ties extending across the 100th place.
939
940Next, we need the second set of 100:
941
942select 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
951See the pattern? Note that the same caveat applies about ties that extend
952across 200th place.
953
954=end notes
955
956=item First
957
958=over 8
959
960=item Syntax
961
962Looks to be identical to C<Top>, e.g. C<SELECT FIRST 10 * FROM table>. Can
963probably be implemented in a very similar way, but not done yet.
964
965=item Databases
966
967Informix
968
969=back
970
971=cut
972
973sub _First {
974 my ( $self, $sql, $order, $rows, $offset ) = @_;
975 die 'FIRST not implemented';
976
977 # fetch first 20 rows
978
979 # might need to add to regex in 'where' method
980
981}
982
983
98411.9e-51.9e-51;
985
986__END__
987
988=back
989
990=head1 SUBCLASSING
991
992You can create your own syntax by making a subclass that provides an
993C<emulate_limit> method. This might be useful if you are using stored procedures
994to provide more efficient paging.
995
996=over 4
997
998=item emulate_limit( $self, $sql, $order, $rows, $offset )
999
1000=over 4
1001
1002=item $sql
1003
1004This is the SQL statement built by L<SQL::Abstract|SQL::Abstract>, but without
1005the ORDER BY clause, e.g.
1006
1007 SELECT foo, bar FROM my_table WHERE conditions
1008
1009or just
1010
1011 WHERE conditions
1012
1013if calling C<where> instead of C<select>.
1014
1015=item $order
1016
1017The C<order> parameter passed to the C<select> or C<where> call. You can get
1018an C<ORDER BY> clause from this by calling
1019
1020 my $order_by = $self->_order_by( $order );
1021
1022You can get a pair of C<ORDER BY> clauses that sort in opposite directions by
1023saying
1024
1025 my ( $up, $down ) = $self->_order_directions( $order );
1026
1027=back
1028
1029The method should return a suitably modified SQL statement.
1030
1031=back
1032
1033=head1 AUTO-DETECTING THE DIALECT
1034
1035The C<$dialect> parameter that can be passed to the constructor or to the
1036C<select> and C<where> methods can be a number of things. The module will
1037attempt to determine the appropriate syntax to use.
1038
1039Supported C<$dialect> things are:
1040
1041 dialect name (e.g. LimitOffset, RowsTo, Top etc.)
1042 database moniker (e.g. Oracle, SQLite etc.)
1043 DBI database handle
1044 Class::DBI subclass or object
1045
1046=head1 CAVEATS
1047
1048Paging results sets is a complicated undertaking, with several competing factors
1049to take into account. This module does B<not> magically give you the optimum
1050paging solution for your situation. It gives you a solution that may be good
1051enough in many situations. But if your tables are large, the SQL generated here
1052will often not be efficient. Or if your queries involve joins or other
1053complications, you will probably need to look elsewhere.
1054
1055But if your tables aren't too huge, and your queries straightforward, you can
1056just plug this module in and move on to your next task.
1057
1058=head1 ACKNOWLEDGEMENTS
1059
1060Thanks to Aaron Johnson for the Top syntax model (SQL/Server and MS Access).
1061
1062Thanks to Emanuele Zeppieri for the IBM DB2 syntax model.
1063
1064=head1 TODO
1065
1066Find more syntaxes to implement.
1067
1068Test the syntaxes against real databases. I only have access to MySQL. Reports
1069of success or failure would be great.
1070
1071=head1 DEPENDENCIES
1072
1073L<SQL::Abstract|SQL::Abstract>,
1074L<DBI::Const::GetInfoType|DBI::Const::GetInfoType>,
1075L<Carp|Carp>.
1076
1077=head1 SEE ALSO
1078
1079L<DBIx::SQLEngine|DBIx::SQLEngine>,
1080L<DBIx::SearchBuilder|DBIx::SearchBuilder>,
1081L<DBIx::RecordSet|DBIx::RecordSet>.
1082
1083=head1 BUGS
1084
1085Please report all bugs via the CPAN Request Tracker at
1086L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Abstract-Limit>.
1087
1088=head1 COPYRIGHT AND LICENSE
1089
1090Copyright 2004 by David Baird.
1091
1092This library is free software; you can redistribute it and/or modify
1093it under the same terms as Perl itself.
1094
1095=head1 AUTHOR
1096
1097David Baird, C<cpan@riverside-cms.co.uk>
1098
1099=head1 HOW IS IT DONE ELSEWHERE
1100
1101A few CPAN modules do this for a few databases, but the most comprehensive
1102seem to be DBIx::SQLEngine, DBIx::SearchBuilder and DBIx::RecordSet.
1103
1104Have a look in the source code for my notes on how these modules tackle
1105similar problems.
1106
1107=begin notes
1108
1109 =over 4
1110
1111 =item DBIx::SearchBuilder::Handle::Oracle
1112
1113 Transform an SQL query from:
1114
1115 SELECT main.*
1116 FROM Tickets main
1117 WHERE ((main.EffectiveId = main.id))
1118 AND ((main.Type = 'ticket'))
1119 AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
1120 AND ( (main.Queue = '1') ) )
1121
1122 to:
1123
1124 SELECT * FROM (
1125 SELECT limitquery.*,rownum limitrownum FROM (
1126 SELECT main.*
1127 FROM Tickets main
1128 WHERE ((main.EffectiveId = main.id))
1129 AND ((main.Type = 'ticket'))
1130 AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
1131 AND ( (main.Queue = '1') ) )
1132 ) limitquery WHERE rownum <= 50
1133 ) WHERE limitrownum >= 1
1134
1135 if ($per_page) {
1136 # Oracle orders from 1 not zero
1137 $first++;
1138 # Make current query a sub select
1139 $$statementref = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= " . ($first + $per_page - 1) . " ) WHERE limitrownum >= " . $first;
1140 }
1141
1142 =item DBIx::SQLEngine::Driver
1143
1144 sub sql_limit {
1145 my $self = shift;
1146 my ( $limit, $offset, $sql, @params ) = @_;
1147
1148 $sql .= " limit $limit" if $limit;
1149 $sql .= " offset $offset" if $offset;
1150
1151 return ($sql, @params);
1152 }
1153
1154 =item DBIx::SQLEngine::Driver::AnyData
1155
1156 Also:
1157
1158 DBIx::SQLEngine::Driver::CSV
1159
1160 Adds support for SQL select limit clause.
1161
1162 TODO: Needs workaround to support offset.
1163
1164 sub sql_limit {
1165 my $self = shift;
1166 my ( $limit, $offset, $sql, @params ) = @_;
1167
1168 # You can't apply "limit" to non-table fetches
1169 $sql .= " limit $limit" if ( $sql =~ / from / );
1170
1171 return ($sql, @params);
1172 }
1173
1174 =item DBIx::SQLEngine::Driver::Informix - Support DBD::Informix and DBD::ODBC/Informix
1175
1176 =item sql_limit()
1177
1178 Not yet supported. Perhaps we should use "first $maxrows" and throw out the first $offset?
1179
1180 =back
1181
1182 =cut
1183
1184 sub sql_limit {
1185 confess("Not yet supported")
1186 }
1187
1188 =item DBIx::SQLEngine::Driver::MSSQL - Support DBD::ODBC with Microsoft SQL Server
1189
1190 =item sql_limit()
1191
1192 Adds support for SQL select limit clause.
1193
1194 =back
1195
1196 =cut
1197
1198 sub sql_limit {
1199 my $self = shift;
1200 my ( $limit, $offset, $sql, @params ) = @_;
1201
1202 # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1203 if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1204 $sql .= " limit $limit" if $limit;
1205 $sql .= " offset $offset" if $offset;
1206 }
1207
1208 return ($sql, @params);
1209 }
1210
1211
1212
1213 =item DBIx::SQLEngine::Driver::Mysql - Support DBD::mysql
1214
1215 =item sql_limit()
1216
1217 Adds support for SQL select limit clause.
1218
1219 =back
1220
1221 =cut
1222
1223 sub sql_limit {
1224 my $self = shift;
1225 my ( $limit, $offset, $sql, @params ) = @_;
1226
1227 # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1228 if ( $sql =~ /\bfrom\b/ and $limit or $offset) {
1229 $limit ||= 1_000_000; # MySQL select with offset requires a limit
1230 $sql .= " limit " . ( $offset ? "$offset," : '' ) . $limit;
1231 }
1232
1233 return ($sql, @params);
1234 }
1235
1236 =item DBIx::SQLEngine::Driver::Oracle - Support DBD::Oracle and DBD::ODBC/Oracle
1237
1238 =item sql_limit()
1239
1240 Adds support for SQL select limit clause.
1241
1242 Implemented as a subselect with ROWNUM.
1243
1244 =back
1245
1246 =cut
1247
1248 sub sql_limit {
1249 my $self = shift;
1250 my ( $limit, $offset, $sql, @params ) = @_;
1251
1252 # remove tablealiases and group-functions from outer query properties
1253 my ($properties) = ($sql =~ /^\s*SELECT\s(.*?)\sFROM\s/i);
1254 $properties =~ s/[^\s]+\s*as\s*//ig;
1255 $properties =~ s/\w+\.//g;
1256
1257 $offset ||= 0;
1258 my $position = ( $offset + $limit );
1259
1260 $sql = <<"";
1261 SELECT $properties FROM (
1262 SELECT $properties, ROWNUM AS sqle_position FROM (
1263 $sql
1264 )
1265 )
1266 WHERE sqle_position > $offset AND sqle_position <= $position
1267
1268 return ($sql, @params);
1269 }
1270
1271 =item DBIx::SQLEngine::Driver::Pg - Support DBD::Pg
1272
1273 =head2 sql_limit
1274
1275 $sqldb->sql_limit( $limit, $offset, $sql, @params ) : $sql, @params
1276
1277 Adds support for SQL select limit clause.
1278
1279 =cut
1280
1281 sub sql_limit {
1282 my $self = shift;
1283 my ( $limit, $offset, $sql, @params ) = @_;
1284
1285 # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1286 if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1287 $sql .= " limit $limit" if $limit;
1288 $sql .= " offset $offset" if $offset;
1289 }
1290
1291 return ($sql, @params);
1292 }
1293
1294 =item DBIx::SQLEngine::Driver::SQLite - Support DBD::SQLite driver
1295
1296 =head2 sql_limit
1297
1298 Adds support for SQL select limit clause.
1299
1300 =cut
1301
1302 sub sql_limit {
1303 my $self = shift;
1304 my ( $limit, $offset, $sql, @params ) = @_;
1305
1306 # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1307 if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1308 $sql .= " limit $limit" if $limit;
1309 $sql .= " offset $offset" if $offset;
1310 }
1311
1312 return ($sql, @params);
1313 }
1314
1315 =item DBIx::SQLEngine::Driver::Sybase - Extends SQLEngine for DBMS Idiosyncrasies
1316
1317 =item sql_limit()
1318
1319 Not yet supported.
1320
1321 See http://www.isug.com/Sybase_FAQ/ASE/section6.2.html#6.2.12
1322
1323 =back
1324
1325 =cut
1326
1327 sub sql_limit {
1328 confess("Not yet supported")
1329 }
1330
1331
1332 =item DBIx::SQLEngine::Driver::Sybase::MSSQL - Support DBD::Sybase with Microsoft SQL
1333
1334 Nothing.
1335
1336 =back
1337
1338 =cut
1339
1340=end notes

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.