File Coverage

blib/lib/SQL/Abstract/Limit.pm
Criterion Covered Total %
statement 122 174 70.1
branch 27 86 31.4
condition 9 21 42.8
subroutine 21 25 84.0
pod 2 2 100.0
total 181 308 58.7


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