1package SQL::Abstract::Limit;
2use strict;
3use warnings;
4use Carp();
5
6use DBI::Const::GetInfoType ();
7
8use SQL::Abstract 1.20;
9
10use base 'SQL::Abstract';
11
12=head1 NAME
13
14SQL::Abstract::Limit - portable LIMIT emulation
15
16=cut    
17
18our $VERSION = '0.141';
19
20# additions / error reports welcome !
21our %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
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    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
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
155sub select {
156    my $self   = shift;
157    my $table  = $self->_table(shift);
158    my $fields = shift;
159    my $where  = shift; #  if ref( $_[0] ) eq 'HASH';
160
161    my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
162
163    $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    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    my ( $sql, @bind ) = $self->SUPER::select( $table, $fields, $where );
171
172    my $syntax_name = $self->_find_syntax( $syntax );
173
174    $sql = $self->_emulate_limit( $syntax_name, $sql, $order, $rows, $offset );
175
176    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{
209    my $self   = shift;
210    my $where  = shift; # if ref( $_[0] ) eq 'HASH';
211
212    my ( $order, $rows, $offset, $syntax ) = $self->_get_args( @_ );
213
214    my ( $sql, @bind );
215
216    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        #
230        ( $sql, @bind ) = $self->SUPER::where( $where, $order );
231    }
232
233    return wantarray ? ( $sql, @bind ) : $sql;
234}
235
236sub _get_args {
237    my $self = shift;
238
239    my $order  = shift;
240    my $rows   = shift;
241    my $offset = shift if ( $_[0] && $_[0] =~ /^\d+$/ );
242    my $syntax = shift || $self->_default_limit_syntax;
243
244    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
266sub _default_limit_syntax { $_[0]->{limit_dialect} || 'GenericSubQ' }
267
268sub _emulate_limit {
269    my ( $self, $syntax, $sql, $order, $rows, $offset ) = @_;
270
271    $offset ||= 0;
272
273    Carp::croak( "rows must be a number (got $rows)" )     unless $rows   =~ /^\d+$/;
274    Carp::croak( "offset must be a number (got $offset)" ) unless $offset =~ /^\d+$/;
275
276    my $method = $self->can( 'emulate_limit' ) || "_$syntax";
277
278    $sql = $self->$method( $sql, $order, $rows, $offset );
279
280    return $sql;
281}
282
283sub _find_syntax
284{
285    my ($self, $syntax) = @_;
286
287    # $syntax is a dialect name, database name, $dbh, or CDBI class or object
288
289    Carp::croak('no syntax') unless $syntax;
290
291    my $db;
292
293    # note: tests arranged so that the eval isn't run against a scalar $syntax
294    #           see rt #15000
295    if (ref $syntax)        # a $dbh or a CDBI object
296    {
297        if ( UNIVERSAL::isa($syntax => 'Class::DBI') )
298        {
299            $db = $self->_find_database_from_cdbi($syntax);
300        }
301        elsif ( eval { $syntax->{Driver}->{Name} } ) # or use isa DBI::db ?
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
325    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    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
335sub _find_database_from_dbh {
336    my ( $self, $dbh ) = @_;
337
338    my $driver = ucfirst( $dbh->{Driver}->{Name} ) || Carp::croak( "no driver in $dbh" );
339
340    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 ?
347    my ( $odbc, $ado ) = ( $driver eq 'ODBC', $driver eq 'ADO' );
348
349    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
373    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    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.
395sub _find_syntax_from_database {
396    my ( $self, $db ) = @_;
397
398    my $syntax = $SyntaxMap{ lc( $db ) };
399
400    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
519sub _LimitOffset {
520    my ( $self, $sql, $order, $rows, $offset ) = @_;
521    $sql .= $self->_order_by( $order ) . " LIMIT $rows";
522    $sql .= " OFFSET $offset" if +$offset;
523    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
957=begin notes
958
959=item First
960
961=over 8
962
963=item Syntax
964
965Looks to be identical to C<Top>, e.g. C<SELECT FIRST 10 * FROM table>. Can
966probably be implemented in a very similar way, but not done yet.
967
968=item Databases
969
970Informix
971
972=back
973
974
975sub _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
997which will take rows 6 through 10 in the select.
998
999=item Databases
1000
1001Informix
1002
1003=back
1004
1005=cut
1006
1007sub _Skip {
1008    my ( $self, $sql, $order, $rows, $offset ) = @_;
1009
1010    my $last = $rows + $offset;
1011
1012    my ( $order_by_up, $order_by_down ) = $self->_order_directions( $order );
1013
1014    $sql =~ s/^\s*(SELECT|select)//;
1015
1016    $sql = "select skip $offset limit $rows ".$sql." ".$self->_order_by( $order );
1017
1018    return $sql;
1019}
1020
1021
1022
10231;
1024
1025__END__
1026
1027=back
1028
1029=head1 SUBCLASSING
1030
1031You can create your own syntax by making a subclass that provides an
1032C<emulate_limit> method. This might be useful if you are using stored procedures
1033to provide more efficient paging.
1034
1035=over 4
1036
1037=item emulate_limit( $self, $sql, $order, $rows, $offset )
1038
1039=over 4
1040
1041=item $sql
1042
1043This is the SQL statement built by L<SQL::Abstract|SQL::Abstract>, but without
1044the ORDER BY clause, e.g.
1045
1046    SELECT foo, bar FROM my_table WHERE conditions
1047
1048or just
1049
1050    WHERE conditions
1051
1052if calling C<where> instead of C<select>.
1053
1054=item $order
1055
1056The C<order> parameter passed to the C<select> or C<where> call. You can get
1057an C<ORDER BY> clause from this by calling
1058
1059    my $order_by = $self->_order_by( $order );
1060
1061You can get a pair of C<ORDER BY> clauses that sort in opposite directions by
1062saying
1063
1064    my ( $up, $down ) = $self->_order_directions( $order );
1065
1066=back
1067
1068The method should return a suitably modified SQL statement.
1069
1070=back
1071
1072=head1 AUTO-DETECTING THE DIALECT
1073
1074The C<$dialect> parameter that can be passed to the constructor or to the
1075C<select> and C<where> methods can be a number of things. The module will
1076attempt to determine the appropriate syntax to use.
1077
1078Supported C<$dialect> things are:
1079
1080    dialect name (e.g. LimitOffset, RowsTo, Top etc.)
1081    database moniker (e.g. Oracle, SQLite etc.)
1082    DBI database handle
1083    Class::DBI subclass or object
1084
1085=head1 CAVEATS
1086
1087Paging results sets is a complicated undertaking, with several competing factors
1088to take into account. This module does B<not> magically give you the optimum
1089paging solution for your situation. It gives you a solution that may be good
1090enough in many situations. But if your tables are large, the SQL generated here
1091will often not be efficient. Or if your queries involve joins or other
1092complications, you will probably need to look elsewhere.
1093
1094But if your tables aren't too huge, and your queries straightforward, you can
1095just plug this module in and move on to your next task.
1096
1097=head1 ACKNOWLEDGEMENTS
1098
1099Thanks to Aaron Johnson for the Top syntax model (SQL/Server and MS Access).
1100
1101Thanks to Emanuele Zeppieri for the IBM DB2 syntax model.
1102
1103Thanks to Paul Falbe for the Informix implementation.
1104
1105=head1 TODO
1106
1107Find more syntaxes to implement.
1108
1109Test the syntaxes against real databases. I only have access to MySQL. Reports
1110of success or failure would be great.
1111
1112=head1 DEPENDENCIES
1113
1114L<SQL::Abstract|SQL::Abstract>,
1115L<DBI::Const::GetInfoType|DBI::Const::GetInfoType>,
1116L<Carp|Carp>.
1117
1118=head1 SEE ALSO
1119
1120L<DBIx::SQLEngine|DBIx::SQLEngine>,
1121L<DBIx::SearchBuilder|DBIx::SearchBuilder>,
1122L<DBIx::RecordSet|DBIx::RecordSet>.
1123
1124=head1 BUGS
1125
1126Please report all bugs via the CPAN Request Tracker at
1127L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Abstract-Limit>.
1128
1129=head1 COPYRIGHT AND LICENSE
1130
1131Copyright 2004 by David Baird.
1132
1133This library is free software; you can redistribute it and/or modify
1134it under the same terms as Perl itself.
1135
1136=head1 AUTHOR
1137
1138David Baird, C<cpan@riverside-cms.co.uk>
1139
1140=head1 HOW IS IT DONE ELSEWHERE
1141
1142A few CPAN modules do this for a few databases, but the most comprehensive
1143seem to be DBIx::SQLEngine, DBIx::SearchBuilder and DBIx::RecordSet.
1144
1145Have a look in the source code for my notes on how these modules tackle
1146similar problems.
1147
1148=begin notes
1149
1150    =over 4
1151
1152    =item DBIx::SearchBuilder::Handle::Oracle
1153
1154        Transform an SQL query from:
1155
1156        SELECT main.*
1157          FROM Tickets main
1158         WHERE ((main.EffectiveId = main.id))
1159           AND ((main.Type = 'ticket'))
1160           AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
1161           AND ( (main.Queue = '1') ) )
1162
1163        to:
1164
1165        SELECT * FROM (
1166            SELECT limitquery.*,rownum limitrownum FROM (
1167                    SELECT main.*
1168                      FROM Tickets main
1169                     WHERE ((main.EffectiveId = main.id))
1170                       AND ((main.Type = 'ticket'))
1171                       AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
1172                       AND ( (main.Queue = '1') ) )
1173            ) limitquery WHERE rownum <= 50
1174        ) WHERE limitrownum >= 1
1175
1176        if ($per_page) {
1177            # Oracle orders from 1 not zero
1178            $first++;
1179            # Make current query a sub select
1180            $$statementref = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= " . ($first + $per_page - 1) . " ) WHERE limitrownum >= " . $first;
1181        }
1182
1183    =item DBIx::SQLEngine::Driver
1184
1185        sub sql_limit {
1186          my $self = shift;
1187          my ( $limit, $offset, $sql, @params ) = @_;
1188
1189          $sql .= " limit $limit" if $limit;
1190          $sql .= " offset $offset" if $offset;
1191
1192          return ($sql, @params);
1193        }
1194
1195    =item DBIx::SQLEngine::Driver::AnyData
1196
1197    Also:
1198
1199        DBIx::SQLEngine::Driver::CSV
1200
1201    Adds support for SQL select limit clause.
1202
1203    TODO: Needs workaround to support offset.
1204
1205        sub sql_limit {
1206          my $self = shift;
1207          my ( $limit, $offset, $sql, @params ) = @_;
1208
1209          # You can't apply "limit" to non-table fetches
1210          $sql .= " limit $limit" if ( $sql =~ / from / );
1211
1212          return ($sql, @params);
1213        }
1214
1215    =item DBIx::SQLEngine::Driver::Informix - Support DBD::Informix and DBD::ODBC/Informix
1216
1217        =item sql_limit()
1218
1219        Not yet supported. Perhaps we should use "first $maxrows" and throw out the first $offset?
1220
1221        =back
1222
1223        =cut
1224
1225        sub sql_limit {
1226          confess("Not yet supported")
1227        }
1228
1229    =item DBIx::SQLEngine::Driver::MSSQL - Support DBD::ODBC with Microsoft SQL Server
1230
1231        =item sql_limit()
1232
1233        Adds support for SQL select limit clause.
1234
1235        =back
1236
1237        =cut
1238
1239        sub sql_limit {
1240          my $self = shift;
1241          my ( $limit, $offset, $sql, @params ) = @_;
1242
1243          # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1244          if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1245            $sql .= " limit $limit" if $limit;
1246            $sql .= " offset $offset" if $offset;
1247          }
1248
1249          return ($sql, @params);
1250        }
1251
1252
1253
1254    =item DBIx::SQLEngine::Driver::Mysql - Support DBD::mysql
1255
1256        =item sql_limit()
1257
1258        Adds support for SQL select limit clause.
1259
1260        =back
1261
1262        =cut
1263
1264        sub sql_limit {
1265          my $self = shift;
1266          my ( $limit, $offset, $sql, @params ) = @_;
1267
1268          # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1269          if ( $sql =~ /\bfrom\b/ and $limit or $offset) {
1270            $limit ||= 1_000_000; # MySQL select with offset requires a limit
1271            $sql .= " limit " . ( $offset ? "$offset," : '' ) . $limit;
1272          }
1273
1274          return ($sql, @params);
1275        }
1276
1277    =item DBIx::SQLEngine::Driver::Oracle - Support DBD::Oracle and DBD::ODBC/Oracle
1278
1279        =item sql_limit()
1280
1281        Adds support for SQL select limit clause.
1282
1283        Implemented as a subselect with ROWNUM.
1284
1285        =back
1286
1287        =cut
1288
1289        sub sql_limit {
1290            my $self = shift;
1291            my ( $limit, $offset, $sql, @params ) = @_;
1292
1293            # remove tablealiases and group-functions from outer query properties
1294            my ($properties) = ($sql =~ /^\s*SELECT\s(.*?)\sFROM\s/i);
1295            $properties =~ s/[^\s]+\s*as\s*//ig;
1296            $properties =~ s/\w+\.//g;
1297
1298            $offset ||= 0;
1299            my $position = ( $offset + $limit );
1300
1301            $sql = <<"";
1302        SELECT $properties FROM (
1303            SELECT $properties, ROWNUM AS sqle_position FROM (
1304                $sql
1305            )
1306        )
1307        WHERE sqle_position > $offset AND sqle_position <= $position
1308
1309            return ($sql, @params);
1310        }
1311
1312    =item DBIx::SQLEngine::Driver::Pg - Support DBD::Pg
1313
1314        =head2 sql_limit
1315
1316          $sqldb->sql_limit( $limit, $offset, $sql, @params ) : $sql, @params
1317
1318        Adds support for SQL select limit clause.
1319
1320        =cut
1321
1322        sub sql_limit {
1323          my $self = shift;
1324          my ( $limit, $offset, $sql, @params ) = @_;
1325
1326          # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1327          if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1328            $sql .= " limit $limit" if $limit;
1329            $sql .= " offset $offset" if $offset;
1330          }
1331
1332          return ($sql, @params);
1333        }
1334
1335    =item DBIx::SQLEngine::Driver::SQLite - Support DBD::SQLite driver
1336
1337        =head2 sql_limit
1338
1339        Adds support for SQL select limit clause.
1340
1341        =cut
1342
1343        sub sql_limit {
1344          my $self = shift;
1345          my ( $limit, $offset, $sql, @params ) = @_;
1346
1347          # You can't apply "limit" to non-table fetches like "select LAST_INSERT_ID"
1348          if ( $sql =~ /\bfrom\b/ and defined $limit or defined $offset) {
1349            $sql .= " limit $limit" if $limit;
1350            $sql .= " offset $offset" if $offset;
1351          }
1352
1353          return ($sql, @params);
1354        }
1355
1356    =item DBIx::SQLEngine::Driver::Sybase - Extends SQLEngine for DBMS Idiosyncrasies
1357
1358        =item sql_limit()
1359
1360        Not yet supported.
1361
1362        See http://www.isug.com/Sybase_FAQ/ASE/section6.2.html#6.2.12
1363
1364        =back
1365
1366        =cut
1367
1368        sub sql_limit {
1369          confess("Not yet supported")
1370        }
1371
1372
1373    =item DBIx::SQLEngine::Driver::Sybase::MSSQL - Support DBD::Sybase with Microsoft SQL
1374
1375    Nothing.
1376
1377    =back
1378
1379    =cut
1380
1381=end notes
1382