O/Rマッパ DBIx::Class

2014/12/20 追記

DBIx::Classのselect等のリファレンスは、次のurlが分かりやすいです
http://yanor.net/wiki/?Perl-DBIC

O/Rマッパとは、Object-Relational マッパの略称のようですが、今回はperl用orマッパの一つであるDBIx::Classを試してみます。

perl用のorマッパには、Class::DBI もありますが、DBIx::Classは、Class::DBIをインスパイアして作成されたそうです。

また、Class::DBI を CDBI、 DBIx::Class を DBIC と略すそうです。

WEB+DB PRESS Vol.36 の Recent Perl World に記事が記載されていたので、記事に沿って、CLI (コマンドラインインタフェース) の bookmark アプリを作ります。

と書きながら、途中で話の内容が変わってくるかも...

DB schema

Recent Perl World では mysqlを使用していますが、私は postgres を使用します。

CREATE TABLE usr (
id		serial	primary key,
name		varchar(32)
);

CREATE TABLE entry (
id		serial	primary key,
url		varchar(255),
title		varchar(255),
created_on	timestamp
);

CREATE TABLE bookmark (
user_id		integer,
entry_id	integer,
comment		text,
created_on	timestamp,
primary key(user_id,entry_id)
);

サンプルデータ

id	name
1	suzuki
2	tanaka
3	endo

schema, table クラスの作成(手動?)

DBICでは、最初に次のクラスを作成する必要があります。

DBIx::Class::Schema を継承したschema クラス
DBIx::Class を継承した table クラス

これらのサンプルは次の通り。

DBIx::Class::Schema による schema クラス

package App::Schema;

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

__PACKAGE__->connection("DBI:Pg:dbname=Test;host=localhost;","uid","paswwd");
__PACKAGE__->load_classes(qw/Usr/);

1;

table クラス

tableクラスでは、table(), add_columns(), set_primary_key() 等でtable構造をtableスキーマに教える必要があります。

package App::Schema::Usr;

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

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

1;

動作確認

#!perl

use strict;
use warnings;

use lib qw(./lib);
use App::Schema;
use Data::Dumper;

my $schema = App::Schema->connect();
my $user = $schema->resultset('Usr')->find(1);

printf "id: %d\nname: %s\n", $user->id,$user->name;

用意したusrテーブルに対して、このスクリプトの実行結果は次のようになります。

id: 1
name:endo

DBIx::Class::Schema::Loader による動的なクラスの作成

DBIx::Class::Schema::Loader で Schemaクラス等の作成を自動にもできます。
例えば、次のようなschemaクラスを用意すると、tableクラス(App::Schema::Usr)を用意することなく、先程のスクリプトと同様の動作が可能になります。

package App::SchemaLoader;
use base qw/DBIx::Class::Schema::Loader/;

__PACKAGE__->loader_options(
			    constraint	=> 'usr',
#			    debug	=> 1,
			   );
1;

#!perl

use strict;
use warnings;

use lib qw(./lib);
use App::SchemaLoader;
use Data::Dumper;

my $DB_PATH = "DBI:Pg:dbname=TestDB;host=localhost;";
my $DB_USER = "user";
my $DB_PASS = "";

my $schema = App::SchemaLoader->connect($DB_PATH,$DB_USER,$DB_PASS);
my $user = $schema->resultset('Usr')->find(1);

printf "id: %d\nname: %s\n", $user->id,$user->name;

DBIx::ClassによるCRUD

CRUD: DBRSの4つの主要機能(Create, Read, Update, Delete)

DBIx::Classによる基本的なCRUD処理は、Recent Perl Worldでも紹介されていますが、非常に多くのmethodが用意されているため、cpan 等を参考にした方がいいと思います。

http://search.cpan.org/perldoc?DBIx::Class::ResultSet
http://e8y.net/mag/011-dbix-class/

DBIx::Classによる遅延評価

DBIC では、CDBI とは異なり、ResultSet経由でオブジェクトを取り扱います。
このResultSetにより遅延評価を実現しているようです。

my $schema = App::SchemaLoader->connect($DB_PATH,$DB_USER,$DB_PASS);

$schema->storage->debug(1);

#### 1.
my $users = $schema->resultset("Usr")->search_like({name=> '%e%'});

#### 2.
my $users = $schema->resultset("Usr")->search_like({name=> '%e%'});
while(my $user = $users->next ){}

#### 3.
$schema->resultset("Usr")->search_like({name=> '%e%'})->delete;

次のようにdebug(1)として、実行時の発行sqlを表示されると、次のようになります。

SELECT me.id, me.name FROM usr me WHERE ( name LIKE ? ): '%e%'
DELETE FROM usr WHERE ( name LIKE ? ): '%e%'

1.と2.で同様のsqlを発行しているはずですが、一方のsqlしか表示されていません。
DBICでは、イテレータをまわしてオブジェクトを取得する際に初めてsqlが発行されるそうです。

3.を見ると、search_like と delete のそれぞれのsqlが発行するように思えますが、DBICでは、一つのsql発行で済ませています。

DBIx::Class::Schema::Loader とのコンボでの relationship 作成

relationshipには、has_many():1対多や belongs_to():多対1 等を利用します。
他にもrelationship用のmethodはありますが、それらに関してcpanを参照すればいいかと思います。

http://search.cpan.org/perldoc?DBIx::Class::Relationship

今回、作成しているbookmarkアプリの usr-bookmark, entry-bookmark, bookmark-entry の場合、次のようにrelationshipのmethodを追加できます。

package App::Schema::Usr;
__PACKAGE__->has_many(bookmarks => "App::Schema::Bookmark",
		      {"foreign.user_id"=> "self.id"});
1;

package App::Schema::Bookmark;
__PACKAGE__->belongs_to(entry => "App::Schema::Entry",
			{"foreign.id"=> "self.entry_id"});
1;

package App::Schema::Entry;
__PACKAGE__->has_many(bookmarks => "App::Schema::Bookmark",
		      {"foreign.entry_id"=> "self.id"});
1;

DBIx::Class::Schema::Loader で、schemaクラスを自動生成し、
relationshipのみを上記のように手動で追加することができるようです。

※ActivePerlのDBIx::Class::Schema::Loaderはverが古いらしく、複数のtableクラスの作成ができないようでしたので、次のscriptはcolinux環境で実行しました。

#!/usr/local/bin/perl

use lib qw(./lib);
use App::Schema;

my $DB_PATH = "DBI:Pg:dbname=test;host=localhost;";
my $DB_USER = "";
my $DB_PASS = "";

my $schema = App::Schema->connect($DB_PATH,$DB_USER,$DB_PASS);
my $users = $schema->resultset('Usr')->search;

while (my $user = $users->next){
    print STDERR $user->name,"\t";
    my $bmarks = $user->bookmarks;
    print STDERR $bmarks->count,"\n";
}

suzuki	0
tanaka	0
endo	0

search_related()

relationshipに関連して search_related() というmethodがあります。
このmethodを使用すると、あるユーザのブックマーク中からの検索も可能になるようです。

$user->search_related('bookmarks',{entry_id=>2});

inflate , deflate によるカラムのオブジェクト化

DBIx::Classでは、inflate , deflate によりカラムのオブジェクトとして扱うことができるそうです。

例えば...

my $entry = $schema->resultset('Entry')->find(〜);
print $entry->url->host;  #URI.pm のhostメソッド

DBIx::Class::InflateColumn によれば、inflate deflateの定義例は次の通りです。
http://search.cpan.org/perldoc?DBIx::Class

__PACKAGE__->inflate_column('insert_time', {
    inflate => sub { DateTime::Format::Pg->parse_datetime(shift); },
    deflate => sub { DateTime::Format::Pg->format_datetime(shift); },
});

先程のURIであれば、次の通りです。

package App::Schema::Entry;
 ＜略＞
__PACKAGE__->inflate_column( 'url',{inflate=>sub {URI->new(shift)}},);

※deflate_column を省略した場合、stringとして扱うのかな?

DBIx::Class::InflateColumn::DateTime

DBICでは、日時の inflate / deflate を行う InflateColumn::DateTime があります。

package App::Schema::Entry;

__PACKAGE__->load_components(qw/InflateColumn::DateTime PK::Auto Core/);
__PACKAGE__->add_column(created_on=>{data_type=>"datetime"});
＜略＞

UTF8Columns で utf8フラグon

そのほかにも文字列のutf8フラグをonにするUTF8Columns もあるそうです。

__PACKAGE__->load_components(qw/UTF8Columns PK::Auto Core/);
__PACKAGE__->utf8_columns(qw/title/);

end0tknr's kipple - web写経開発

太宰府天満宮の狛犬って、妙にカワイイ