DBIC以降の選択肢
今回はデータベース話の締めくくりとして、
DBIx::Skinny
nekokakこと小林篤氏のDBIx::Skinnyは、
use strict;
use warnings;
# マッパを用意
package MyDB;
use DBIx::Skinny;
# スキーマを書いて
package MyDB::Schema;
use DBIx::Skinny::Schema;
use Time::Piece;
install_table user => schema {
pk 'id';
columns qw(id name created_at);
};
# inflateのルールはまとめておけます
install_inflate_rule '^.+_at$' => callback {
inflate { Time::Piece->new(shift) };
deflate { Time::Piece->new(shift)->epoch };
};
# ここから動作確認
package main;
my $db = MyDB->new({ dsn => 'dbi:SQLite::memory:' });
# データベースハンドルを直接操作
$db->dbh->do('create table user (
id integer primary key autoincrement,
name text,
created_at integer
)');
# 用意されているメソッドを使う例
$db->insert(user => { id => 1, name => 'foo' });
# 生SQLを使った検索。ここでは配列コンテキストで
my ($row) = $db->search_by_sql(
'select id, name, created_at from user where id = ?', [1]);
# rowオブジェクトの中身を確認
print $row->name, "\n";
print $row->created_at->ymd, "\n";
Teng
DBIx::Skinnyはよくできたモジュールですが、
use strict;
use warnings;
# マッパを用意
package MyDB;
use parent 'Teng';
# スキーマを書いて
package MyDB::Schema;
use Teng::Schema::Declare;
use Time::Piece;
table {
name 'user';
pk 'id';
columns qw(id name created_at);
inflate created_at => sub { Time::Piece->new(shift) };
deflate created_at => sub { Time::Piece->new(shift)->epoch };
};
# この例の場合、動作確認の部分はSkinnyのと同じです
package main;
my $db = MyDB->new({ connect_info => ['dbi:SQLite::memory:']});
$db->dbh->do('create table user (
id integer primary key autoincrement,
name text,
created_at integer
)');
$db->insert(user => { id => 1, name => 'foo' });
my ($row) = $db->search_by_sql(
'select id, name, created_at from user where id = ?', [1]);
print $row->name, "\n";
print $row->created_at->ymd, "\n";
Data::Model
Yappoこと大沢和宏氏のData::Modelは、
use strict;
use warnings;
package MyDB;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::DBI;
use Data::Model::Driver::Cache::HASH;
use Time::Piece;
# スキーマを定義するときにも使う基本のドライバ
my $driver = Data::Model::Driver::DBI->new(
dsn => 'dbi:SQLite::memory:',
);
base_driver $driver;
# キャッシュを透過的に扱うためのドライバ
my $cache = Data::Model::Driver::Cache::HASH->new(
fallback => $driver
);
# 複数のテーブルに共通の部分はまとめられます
column_sugar '_.at' => int => {
unsigned => 1,
default => sub { time },
inflate => sub { Time::Piece->new(shift) },
deflate => sub { Time::Piece->new(shift)->epoch },
};
column_sugar '_.id' => int => {
unsigned => 1,
};
# スキーマ定義。別名を使ったり、追加のメソッドをはやしたり
install_model user => schema {
key 'id';
column '_.id' => 'id' => { auto_increment => 1 };
column '_.at' => 'created_at';
columns qw(name);
add_method emails => sub {
my $row = shift;
map { $_->email } $row->get_model->get(
email => { index => { user_id => $row->id }}
);
};
};
install_model email => schema {
driver $cache; # このテーブルだけはキャッシュを有効に
index 'user_id';
column '_.id' => 'user_id';
columns qw(email);
};
# ここから動作確認
package main;
my $db = MyDB->new;
# スキーマの定義を実際のデータベースに反映
for my $name ($db->schema_names) {
my $dbh = $db->get_base_driver($name)->rw_handle;
$dbh->do($_) for $db->as_sqls($name);
}
# データを追加
my $user = $db->set(user => { name => 'foo' });
$db->set(email => {
user_id => $user->id,
email => 'foo@localhost'
});
# ここでは主キーで検索していますが、SQLを使った検索もできます
$user = $db->lookup(user => $user->id);
print $user->name, "\n";
print $user->emails, "\n";
print $user->created_at->ymd, "\n";
DBIx::ObjectMapper
2010年のYAPC::Asiaでも発表があった大石英介氏のDBIx::ObjectMapperは、
use strict;
use warnings;
# アプリで使うクラスを用意
package MyUser;
use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw/id name emails/);
# マッピングは外に出せるように別パッケージにまとめてあります
package MyMapper;
use DBIx::ObjectMapper;
use DBIx::ObjectMapper::Engine::DBI;
sub init {
my $class = shift;
my $_mapper = DBIx::ObjectMapper->new(
engine => DBIx::ObjectMapper::Engine::DBI->new({
dsn => 'dbi:SQLite::memory:',
on_connect_do => [
q/create table user (
id integer primary key autoincrement, name text )/,
q/create table email (
id integer primary key autoincrement,
user_id integer references user(id), email text )/,
],
}),
);
$_mapper->metadata->autoload_all_tables;
# テーブルのメタデータとアプリ用のクラスをマッピング
$_mapper->maps(
$_mapper->metadata->table('user') => 'MyUser',
attributes => {
properties => {
emails => {
isa => $_mapper->relation(has_many => 'MyEmail'),
},
},
},
);
# 面倒なときはクラスの定義もおまかせにできます
$_mapper->maps(
$_mapper->metadata->table('email') => 'MyEmail',
constructor => { auto => 1 },
accessors => { auto => 1 },
attributes => {
properties => {
user_id => {
isa => $_mapper->relation(belongs_to => 'MyUser'),
},
},
},
);
$_mapper;
}
# ここから動作確認
package main;
my $mapper = MyMapper->init;
# テーブルのメタデータから直接データを入れることもできます
$mapper->metadata->table('user')->insert->values(
id => 1,
name => 'foo'
)->execute;
$mapper->metadata->table('email')->insert->values(
user_id => 1,
email => 'foo@localhost'
)->execute;
# 本来の使い方はこちら
my $session = $mapper->begin_session;
my $user = $session->get(MyUser => 1);
print $user->name, "\n";
print map { $_->email, "\n" } @{ $user->emails };
# データの更新もセッションのなかで
$user->name('foo');
push @{ $user->emails }, MyEmail->new(email => 'bar@localhost');
$session->commit;
# あらためてセッションを作り直してデータを再取得
$session = $mapper->begin_session;
$user = $session->get(MyUser => 1);
print $user->name, "\n";
print map { $_->email, "\n" } @{ $user->emails };
ORLite
ここまで見てきたものはMySQLであろうとPostgreSQLやSQLiteであろうと基本的にはそれほど意識しなくても使えるようになっていましたが、
use strict;
use warnings;
use ORDB::CPANUploads;
use Time::Piece;
ORDB::CPANUploads::Uploads->iterate(
"where type = ? and author = ?",
"cpan", "ISHIGAKI",
sub {
printf "%s: %s\n",
$_->dist,
Time::Piece->new($_->released)->ymd,
}
);
ほかにもいろいろありますが
今回は比較的新しく、