File Coverage

blib/lib/CatalystX/Widget/Paginator.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	23	24	95.8
condition	26	33	78.7
subroutine	15	15	100.0
pod	2	3	66.6
total	128	137	93.4

package CatalystX::Widget::Paginator;

=head1 NAME

CatalystX::Widget::Paginator - HTML widget for digg-style paginated DBIx::ResulSet

=head1 VERSION

Version 0.06

=cut

our $VERSION = '0.06';

use List::Util qw( min max );
use Moose;
use Moose::Util::TypeConstraints;
use POSIX qw( ceil floor );

extends 'Catalyst::Plugin::Widget::Base';
with    'Catalyst::Plugin::Widget::WithResultSet';


=head1 DESCRIPTION

This widget intended to solve the general problem with paginated results.
Assume that we have a set of objects (L<DBIx::Class::ResultSet>) and (probably)
the L<Catalyst::Request> parameter indicates the current page. Created widget
receives resultset and additional arguments, validates pagination and can be
queried about pagination and objects presented for current page.

For the correct determination of the current page widget makes taking
the following steps:

1. Checks for constructor arguments: C<page>, C<rows>. If specified, uses them.

2. Checks for already paginated resultset (see L<DBIx::Class::ResultSet>
C<rows> and C<page> attributes for details). If specified - uses them.

3. Uses the default value for C<rows> (10).

4. If attribute C<page_auto> is enabled (default), try to get request parameter
named C<page_arg> for C<page> value.

5. Uses the default value for C<page> (1).

After successful identification C<page> and C<rows> attributes, the widget
checks their validity for a specified resultset. Processing logic for non-valid
attributes defined by C<invalid> attribute.

Created instance of a widget can be queried about its attributes.
For example: C<last>, C<pages>, C<objects>, etc.

Widget is converted to a string represetning the HTML table with page numbers
as links in the cells. Design details can be configured with C<style> and
C<style_prefix> attributes.


=head1 SYNOPSIS

Typical usage pattern in the controller:

  sub index :Path :Args(0) {
      my ( $self,$c ) = @_;

      my $pg = $c->widget( 'Paginator', rs => 'Schema::User' );

      my $current = $pg->page;     # current page no
      my $first   = $pg->first;    # first page no (1)
      my $last    = $pg->last;     # last page no
      my $pages   = $pg->total;    # total pages ($last - $first + 1)
      my $total   = $pg->total;    # total objects (overall pages)
      my $objects = $pg->objects;  # objects for current page

      $c->res->body( "$pg" );      # render to nice HTML table
  }


With L<DBIx::Class::ResultSet> instance:

  my $pg = $c->widget( 'Paginator',
      rs   => $c->model('Schema::User'),
      rows => 3, page => 15
  );


With paginated L<DBIx::Class::ResultSet> instance:

  my $pg = $c->widget( 'Paginator',
      rs => $c->model('Schema::User')->search_rs( undef, { rows => 3, page => 15 )
  );


Handling invalid page:

  use Try::Tiny;

  my $pg = try {
      $c->widget( 'Paginator',
          rs      => 'Schema::User',
          invalid => 'raise'
      )
  } except {
      $c->detach('/error404') if /PAGE_OUT_OF_RANGE/;
      die $_;
  };


The same effect:

  my $pg = $c->widget( 'Paginator',
      rs      => 'Schema::User',
      invalid => sub { $c->detach('/error404' )
  };

Subclassing in your application:

  package YourApp::Widget::SimplePager;
  use Moose;
  extends 'CatalystX::Widget::Paginator';

  has '+edges'    => ( is => 'ro', default => undef );
  has '+invalid'  => ( is => 'ro', default => 'last' );
  has '+page_arg' => ( is => 'ro', default => 'page' );
  has '+prefix'   => ( is => 'ro', default => undef );
  has '+side'     => ( is => 'ro', default => 0 );
  has '+suffix'   => ( is => 'ro', default => undef );

  __PACKAGE__->meta->make_immutable;
  1;

Usage subclassed widget in the controller:

  $c->widget( '~SimplePager', rs => 'Schema::User' );

=head1 RENDERING

Widget renders (string representated) as HTML table with single row and
multiple columns:

  prefix | edge | side | delim |  main  |  delim | side | edge | suffix
  ----------------------------------------------------------------------
  Pages:   <<     1  2    ...    7 >8< 9    ...    40 41   >>    Total:x
  ----------------------------------------------------------------------

Table has HTML class attribute with a C<style> value. Cells HTML
class attribute consists from C<style_prefix> and block name, where
the names of the blocks the same as in example above. Current page framed
with HTML span tag, others with links.

=cut


# constructor
sub BUILD {
	my ( $self,$args ) = @_;

	# is page number valid?
	&{ $self->invalid } if $self->page > $self->last;
}

#
# types (used internally)
#
subtype __PACKAGE__ . '::Edges'
	=> as 'ArrayRef',
	=> where { $#$_==1 }
;
subtype __PACKAGE__ . '::Format'
	=> as 'CodeRef'
;
coerce __PACKAGE__ . '::Format'
	=> from 'Str',
	=> via { my $x = $_; sub { sprintf $x,@_ } }
;
subtype __PACKAGE__ . '::Invalid'
	=> as 'CodeRef'
;
coerce __PACKAGE__ . '::Invalid'
	=> from 'Str',
	=> via {
		return sub { my $self=shift; $self->_set_page( $self->first ) }
			if $_ eq 'first';
		return sub { my $self=shift; $self->_set_page( $self->last ) }
			if $_ eq 'last';
		return sub { die 'PAGE_OUT_OF_RANGE' }
			if $_ eq 'raise';
		die 'invalid value for "invalid" attribute';
	}
;
subtype __PACKAGE__ . '::NaturalInt'
	=> as 'Int',
	=> where { $_ >= 0 }
;
subtype __PACKAGE__ . '::PositiveInt'
	=> as 'Int',
	=> where { $_ > 0 }
;
coerce __PACKAGE__ . '::PositiveInt'
	=> from 'Defined',
	=> via { /^(\d+)$/ ? $1 : 1 }
;
subtype __PACKAGE__ . '::ResultSet'
	=> as 'Object',
	=> where { $_->isa('DBIx::Class::ResultSet') }
;
subtype __PACKAGE__ . '::Text'
	=> as 'CodeRef'
;
coerce __PACKAGE__ . '::Text'
	=> from 'Str',
	=> via { my $x = $_; sub { $x } }
;


=head1 CONSTRUCTOR

=head2 new( rs => $name|$instance, %options )

=head3 rs

L<DBIx::Class::ResultSet> name or instance

=head3 options

=head4 delim

Delimeter string or C<undef> (default: '...'). See L</RENDERING> for details.

=cut

has delim => ( is => 'ro', isa => 'Str | Undef', default => '...' );


=head4 edges

Two element array of strings for left and right edges respectively or C<undef>
(default: ['<<','>>']). See L</RENDERING> for details.

=cut

has edges => ( is => 'ro', isa => __PACKAGE__ . '::Edges | Undef', default => sub{ ['<<','>>'] } );


=head4 invalid

Determines the constructor behavior in the case of an invalid page.
Could be arbitrary code block or one of predefined words:

=over

=item first

Force set C<page> to C<first> (default).

=item last

Force set C<page> to C<last>.

=item raise

Raise exception C<PAGE_OUT_OF_RANGE>.

=back

=cut

has invalid => ( is => 'ro', isa => __PACKAGE__ . '::Invalid', coerce => 1, default => 'first' );


=head4 link

Code reference for build link. Receives page number as argument and returns target URI.

=cut

has link => ( is => 'ro', isa => 'CodeRef', lazy => 1, builder => '_link' );

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

	my $c = $self->context;

	sub {
		$c->uri_for( $c->action, $c->req->captures, @{ $c->req->args },
			{ %{ $c->req->params }, $self->page_arg => shift } );
	}
}


=head4 main

Size of 'main' pages group (default: 10). See L</RENDERING> for details.

=cut

has main  => ( is => 'ro', isa => __PACKAGE__ . '::PositiveInt', default => 10 );


=head4 page

Current page number.

=cut

has page => ( is => 'ro', isa => __PACKAGE__ . '::PositiveInt', coerce => 1, lazy => 1, builder => '_page', writer => '_set_page' );

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

	my $p = $self->resultset->{ attrs }{ page };

	$p ||= $self->context->req->param( $self->page_arg )
		if $self->page_auto;

	$p || 1;
}


=head4 page_arg

Name of query string parameter for page number extracting (default: 'p').

=cut

has page_arg => ( is => 'ro', isa => 'Str', default => 'p' );


=head4 page_auto

Try or not to extract C<page_arg> from L<Catalyst::Request> automatically
(default: 1).

=cut

has page_auto => ( is => 'ro', isa => 'Bool', default => 1 );


=head4 prefix

First cell content (default: 'Pages'). See L</RENDERING> for details.

=cut

has prefix => ( is => 'ro', isa => __PACKAGE__ . '::Text | Undef', coerce => 1, default => 'Pages:' );


=head4 rows

Number of objects per page (default: 10).

=cut

has rows => ( is => 'ro', isa => __PACKAGE__ . '::PositiveInt', lazy => 1, builder => '_rows' );

sub _rows {
	shift->resultset->{ attrs }{ rows } || 10;
}


=head4 side

Size of 'side' pages groups (default: 2). See L</RENDERING> for details.

=cut

has side  => ( is => 'ro', isa => __PACKAGE__ . '::NaturalInt', default => 2 );


=head4 style

CSS class name for table tag (default: 'pages'). See L</RENDERING> for details.

=cut

has style => ( is => 'rw', isa => 'Str', default => 'pages' );


=head4 style_prefix

CSS class name prefix for table cells (default: 'p_'). See L</RENDERING> for details.

=cut

has style_prefix => ( is => 'rw', isa => 'Str', default => 'p_' );


=head4 suffix

Last cell content (default: 'Total: x'). See L</RENDERING> for details.

=cut

has suffix => ( is => 'ro', isa => __PACKAGE__ . '::Text | Undef', coerce => 1, default => sub { sub { 'Total: ' . shift->total } } );


=head4 text

Code reference for page number formatting. Receives page number as argument and
returns string. Also can be just a sprintf format string (default: '%s').
See L</RENDERING> for details.

=cut

has text => ( is => 'ro', isa => __PACKAGE__ . '::Format', coerce => 1, default => '%s' );



=head1 ATTRIBUTES

=head2 first

First page number.

=cut

has first => ( is => 'ro', isa => __PACKAGE__ . '::PositiveInt', init_arg => undef, default => 1 );


=head2 last

Last page number.

=cut

has last => ( is => 'ro', isa => __PACKAGE__ . '::PositiveInt', init_arg => undef, lazy => 1, builder => '_last' );

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

	ceil $self->total / $self->rows;
}


=head2 objects

Paged L<DBIx::Class::ResulSet> instance.

=cut

has objects => ( is => 'ro', isa => __PACKAGE__ . '::ResultSet', lazy => 1, builder => '_objects' );

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

	$self->resultset->search( undef, { page => $self->page, rows => $self->rows } );
}


=head2 pages

Total number of pages.

=cut

has pages => ( is => 'ro', isa => __PACKAGE__ . ':: PositiveInt', init_arg => undef, lazy => 1, builder => '_pages' );

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

	$self->last - $self->first;
}


=head2 total

Total objects count (overall pages).

=cut

has total => ( is => 'ro', isa => 'Int', lazy => 1, builder => '_total' );

sub _total {
	shift->resultset->search( undef, { map { $_ => undef } qw( page rows offset ) } )->count;
}


=head1 METHODS

=head2 format

Formatting linked page item.

=cut

sub format {
	my ( $self,$page,$text ) = @_;

	return '<span class="' . $self->style_prefix . 'current">' . &{ $self->text }( $text || $page ) . '</span>'
		if $self->page==$page;

	'<a href="' . &{ $self->link }( $page ). '">' . &{ $self->text }( $text || $page ) . '</a>';
}


=head2 render

Overriden L<Catalyst::Plugin::Widget> C<render> method.

=cut

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

	return '' unless $self->pages;

	# 'main' boundaries
	my $ml = $self->page - floor( ($self->main - 1) / 2);
	my $mr = $self->page + ceil ( ($self->main - 1) / 2);

	# 'main' adjustment
	$mr-- while $mr > $self->last  && $ml-- >= $self->first;
	$ml++ while $ml < $self->first && $mr++ <= $self->last;

	# 'main' range
	my @main = $ml .. $mr;

	# 'head' range
	my @head = $self->first .. min( $self->first + $self->side, $main[0] ) - 1;

	# 'tail' range
	my @tail = max( $self->last - $self->side , $main[-1] ) + 1 .. $self->last;

	# rendering
	my $r = '<table class="' . $self->style . '"><tr>';

	# 'prefix'
	$r .= '<td class="' . $self->style_prefix . 'prefix">' . &{ $self->prefix }( $self ) . '</td>'
		if $self->prefix;

	# 'prev' edge
	$r .= '<td class="' .$self->style_prefix . 'edge">' . $self->format( $self->page - 1, $self->edges->[0] ) . '</td>'
		if $self->page > $self->first && $self->edges;

	# 'head' side
	$r .= '<td class="'. $self->style_prefix .'side">' . $self->format( $_ ) . '</td>'
		for @head;

	# 'delim'
	$r .= '<td class="' . $self->style_prefix . 'delim">' . $self->delim . '</td>'
		if $self->delim && @head && $main[0] - $head[-1] > 1;

	# 'main'
	$r .= '<td class="' . $self->style_prefix . 'main">' . $self->format( $_ ) . '</td>'
		for @main;

	# 'delim'
	$r .= '<td class="' . $self->style_prefix . 'delim">' . $self->delim . '</td>'
		if $self->delim && @tail && $tail[0] - $main[-1] > 1;

	# 'tail' side
	$r .= '<td class="' . $self->style_prefix . 'side">' . $self->format( $_ ) . '</td>'
		for @tail;

	# 'next' edge
	$r .= '<td class="' . $self->style_prefix . 'edge">' . $self->format( $self->page + 1, $self->edges->[1] ) . '</td>'
		if $self->page < $self->last && $self->edges;

	# 'suffix'
	$r .= '<td class="' . $self->style_prefix . 'suffix">' . &{ $self->suffix }( $self ) . '</td>'
		if $self->suffix;

	# done!
	$r .= '</tr></table>';
}


=head1 AUTHOR

Oleg A. Mamontov, C<< <oleg at mamontov.net> >>


=head1 BUGS

Please report any bugs or feature requests to C<bug-catalystx-widget-paginator at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-Widget-Paginator>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc CatalystX::Widget::Paginator


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-Widget-Paginator>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/CatalystX-Widget-Paginator>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/CatalystX-Widget-Paginator>

=item * Search CPAN

L<http://search.cpan.org/dist/CatalystX-Widget-Paginator/>

=back


=head1 LICENSE AND COPYRIGHT

Copyright 2010 Oleg A. Mamontov.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut


1;