license => 'perl',
module_name => 'DBIx::Class',
requires => {
+ 'Data::Page' => 0,
'DBI' => 0,
'UNIVERSAL::require' => 0,
'NEXT' => 0,
__PACKAGE__->load_components(qw/
InflateColumn
Relationship
+ Pager
PK
Row
Table
--- /dev/null
+package DBIx::Class::Pager;
+
+use strict;
+use warnings;
+
+use NEXT;
+use Data::Page;
+
+=head1 NAME
+
+DBIx::Class::Pager - Pagination of resultsets
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class lets you page through a resultset.
+
+=head1 METHODS
+
+=over 4
+
+=item page
+
+=item pager
+
+=cut
+
+*pager = \&page;
+
+sub page {
+ my $self = shift;
+ my ($criteria, $attr) = @_;
+
+ my $rows = $attr->{rows} || 10;
+ my $current = $attr->{page} || 1;
+
+ # count must not use LIMIT, so strip out rows/offset
+ delete $attr->{$_} for qw/rows offset/;
+
+ my $total = $self->count( $criteria, $attr );
+ my $page = Data::Page->new( $total, $rows, $current );
+
+ $attr->{rows} = $page->entries_per_page;
+ $attr->{offset} = $page->skipped;
+
+ my $iterator = $self->search( $criteria, $attr );
+
+ return ( $page, $iterator );
+}
+
+1;
+
+=back
+
+=head1 AUTHORS
+
+Andy Grundman <andy@hybridized.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
sub count {
my ($self) = @_;
- return $self->{attrs}{rows} if $self->{attrs}{rows};
- # This is a hack, and will break on the last page of a paged set.
- # Once we have limit support in Storage, kill it.
-
my $db_class = $self->{class};
+
+ # offset breaks COUNT(*), so remove it
+ my $attrs = { %{ $self->{attrs} } };
+ delete $attrs->{offset};
+
my @cols = 'COUNT(*)';
my ($c) = $db_class->storage->select_single($db_class->_table_name, \@cols,
- $self->{cond}, $self->{attrs});
- return $c; # ($cursor->next)[0];
+ $self->{cond}, $attrs);
+ return 0 unless $c;
+ return ( $attrs->{rows} && $attrs->{rows} < $c )
+ ? $attrs->{rows}
+ : $c;
}
sub all {
--- /dev/null
+use Test::More;
+
+plan tests => 8;
+
+use lib qw(t/lib);
+
+use_ok('DBICTest');
+
+# first page
+my ( $pager, $it ) = DBICTest::CD->page(
+ {},
+ { order_by => 'title',
+ rows => 3,
+ page => 1 }
+);
+
+is( $pager->entries_on_this_page, 3, "entries_on_this_page ok" );
+
+is( $pager->next_page, 2, "next_page ok" );
+
+is( $it->next->title, "Caterwaulin' Blues", "iterator->next ok" );
+
+$it->next;
+$it->next;
+
+is( $it->next, undef, "next past end of page ok" );
+
+# second page
+( $pager, $it ) = DBICTest::CD->page(
+ {},
+ { order_by => 'title',
+ rows => 3,
+ page => 2 }
+);
+
+is( $pager->entries_on_this_page, 2, "entries on second page ok" );
+
+is( $it->next->title, "Generic Manufactured Singles", "second page first title ok" );
+
+# XXX: Should we support disable_sql_paging?
+#( $pager, $it ) = DBICTest::CD->page(
+# {},
+# { rows => 2,
+# page => 2,
+# disable_sql_paging => 1 } );
+#
+#cmp_ok( $pager->total_entries, '==', 5, "disable_sql_paging total_entries ok" );
+#
+#cmp_ok( $pager->previous_page, '==', 1, "disable_sql_paging previous_page ok" );
+#
+#is( $it->next->title, "Caterwaulin' Blues", "disable_sql_paging iterator->next ok" );
+#
+#$it->next;
+#
+#is( $it->next, undef, "disable_sql_paging next past end of page ok" );
+
+# based on a failing criteria submitted by waswas
+# requires SQL::Abstract >= 1.20
+( $pager, $it ) = DBICTest::CD->page(
+ { title => [
+ -and =>
+ {
+ -like => '%bees'
+ },
+ {
+ -not_like => 'Forkful%'
+ }
+ ]
+ },
+ { rows => 5 }
+);
+is( $it->count, 1, "complex abstract count ok" );