DBIx::Classのページング処理 - 高知ではたらくひとのブログ

現在、DBIx::ClassとTemplate Toolkitを勉強しているところですが、ページングの処理が驚くほど簡単に書けるので自分用のメモを残しておきます。
CGI側でresultsetオブジェクトに対しpager()をコールすることで、Data::Pageオブジェクトを取得できます。

my $q = CGI->new;
my $schema = App::Schema->connect;
my $iterator = $schema->resultset('Comment')->search({}, {rows => 5}); # 1ページ辺りの行数は5

my $page = $q->param('page') || 1;
my $rs = $it->page($page);		# 1ページ目のresultsetオブジェクトを取得
print $q->header('text/html; charset=utf-8');
$template->process('index.tt', {iterator => $rs,
				pager => $rs->pager()});	# Data::Pageオブジェクトを取得

これをtemplate側で、渡したpagerを使って

Total [% pager.total_entries %] items.
### navigation like: [1] [2] [3]
[% FOREACH num=[pager.first_page .. pager.last_page] %]
	[% IF num == pager.current_page %]% num %
	[% ELSE %][[% num %]]
	[% END %]
[% END %]
#display data
[% WHILE (com = iterator.next) %]
	[% com.name | html %]
	[% com.comment | html %]
[% END %]

とすることで、1ページの5件づづデータを表示するwebアプリが作成できます。
しかも、ページのナビゲーション付です。

完全にViewとControllを分けることができるDBIx::ClassとTemlate Toolkitの組み合わせはかなりいい感じです。
それでは、汚いですが全てのコードを。
main.cgi

#!/usr/bin/perl -w
#
# 参考：
# エラー発生した場合は、以下でトレースを取得できる
# $schema->storage->debug(1);
# $schema->storage->debugfh(IO::File->new('/tmp/trace.out', 'w'));

use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);

use lib '.';
use App::Schema;
use Template;

my $q = CGI->new;
my $action = $q->param('action') || '';

if($q->param('add'))
{
	&edit($q);
}
elsif($q->param('edit_exe'))
{
	&edit_execute($q);
}
elsif($q->param('delete'))
{
	&delete($q);
}
elsif($q->param('search'))
{
	&index($q);
}
else
{
	&index($q);
}



sub edit
{
	my $q = shift;
	my $template = Template->new();

	print $q->header('text/html; charset=utf-8');
	$template->process('edit.tt');
}

sub edit_execute
{
	my $q = shift;

	my $schema = App::Schema->connect;
	my $rs = $schema->resultset('Comment');
	my $new = $rs->create( { name	=> $q->param('name'),
			comment	=> $q->param('comment')});
	&index($q);
}

sub index
{
	my $q = shift;
	my $template = Template->new();

	my ($schema, $it) = iterator_factory($q);

	my $page = $q->param('page') || 1;
	my $rs = $it->page($page);
	print $q->header('text/html; charset=utf-8');
	$template->process('index.tt', {iterator => $rs,
				pager => $rs->pager()});
}

sub delete
{
	my $q = shift;

	my @delete_id = $q->param('checkbox');
	my $schema = App::Schema->connect;
	
	for(@delete_id)
	{
		my $delete_item = $schema->resultset('Comment')->find($_);
		$delete_item->delete;
	}

	&index($q);
}

# $iteratorは、$schemaと一緒に返さないとエラーになるので注意
# 原因は今のところわからないorz
sub iterator_factory
{
	my $q = shift;
	my $rows = 5;

	my $schema = App::Schema->connect;

	my $search_name = $q->param('search_name');
	my $search_comment = $q->param('search_comment');
	my $search_string = $q->param('search_string');

	my $iterator;

	if($search_name && $search_comment)
	{
		# or検索
		$iterator = $schema->resultset('Comment')->search({-or => [name=> {'like', "%$search_string%"},
                                                                   comment => {'like', "%$search_string%"}
                                                          ]},
                                                          {rows => $rows});
	}
	elsif($search_name)
	{
		$iterator = $schema->resultset('Comment')->search({name=> {'like', "%$search_string%"}},
								  {rows => $rows});
	}
	elsif($search_comment)
	{
		$iterator = $schema->resultset('Comment')->search({comment => {'like', "%$search_string%"}},
							    {rows => $rows});
	}
	else
	{
		$iterator = $schema->resultset('Comment')->search({}, {rows => $rows});
	}

	return ($schema, $iterator);
}

index.tt

index.tt
>||
<html>
    <head><title>DBIx::Class Template Toolkit</title></head>
    <style type="text/css">
    </style> 
    <body>
        <h1>Hyper Search!!</h1>
        <form name="search_form" action="./main.cgi" method="GET">
            <table column="3">
                <tr>
                    <td>検索：</td>
                    <td><input type="text" name="search_string" size="50" value=""></td>
                    <td><input type="submit" name="search" value="検索"></td>
                </tr>
                <tr>
                    <td></td>
                    <td><input type="checkbox" name="search_name" value="name" CHECKED><font size=-1>名前を検索</font></td>
                </tr>
                <tr>
                    <td></td>
                    <td><input type="checkbox" name="search_comment" value="comment" CHECKED><font size=-1>コメントを検索</font></td>
                </tr>
            </table>
        </form>
        <br>
        <center>
        <table width="60%">
            <td>Total [% pager.total_entries %] items.
                [% FOREACH num=[pager.first_page .. pager.last_page] %]
                    [% IF num == pager.current_page %][[% num %]]
                    [% ELSE %]<a href="main.cgi?page=[% num %]">[[% num %]]</a>
                    [% END %]
                [% END %]
            </td>
        </table>
        <form name="form" action="./main.cgi" method="GET">
            <table width="60%" border=1 cellspacing=0>
                <tr>
                    <th>Delete?</th><th>Name</th><th>Comment</th>
                </tr>
                [% WHILE (com = iterator.next) %]
                <tr>
                    <td align="center"><input type="checkbox" name="checkbox" value=[% com.id %]></td>
                    <td>[% com.name | html %]</td>
                    <td>[% com.comment | html %]</td>
                </tr>
                [% END %]
            </table>
            <br>
            <table>
                <tr>
                    <td>
                        <input type="submit" name="add" value="新しく名前とコメントを追加">
                    </td>
                    <td>
                        <input type="submit" name="delete" value="選択した項目を削除">
                    </td>
                </tr>
            </table>
        </form>
        </center>
        [% INCLUDE footer.tt %]
    </body>
</html>

Schema.pm

#!/usr/bin/perl

package App::Schema;

use strict;
use base qw/DBIx::Class::Schema/;

__PACKAGE__->connection('dbi:Pg:host=localhost;dbname=test', 'user', 'password');
__PACKAGE__->load_classes(qw/Comment/);

1;

Comment.pm

#!/usr/bin/perl

package App::Schema::Comment;

use strict;
use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('comment');
__PACKAGE__->add_columns(qw/id name comment/);
__PACKAGE__->set_primary_key(qw/id/);

1;

参考：http://search.cpan.org/~miyagawa/Class-DBI-Pager-0.08/lib/Class/DBI/Pager.pm
(これはClass::DBI用ですが、サンプルソースが参考になります。)