File Coverage

blib/lib/SQL/Abstract/Limit.pm
Criterion Covered Total %
statement 123 175 70.2
branch 27 88 30.6
condition 8 19 42.1
subroutine 21 25 84.0
pod 2 2 100.0
total 181 309 58.5


line stmt bran cond sub pod time code
1             package SQL::Abstract::Limit;
2 5     5   366731 use strict;
  5         55  
  5         146  
3 5     5   27 use warnings;
  5         8  
  5         116  
4 5     5   26 use Carp();
  5         10  
  5         111  
5            
6 5     5   2446 use DBI::Const::GetInfoType ();
  5         29137  
  5         162  
7            
8 5     5   4556 use SQL::Abstract 1.20;
  5         101232  
  5         312  
9            
10 5     5   50 use base 'SQL::Abstract';
  5         8  
  5         14065  
11            
12             =head1 NAME
13            
14             SQL::Abstract::Limit - portable LIMIT emulation
15            
16             =cut
17            
18             our $VERSION = '0.143';
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 157779 my $self = shift;
157 11         24 my $table = shift;
158 11         19 my $fields = shift;
159 11         21 my $where = shift; # if ref( $_[0] ) eq 'HASH';
160            
161 11         34 my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
162            
163 11   50     36 $fields ||= '*'; # in case someone supplies '' or undef
164            
165             # with no LIMIT parameters, defer to SQL::Abstract
166 11 100       34 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         57 my ( $sql, @bind ) = $self->SUPER::select( $table, $fields, $where );
170            
171 9         32552 my $syntax_name = $self->_find_syntax( $syntax );
172            
173 9         31 $sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
174            
175 9 100       83 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 1     1 1 4077 my $self = shift;
209 1         3 my $where = shift; # if ref( $_[0] ) eq 'HASH';
210            
211 1         16 my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
212            
213 1         3 my ( $sql, @bind );
214            
215 1 50       3 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 1         7 ( $sql, @bind ) = $self->SUPER::where( $where, $order );
230             }
231            
232 1 50       800 return wantarray ? ( $sql, @bind ) : $sql;
233             }
234            
235             sub _get_args {
236 12     12   22 my $self = shift;
237            
238 12         19 my $order = shift;
239 12         21 my $rows = shift;
240 12 100 66     98 my $offset = shift if ( defined $_[0] && $_[0] =~ /^\d+$/ );
241 12   66     49 my $syntax = shift || $self->_default_limit_syntax;
242            
243 12         43 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 5 100   5   35 sub _default_limit_syntax { $_[0]->{limit_dialect} || 'GenericSubQ' }
266            
267             sub _emulate_limit {
268 9     9   29 my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
269            
270 9   50     20 $offset ||= 0;
271            
272 9 50       50 Carp::croak( "rows must be a number (got $rows)" ) unless $rows =~ /^\d+$/;
273 9 50       29 Carp::croak( "offset must be a number (got $offset)" ) unless $offset =~ /^\d+$/;
274            
275 9   66     60 my $method = $self->can( 'emulate_limit' ) || "_$syntax";
276            
277 9         36 $sql = $self->$method( $sql, $order, $rows, $offset );
278            
279 9         27 return $sql;
280             }
281            
282             sub _find_syntax
283             {
284 9     9   54 my ($self, $syntax) = @_;
285            
286             # $syntax is a dialect name, database name, $dbh, or CDBI class or object
287            
288 9 50       31 Carp::croak('no syntax') unless $syntax;
289            
290 9         16 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       21 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       72 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   8 my ( $self, $order ) = @_;
431            
432 3 50       8 return unless $order;
433            
434 3         8 my $ref = ref $order;
435            
436 3         6 my @order;
437            
438             CASE: {
439 3 50       5 @order = @$order, last CASE if $ref eq 'ARRAY';
  3         14  
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         8 my ( $order_by_up, $order_by_down );
446            
447 3         6 foreach my $spec ( @order )
448             {
449 6         16 my @spec = split ' ', $spec;
450 6 50       19 Carp::croak( "bad column order spec: $spec" ) if @spec > 2;
451 6 50       15 push( @spec, 'ASC' ) unless @spec == 2;
452 6         15 my ( $col, $up ) = @spec; # or maybe down
453 6         10 $up = uc( $up );
454 6 50       26 Carp::croak( "bad direction: $up" ) unless $up =~ /^(?:ASC|DESC)$/;
455 6         15 $order_by_up .= ", $col $up";
456 6 50       15 my $down = $up eq 'ASC' ? 'DESC' : 'ASC';
457 6         17 $order_by_down .= ", $col $down";
458             }
459            
460 3         21 s/^,/ORDER BY/ for ( $order_by_up, $order_by_down );
461            
462 3         12 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   4 my ( $self, $sql, $order, $rows, $offset ) = @_;
520 1         5 $sql .= $self->_order_by( $order ) . " LIMIT $rows";
521 1 50       412 $sql .= " OFFSET $offset" if +$offset;
522 1         3 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   4 my ( $self, $sql, $order, $rows, $offset ) = @_;
549 1         6 $sql .= $self->_order_by( $order ) . " LIMIT ";
550 1 50       432 $sql .= "$offset, " if +$offset;
551 1         2 $sql .= $rows;
552 1         4 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         4 my $last = $rows + $offset;
606 1         4 $sql .= $self->_order_by( $order ) . " ROWS $offset TO $last";
607 1         384 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   4 my ( $self, $sql, $order, $rows, $offset ) = @_;
639            
640 1         4 my $last = $rows + $offset;
641            
642 1         5 my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
643            
644 1         6 $sql =~ s/^\s*(SELECT|select)//;
645            
646 1         8 $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   3 my ( $self, $sql, $order, $rows, $offset ) = @_;
690            
691             # Oracle orders from 1 not zero
692 1         3 $offset++;
693            
694 1         3 my $last = $rows + $offset;
695            
696 1         5 my $order_by = $self->_order_by( $order );
697            
698 1         449 $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         4 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   4 my ( $self, $sql, $order, $rows, $offset ) = @_;
797            
798 1         3 my $last = $rows + $offset;
799            
800 1         4 my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
801            
802 1         7 $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   3 my ( $self, $sql, $order, $rows, $offset ) = @_;
859            
860 1         3 my $last = $rows + $offset;
861            
862 1         4 my $order_by = $self->_order_by( $order );
863            
864 1         407 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       5 $asc_desc = $asc_desc eq 'ASC' ? 'DESC' : 'ASC';
874            
875 1         19 $sql =~ s/FROM $table /FROM $table X /;
876            
877 1 50       6 my $limit = $offset ? "BETWEEN $offset AND $last" : "< $rows";
878            
879 1         5 $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         5 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   5 my ( $self, $sql, $order, $rows, $offset ) = @_;
1009            
1010 1         3 my $last = $rows + $offset;
1011            
1012 1         3 my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
1013            
1014 1         6 $sql =~ s/^\s*(SELECT|select)//;
1015            
1016 1         8 $sql = "select skip $offset limit $rows ".$sql." ".$self->_order_by( $order );
1017            
1018 1         389 return $sql;
1019             }
1020            
1021            
1022            
1023             1;
1024            
1025             __END__