[Perl]Data::ModelでつくったスキーマクラスをMouseでくるんでdriver食わせたりしてみた

明けましておめでとうございます。Hachioji.pm#1のLTで何か話したいけど、何を話すか決めきれていないytnobodyです。

かなり前に[Perl]Data::ModelをMouseでextendsしたけどあんまり意味なかった。というメモ。という記事を書いたのですが、2年の時を経てもう一度同じ事をしてみました。
今回もご多分に漏れず備忘録的な記事ですが、今回はちゃんと「意味あるんじゃね？」という風に思わせているはずです。。。

スキーマクラス

ユーザに関する情報(=userスキーマ)をtokyotyrantに食わせ、ユーザーIDと登録タイムスタンプをSQLiteに食わせる、というデータ構造になってます。

package MySchema;

use Mouse;
use MouseX::Foreign qw/ Data::Model /;
use Data::Model::Schema;

has dbi => ( is => 'rw' );
has tyrant => ( is => 'rw' );

sub BUILD {
    my $self = shift;

    install_model user => schema {
        schema_options model_name_realname => 'u';
        key 'id';
        columns qw/ id name sex place favorite /;
        schema_options column_name_rename => {
               id => 1,
               name => 2,
               sex => 3,
               place => 4,
               favorite => 5,
        };
    };

    install_model user_list => schema {
        key 'user';
        driver $self->dbi;
        column user => varchar => {
            required => 1,
        };
        column datein => integer => {
            default => sub { time() },
        };
    };

}

no Mouse;
1;

Data::Modelを継承するために、MouseX::Foreignを使っています。これは、Mouse-0.71から非MouseなクラスをMouseで継承する上で、MouseX::Foreignというモジュールを使う必要があるためです。Mouse作者のブログでも明記されてますので、ぜひご一読を。
hasで宣言されているアクセサはそれぞれ、Data::Model::Driver::MemcachedとData::Model::Driver::DBIのオブジェクトを受け取る為の窓口となります。
本来のスキーマ定義はBUILDメソッド内に納めることになりますが、当然アクセサをそのまま使えますので、$self->dbi の様な記述もまかり通ります。

モデルクラス

スキーマクラスとアプリケーションの間を取り持つクラス。
このクラスを通して、スキーマオブジェクトを生成させるのですが、その時にD::M::D::MemcachedやD::M::D::DBIの設定をある程度やってくれるようにしてみました。

package MyModel;

use warnings;
use strict;

use Mouse;
use MySchema;
use Cache::Memcached::Fast;
use Data::Model::Driver::Memcached;
use Data::Model::Driver::DBI;

has dbi_options => ( is => 'ro', isa => 'HashRef' );
has memcached_options => ( is => 'ro', isa => 'HashRef' );
has schema => ( is => 'rw' );

sub BUILD {
    my $self = shift;
    my $tyrant = Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new( $self->memcached_options ),
        namespace => 'hoge',
        serializer => 'Default',
        strip_keys => 1,
    );
    my $dbi = Data::Model::Driver::DBI->new( %{ $self->dbi_options } );
    my $schema = MySchema->new( tyrant => $tyrant, dbi => $dbi );
    $schema->set_base_driver( $schema->tyrant );
    $self->schema( $schema );
}

around new => sub {
    my $super = shift;
    my $class = shift;
    my $self = $class->$super( @_ );
    return $self->schema;
};

no Mouse;
1;

アプリケーション

ただレコードをsetしてData::Dumperで吐かせるだけの簡単なお仕事です。

use warnings;
use strict;

use MyModel;
use Data::Dumper;

my $model = MyModel->new(
    memcached_options => {
        servers => [qw[ 127.0.0.1:11211 ]],
        namespace => 'hoge',
    },
    dbi_options => {
        dsn => 'dbi:SQLite:dbname=mymodel.db'
    },
);

$model->set(
    user => 'user001' => {
        name => 'ytnobody',
        place => 'sagamihara',
        sex => 'male',
        favorite => 'soba',
    }
);

$model->set(
    user_list => 'user001'
);

print Dumper( $model->lookup( user => 'user001' )->get_columns );
print Dumper( $model->lookup( user_list => 'user001' )->get_columns );

実行結果は以下の様になり、レコードのsetおよびlookupが出来ていることがわかります。
(2回目以降の実行では、レコードのsetで失敗しますので、エラーとなります。)

$VAR1 = {
          'favorite' => 'soba',
          'place' => 'sagamihara',
          'name' => 'ytnobody',
          'id' => 'user001',
          'sex' => 'male'
        };
$VAR1 = {
          'user' => 'user001',
          'datein' => '1294213651'
        };

モデルクラスの記述次第では、D::M::D::Memcachedのようなインスタンスをパラメータに求めるタイプのドライバすらも、インスタンスではなく接続先アドレスの指定のみで動作します。当然、モデルクラスとスキーマクラスを1つにまとめることも可能です。yamlなどの設定ファイルにモデルクラスの設定項目を書き出しておくことが容易になり、他のサーバへのアプリケーション移行時にも役に立ちそうです。