File Coverage

blib/lib/Class/DBI/Pageset.pm

Criterion	Covered	Total	%
statement	21	42	50.0
branch	2	14	14.2
condition	0	9	0.0
subroutine	5	9	55.5
pod			n/a
total	28	74	37.8

package Class::DBI::Pageset;

###########################################################################
# Class::DBI::Pageset
# Mark Grimes
# $Id: NAMESPACE.pm,v 1.3 2006/11/29 02:40:22 mgrimes Exp $
#
# A flexible pager utility for Class::DBI
# Copyright (c) 2008 Mark Grimes ([e-mail]).
# All rights reserved. This program is free software; you can redistribute
# it and/or modify it under the same terms as Perl itself.
#
# Heavily inspired by (read: stolen from) Class::DBI::Pager and
# DBIx::Class::ResultSet::Data::Pageset. Thanks!
#
###########################################################################

use strict;
use warnings;

our $VERSION = '0.14';
our $AUTOLOAD;

use Class::DBI 0.90;
our $PAGER_IMPLEMENTATION = 'Data::Pageset';

sub _croak { require Carp; Carp::croak(@_); }

sub import {
    my $class = shift;
    my $pkg   = caller(0);
    no strict 'refs';
    *{"$pkg\::pager"} = \&_pager;

    $PAGER_IMPLEMENTATION = shift if @_;
    ( my $pager_implementation_file = "$PAGER_IMPLEMENTATION.pm" ) =~ s{::}{/}g;
    eval { require $pager_implementation_file; };
    _croak "Unable to use $PAGER_IMPLEMENTATION: $@" if $@;
}

sub _pager {
    my $pkg  = shift;
    my @args = qw( entries_per_page current_page pages_per_set mode );
    my $opts = {};
    while ( @_ and not ref $_[0] ) {
        $opts->{ shift @args } = shift;
    }
    my $ref = ref $_[0] eq 'HASH' ? shift : {};
    return bless {
        pkg        => $pkg,
        pager      => undef,
        pager_opts => { %$opts, %$ref, },
      },
      __PACKAGE__;
}

sub AUTOLOAD {
    my $self = shift;
    ( my $method = $AUTOLOAD ) =~ s/.*://;
    if ( ref($self) && $self->{pkg}->can($method) ) {
        my $iter = $self->{pkg}->$method(@_);
        UNIVERSAL::isa( $iter, 'Class::DBI::Iterator' )
          or _croak("$method doesn't return Class::DBI::Itertor");
        my $pager_opts = $self->{pager_opts};
        my $pager = $self->{pager} = $PAGER_IMPLEMENTATION->new( {
                total_entries => $iter->count,
                %$pager_opts,
        } );
        return $iter->slice( $pager->first - 1, $pager->last - 1 );
    } elsif ( $PAGER_IMPLEMENTATION->can($method) ) {
        $self->{pager} or _croak("Can't call pager methods before searching");
        return $self->{pager}->$method(@_);
    } else {
        _croak(
            qq(Can't locate object method "$method" via package ) . ref($self)
              || $self );
    }
}

sub DESTROY { }

1;

__END__