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