pager

[prev] [thread] [next] [Date index for 2004/10/20]

--Message-Boundary-18281
Content-type: text/plain; charset=US-ASCII
Content-transfer-encoding: 7BIT
Content-description: Mail message body


Hi,

I'd be grateful for comments from the list on a pager module I've 
written (attached to this email). It uses LIMIT so that only the 
required subset of results are loaded into memory. I've tried to code 
for different dialects, but I only run MySQL so I haven't tested the 
others - any pointers would be great. 

I've copied search_abstract from CDBI::AbstractSearch, and added the 
LIMIT code to that, but I'd be happy for the LIMIT code to go into 
CDBI::AS instead of the pager. The only issue there is that I don't 
know how to pass the dialect tag to the use statement in CDBI::AS, 
whereas I've figured it out for CDBI::Plugin (which the pager uses) 
[thanks to a recent post from Randal Schwartz]. 

I've called the thing C::DBI::Plugin::Pager, but perhaps 
C::DBI::Plugin::Abstract::Pager would be more accurate, though a bit 
long-winded for 100 lines of code. 

d.


        -- 
        Dr. David R. Baird
Riverside Content Management Systems
http://www.riverside-cms.co.uk



--Message-Boundary-18281
Content-type: text/plain; charset=US-ASCII
Content-transfer-encoding: 7BIT
Content-description: Text from file 'Pager.pm'

package Class::DBI::Plugin::Pager;
use strict;
use warnings;
use Carp;

use Data::Page;
use SQL::Abstract;

use base 'Class::DBI::Plugin';

use vars '$VERSION';
$VERSION = 0.1;

sub debug { 0 }

my $Dialect;

sub import {
    $Dialect = $_[1] || 'default';
    goto &{ __PACKAGE__->can( 'SUPER::import' ) };
}

sub search_where_paged : Plugged {
    my ( $class, @args ) = @_; # this is the plugged-into-class

    push( @args, 1 ) if @args == 2;

    my ( $where, $per_page, $current_page );

    if ( @args == 3 )
    {
        ( $where, $per_page, $current_page ) = @args;
    }
    else
    {
        my %args = @args;
        ( $where, $per_page, $current_page ) = ( $args{where},
                                                 $args{per_page},
                                                 $args{page},
                                                 );
    }

    my $count = $class->count_search_where( $where );

    my $pager = Data::Page->new( $count, $per_page, $current_page );

    my @results = $class->_search_where_limitable(
                                         $where,
                                         { limit => [ $pager->skipped,
                                                      $pager->entries_per_page,
                                                      ] } );

    return $pager, @results;
}

# This is CDBI::AbstractSearch::search_where, with extra limitations
sub _search_where_limitable : Plugged {
    my $class = shift;  # this is the plugged-into-class
    my $where = ( ref $_[0] ) ? $_[0] : { @_ };
    my $attr  = ( ref $_[0] ) ? $_[1] : undef;
    my $order = ( $attr ) ? delete( $attr->{order_by} ) : undef;
    my $limit = ( $attr ) ? delete( $attr->{limit} )    : undef;

    if ( debug )
    {
        require YAML;
        warn 'limitations: ' . YAML::Dump( $limit );
        warn "dialect: $Dialect";
    }

    # order is deprecated, but still backward compatible
    if ( $attr && exists $attr->{order} )
    {
        $order = delete $attr->{order};
    }

    $class->can( 'retrieve_from_sql' ) or
        croak( "$class should inherit from Class::DBI >= 0.90" );

    my $sql = SQL::Abstract->new( %$attr );

    my ( $phrase, @bind ) = $sql->where( $where, $order );

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

    if ( $limit )
    {
        my ( $offset, $rows, $limit_phrase );

        if ( my $input = ref $limit )
        {
            if ( $input eq 'ARRAY' )
            {
                ( $offset, $rows ) = @$limit;
            }
            elsif ( $input eq 'HASH' )
            {
                ( $offset, $rows ) = map { $limit->{ $_ } } qw( offset rows );
            }
            else
            {
                croak( "can't parse $limit for LIMIT params" );
            }

            croak( "undefined offset in $limit" ) unless defined $offset;
            croak( "undefined rows in $limit" )   unless defined $rows;

            $limit_phrase = " LIMIT $rows OFFSET $offset" if $Dialect eq 'default';
            $limit_phrase = " LIMIT $offset, $rows"       if $Dialect eq 'mysql';
            $limit_phrase = " ROWS $offset TO " . ( $rows + $offset ) if $Dialect eq 'interbase';
        }
        else
        {
            $limit_phrase = $limit;
        }

        $phrase .= $limit_phrase;

        warn "limit phrase: $limit_phrase" if debug;
    }

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

1;

__END__

=head1 NAME

Class::DBI::Plugin::Pager - paged results for CDBI::AbstractSearch

=head1 SYNOPSIS

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

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

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

    # or to use a different LIMIT syntax
    # use Class::DBI::Plugin::Pager 'mysql'; # or 'interbase'

    __PACKAGE__->set_db(...);


    # in a nearby piece of code...

    use CD;

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

    my ( $pager, @cds ) = CD->search_where_paged( where    => $where,
                                                  per_page => 10,
                                                  page     => 3,
                                                  );

    # or

    my ( $pager, @cds ) = CD->search_where_paged( $where, $per_page, $page );

    # $pager is a Data::Page object
    # @cds contains the CDs just for the current page

=head1 EXPORTS

=item search_where_paged

Uses the L<Class::DBI::Plugin|Class::DBI::Plugin> mechanism to put the method
C<search_where_paged> into the package of the caller. Accepts a
L<SQL::Abstract|SQL::Abstract> query specification.

=head1 DIALECTS

This module works by appending a LIMIT (or ROWS) phrase to the end of the WHERE
clause generated by L<SQL::Abstract|SQL::Abstract>. Please let me know of any
other dialects out there that can be implemented in this manner and I'll add
them in. Also, any comments on whether this actually does work for PostgreSQL
or InterBase would be very helpful, since I only have access to MySQL.

Pass a dialect tag to the use statement to change from the default.

=item default

    LIMIT $rows OFFSET $offset

This should work for PostgreSQL and some others.

=item mysql

    LIMIT $offset, $rows

=item interbase

    ROWS $offset TO $offset + $rows

Also FireBird, maybe others?

=head1 TODO

I've only used this on MySQL, reports of this thing working (or not)
elsewhere would be useful.

Tests.

=head1 DEPENDENCIES

L<SQL::Abstract|SQL::Abstract>,
L<Data::Page|Data::Page>,
L<Class::DBI::Plugin|Class::DBI::Plugin>,
L<Class::DBI::Plugin::AbstractCount|Class::DBI::Plugin::AbstractCount>,
L<Carp|Carp>.

=head1 SEE ALSO

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

=head1 BUGS

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

=head1 COPYRIGHT AND LICENSE

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.

=head1 AUTHOR

David Baird, C<cpan@xxxxxxxxxxxxx.xx.xx>






--Message-Boundary-18281--