Class::DBI::Plugin::Pager - paged queries for CDBI

Class-DBI-Plugin-Pager documentation Contained in the Class-DBI-Plugin-Pager distribution.

Index

Code Index:

NAME

Top

Class::DBI::Plugin::Pager - paged queries for CDBI

DESCRIPTION

Top

Adds a pager method to your class that can query using SQL::Abstract where clauses, and limit the number of rows returned to a specific subset.

SYNOPSIS

Top

    package CD;
    use base 'Class::DBI';

    use Class::DBI::Plugin::AbstractCount;      # pager needs this
    use Class::DBI::Plugin::Pager;

    # or to use a different syntax
    # use Class::DBI::Plugin::Pager::RowsTo;

    __PACKAGE__->set_db(...);




    # in a nearby piece of code...

    use CD;

    # see SQL::Abstract for how to specify the query
    my $where = { ... };

    my $order_by => [ qw( foo bar ) ];

    # bit by bit:
    my $pager = CD->pager;

    $pager->per_page( 10 );
    $pager->page( 3 );
    $pager->where( $where );
    $pager->order_by( $order_by );

    $pager->set_syntax( 'RowsTo' );

    my @cds = $pager->search_where;

    # or all at once
    my $pager = CD->pager( $where, $order_by, 10, 3 );

    my @cds = $pager->search_where;

    # or

    my $pager = CD->pager;

    my @cds = $pager->search_where( $where, $order_by, 10, 3 );

    # $pager isa Data::Page
    # @cds contains the CDs just for the current page

METHODS

Top

import

Loads the pager method into the CDBI app.

pager( [$where, [$abstract_attr]], [$order_by], [$per_page], [$page], [$syntax] )

Also accepts named arguments:

    where           => $where,
    abstract_attr   => $attr,
    order_by        => $order_by,
    per_page        => $per_page,
    page            => $page,
    syntax          => $syntax

Returns a pager object. This subclasses Data::Page.

Note that for positional arguments, $abstract_attr can only be passed if preceded by a $where argument.

$abstract_attr can contain the $order_by setting (just as in SQL::Abstract).

configuration

The named arguments all exist as get/set methods.

where

A hashref specifying the query. See SQL::Abstract.

abstract_attr

A hashref specifying extra options to be passed through to the SQL::Abstract constructor.

order_by

Single column name or arrayref of column names for the ORDER BY clause. Defaults to the primary key(s) if not set.

per_page

Number of results per page.

page

The pager will retrieve results just for this page. Defaults to 1.

syntax

Change the way the 'limit' clause is constructed. See set_syntax. Default is LimitOffset.

search_where

Retrieves results from the pager. Accepts the same arguments as the pager method.

retrieve_all

Convenience method, generates a WHERE clause that matches all rows from the table.

Accepts the same arguments as the pager or search_where methods, except that no WHERE clause should be specified.

Note that the argument parsing routine called by the pager method cannot cope with positional arguments that lack a WHERE clause, so either use named arguments, or the 'bit by bit' approach, or pass the arguments directly to retrieve_all.

set_syntax( [ $name || $class || $coderef ] )

Changes the syntax used to generate the limit or other phrase that restricts the results set to the required page.

The syntax is implemented as a method called on the pager, which can be queried to provide the $rows and $offset parameters (see the subclasses included in this distribution).

$class

A class with a make_limit method.

$name

Name of a class in the Class::DBI::Plugin::Pager:: namespace, which has a make_limit method.

$coderef

Will be called as a method on the pager object, so receives the pager as its argument.

(no args)

Called without args, will default to LimitOffset, which causes Class::DBI::Plugin::Pager::LimitOffset (Class::DBI::Plugin::Pager::LimitOffset) to be used.

auto_set_syntax

This is called automatically when you call pager, and attempts to set the syntax automatically.

If you are using a subclass of the pager, this method will not be called.

Will die if using Oracle or DB2, since there is no simple syntax for limiting the results set. DB2 has a FETCH keyword, but that seems to apply to a cursor and I don't know if there is a cursor available to the pager. There should probably be others to add to the unsupported list.

Supports the following drivers:

                      DRIVER        CDBI::P::Pager subclass
    my %supported = ( pg        => 'LimitOffset',
                      mysql     => 'LimitOffset', # older versions need LimitXY
                      sqlite    => 'LimitOffset', # or LimitYX
                      sqlite2   => 'LimitOffset', # or LimitYX
                      interbase => 'RowsTo',
                      firebird  => 'RowsTo',
                      );

Older versions of MySQL should use the LimitXY syntax. You'll need to set it manually, either by use CDBI::P::Pager::LimitXY, or by passing syntax => 'LimitXY' to a method call, or call set_syntax directly.

Any driver not in the supported or unsupported lists defaults to LimitOffset.

Any additions to the supported and unsupported lists gratefully received.

SUBCLASSING

The 'limit' syntax can be set by using a subclass, e.g.

    use Class::DBI::Plugin::Pager::RowsTo;

instead of setting at runtime. A subclass looks like this:

    package Class::DBI::Plugin::Pager::RowsTo;
    use base 'Class::DBI::Plugin::Pager';

    sub make_limit {
        my ( $self ) = @_;

        my $offset = $self->skipped;
        my $rows   = $self->entries_per_page;

        my $last = $rows + $offset;

        return "ROWS $offset TO $last";
    }

    1;

You can omit the use base and switch syntax by calling $pager->set_syntax( 'RowsTo' ). Or you can leave in the use base and still say $pager->set_syntax( 'RowsTo' ), because in this case the class is required and the import in the base class doesn't get called. Or something. At any rate, It Works.

The subclasses implement the following LIMIT syntaxes:

Class::DBI::Plugin::Pager::LimitOffset
    LIMIT $rows OFFSET $offset

This is the default if your driver is not in the list of known drivers.

This should work for PostgreSQL, more recent MySQL, SQLite, and maybe some others.

Class::DBI::Plugin::LimitXY
    LIMIT $offset, $rows

Older versions of MySQL.

Class::DBI::Plugin::LimitYX
    LIMIT $rows, $offset

SQLite.

Class::DBI::Plugin::RowsTo
    ROWS $offset TO $offset + $rows

InterBase, also FireBird, maybe others?

TODO

Top

I've only used this on an older version of MySQL. Reports of this thing working (or not) elsewhere would be useful.

It should be possible to use set_sql to build the complex queries required by some databases to emulate LIMIT (see notes in source).

CAVEATS

Top

This class can't implement the subselect mechanism required by some databases to emulate the LIMIT phrase, because it only has access to the WHERE clause, not the whole SQL statement. At the moment.

Each query issues two requests to the database - the first to count the entire result set, the second to retrieve the required subset of results. If your tables are small it may be quicker to use Class::DBI::Pager.

The order_by clause means the database has to retrieve (internally) and sort the entire results set, before chopping out the requested subset. It's probably a good idea to have an index on the column(s) used to order the results. For huge tables, this approach to paging may be too inefficient.

DEPENDENCIES

Top

SQL::Abstract, Data::Page, Class::DBI::Plugin::AbstractCount, Class::Accessor, Class::Data::Inheritable, Carp (Carp).

SEE ALSO

Top

Class::DBI::Pager does a similar job, but retrieves the entire results set into memory before chopping out the page you want.

BUGS

Top

Please report all bugs via the CPAN Request Tracker at http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-DBI-Plugin-Pager.

COPYRIGHT AND LICENSE

Top

Copyright 2004 by David Baird.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

AUTHOR

Top

David Baird, cpan@riverside-cms.co.uk

Class-DBI-Plugin-Pager documentation Contained in the Class-DBI-Plugin-Pager distribution. 
package Class::DBI::Plugin::Pager;
use strict;
use warnings;
use Carp;

use UNIVERSAL::require;
use SQL::Abstract;

use base qw( Data::Page Class::Data::Inheritable ); 

use vars qw( $VERSION );

$VERSION = 0.561;

# D::P inherits from Class::Accessor::Chained::Fast
__PACKAGE__->mk_accessors( qw( where abstract_attr per_page page order_by _cdbi_app ) );

__PACKAGE__->mk_classdata( '_syntax' );
__PACKAGE__->mk_classdata( '_pager_class' );



sub import {
    my ( $class ) = @_; # the pager class or subclass

    __PACKAGE__->_pager_class( $class );

    my $caller;

    # find the app - supports subclassing (My::Pager is_a CDBI::P::Pager, not_a CDBI)
    foreach my $level ( 0 .. 10 )
    {
        $caller = caller( $level );
        last if UNIVERSAL::isa( $caller, 'Class::DBI' )
    }

    warn( "can't find the CDBI app" ), return unless $caller; 
    #croak( "can't find the CDBI app" ) unless $caller;

    no strict 'refs';
    *{"$caller\::pager"} = \&pager;
}


sub pager {
    my $cdbi = shift;

    my $class = __PACKAGE__->_pager_class;

    my $self = bless {}, $class;

    $self->_cdbi_app( $cdbi );

    # This has to come before _init, so the caller can choose to set the syntax
    # instead. But don't auto-set if we're a subclass.
    $self->auto_set_syntax if $class eq __PACKAGE__;

    $self->_init( @_ );

    return $self;
}

# _init is also called by results, so preserve any existing settings if
# new settings are not provided
sub _init {
    my $self = shift;

    return unless @_;

    my ( $where, $abstract_attr, $order_by, $per_page, $page, $syntax );

    if ( ref( $_[0] ) or $_[0] =~ /^\d+$/ )
    {
        $where          = shift if ref $_[0]; # SQL::Abstract accepts a hashref or an arrayref 
        $abstract_attr  = shift if ref $_[0] eq 'HASH';
#        $order_by       = shift unless $_[0] =~ /^\d+$/;
#        $per_page       = shift if $_[0] =~ /^\d+$/;
#        $page           = shift if $_[0] =~ /^\d+$/;
        $order_by       = shift unless $_[0] and $_[0] =~ /^\d+$/;
        $per_page       = shift if $_[0] and $_[0] =~ /^\d+$/;
        $page           = shift if $_[0] and $_[0] =~ /^\d+$/;         
        $syntax         = shift;
    }
    else
    {
        my %args  = @_;

        $where          = $args{where};
        $abstract_attr  = $args{abstract_attr};
        $order_by       = $args{order_by};
        $per_page       = $args{per_page};
        $page           = $args{page};
        $syntax         = $args{syntax};
    }

    # Emulate AbstractSearch's search_where ordering -VV 20041209
    $order_by = delete $$abstract_attr{order_by} if ($abstract_attr and !$order_by);

    $self->per_page( $per_page )          if $per_page;
    $self->set_syntax( $syntax )          if $syntax;
    $self->abstract_attr( $abstract_attr )if $abstract_attr;
    $self->where( $where )                if $where;
    $self->order_by( $order_by )          if $order_by;
    $self->page( $page )                  if $page;
}


# like CDBI::AbstractSearch::search_where, with extra limitations
sub search_where {
    my $self = shift;

    $self->_init( @_ );

    $self->_setup_pager;

    my $cdbi = $self->_cdbi_app;

    my $order_by      = $self->order_by || [ $cdbi->primary_columns ];
    my $where         = $self->where;
    my $syntax        = $self->_syntax || $self->set_syntax;
    my $limit_phrase  = $self->$syntax;
    my $sql           = SQL::Abstract->new( %{ $self->abstract_attr  || {} } );

    $order_by = [ $order_by ] unless ref $order_by;
    my ( $phrase, @bind ) = $sql->where( $where, $order_by );
    
    # If the phrase starts with the ORDER clause (i.e. no WHERE spec), then we are 
    # emulating a { 1 => 1 } search, but avoiding the bug in Class::DBI::Plugin::AbstractCount 0.04,
    # so we need to replace the spec - patch from Will Hawes
    if ( $phrase =~ /^\s*ORDER\s*/i ) 
    {
        $phrase = ' 1=1' . $phrase;
    }
    

    $phrase .= ' ' . $limit_phrase;
    $phrase =~ s/^\s*WHERE\s*//i;

    return $cdbi->retrieve_from_sql( $phrase, @bind );
}


sub retrieve_all 
{
    my $self = shift;

    my $get_all = {}; # { 1 => 1 };

    unless ( @_ ) 
    {   # already set pager up via method calls
            $self->where( $get_all );
            return $self->search_where;
    }
    
    my @args = ( ref( $_[0] ) or $_[0] =~ /^\d+$/ ) ?
                ( $get_all, @_ ) :          # send an array
                ( where => $get_all, @_ );  # send a hash

    return $self->search_where( @args );
}

sub _setup_pager 
{
    my ( $self ) = @_;

    my $where = $self->where || {}; 
    
    # fix { 1 => 1 } as a special case - Class::DBI::Plugin::AbstractCount 0.04 has a bug in 
    # its column-checking code
    if ( ref( $where ) eq 'HASH' and $where->{1} )
    {
        $where = {};
        $self->where( {} );
    }    
    
    my $per_page = $self->per_page || croak( 'no. of entries per page not specified' );
    my $cdbi     = $self->_cdbi_app;
    my $count    = $cdbi->count_search_where( $where, $self->abstract_attr );
    my $page     = $self->page || 1;

    $self->total_entries( $count );
    $self->entries_per_page( $per_page );
    $self->current_page( $page );
    
    croak( 'Fewer than one entry per page!' ) if $self->entries_per_page < 1;

    $self->current_page( $self->first_page ) unless defined $self->current_page;
    $self->current_page( $self->first_page ) if $self->current_page < $self->first_page;
    $self->current_page( $self->last_page  ) if $self->current_page > $self->last_page;
}

# SQL::Abstract::_recurse_where eats the WHERE clause 
#sub where {
#	my ( $self, $where_ref ) = @_;
#
#	return $self->_where unless $where_ref;
#
#	my $where_copy;
#
#	if ( ref( $where_ref ) eq 'HASH' ) {
#		$where_copy = { %$where_ref };
#	}
#	elsif ( ref( $where_ref ) eq 'ARRAY' )
#	{
#		$where_copy = [ @$where_ref ];
#	}
#	else
#	{
#		die "WHERE clause [$where_ref] must be specified as an ARRAYREF or HASHREF";
#	}
#
#	# this will get eaten, but the caller's value is now protected
#	$self->_where( $where_copy );
#}


sub set_syntax {
    my ( $proto, $syntax ) = @_;

    # pick up default from subclass, or load from LimitOffset
    $syntax ||= $proto->can( 'make_limit' );
    $syntax ||= 'LimitOffset';

    if ( ref( $syntax ) eq 'CODE' )
    {
        $proto->_syntax( $syntax );
        return $syntax;
    }

    my $format_class = $syntax =~ '::' ? $syntax : "Class::DBI::Plugin::Pager::$syntax";

    $format_class->require || croak "error loading $format_class: $UNIVERSAL::require::ERROR";

    my $formatter = $format_class->can( 'make_limit' ) || croak "no make_limit method in $format_class";

    $proto->_syntax( $formatter );

    return $formatter;
}


sub auto_set_syntax {
    my ( $self ) = @_;

    # not an exhaustive list
    my %not_supported = ( oracle => 'Oracle',
                          db2    => 'DB2',
                          );

    # additions welcome
    my %supported = ( pg        => 'LimitOffset',
                      mysql     => 'LimitOffset', # older versions need LimitXY
                      sqlite    => 'LimitOffset', # or LimitYX
                      sqlite2   => 'LimitOffset', # or LimitYX
                      interbase => 'RowsTo',
                      firebird  => 'RowsTo',
                      );

    my $cdbi = $self->_cdbi_app;

    my $driver = lc( $cdbi->__driver );

    die __PACKAGE__ . " can't build limit clauses for $not_supported{ $driver }"
        if $not_supported{ $driver };
        
    #warn sprintf "Setting syntax to %s for $driver", $supported{ $driver } || 'LimitOffset';

    $self->set_syntax( $supported{ $driver } || 'LimitOffset' );
}

1;

__END__

#=for notes
#
#Would this work?
#
#with $limit and $offset defined.
#
#my $last = $limit + $offset
#
#my $order_by_str = join( ', ', @$order_by )
#
#$cdbi->set_sql( emulate_limit => <<'');
#    SELECT * FROM (
#        SELECT TOP $limit * FROM (
#            SELECT TOP $last __ESSENTIAL__
#            FROM __TABLE__
#            ORDER BY $order_by_str ASC
#        ) AS foo ORDER BY $order_by_str DESC
#    ) AS bar ORDER BY $order_by_str ASC
#
#
#e.g. MS Access (thanks Emanuele Zeppieri)
#
#to add LIMIT/OFFSET to this query:
#
#SELECT my_column
#FROM my_table
#ORDER BY my_column ASC
#
#say with the values LIMIT=5 OFFSET=10, you have to resort to the TOP
#clause and re-write it this way:
#
#SELECT * FROM (
#	SELECT TOP 5 * FROM (
#		SELECT TOP 15 my_column
#		FROM my_table
#		ORDER BY my_column ASC
#	) AS foo ORDER BY my_column DESC
#) AS bar ORDER BY my_column ASC
#
#=cut