今後の Data::Model

今後の予定ですが、夏に sfujiwara さんからいただいた Pg 対応の取り込みやら、 リレーショナルスキーマのサポートやら細かい fix 項目など TODO はまだまだあります。

Data::Model はリレーショナルしないっていってたじゃん！ってツッコミもありますが、いい実装方法を思いついたのでやってみようと思います。

もし今回の企画で Data::Model に興味をもって使ってみようと思っていただけたら嬉しいです。

不明点やらなんやらがあれば #perl-casual@freenode やら #data-model@irc.perl.org やら #dbix-skinny@irc.perl.org やら適当なところで捕まえてくれればとおもいます。

ではでは、本当に僕の advent calendar 2009 はこれにておわりです。

水着もってバカンスいってきます。

Driver を作るために必要な知識

Driver を作るためにはある程度規則に従う必要があります。

ゼロから独自の Driver を作るには Data::Model::Driver の中で空定義してあるメソッドを上書きする必要があります。

そして Data::Model::Driver の各メソッドは Data::Model より delegation されているので、 Data::Model のコードも読んでおく必要があります。

このあたりはドキュメントされていません。

また、内部 API が変わってしまうと互換性が無くなる可能性もあり厄介です。

ということで本日は、需要がありそうで簡単そうな Driver を作る方法を軽く紹介します。

Driver::DBI を拡張する

主に一昨日紹介した Driver::DBI::MasterSlave の挙動が気にくわないと言った事で作りたい欲求が出るでしょう。

Driver::DBI::MasterSlave は Driver::DBI の dbh のやりくりを制御する部分を独自にハンドリングして master, slave の dbh を切り替えるという要求にしたがって作られています。

rw_handle, r_handle が返す値をうまい具合にやりくりすれば、独自のレプリケーション対応の Driver がかけます。

Driver::DBI::MasterSlave のコードを元にして、どのあたりをいじれば良いのかを紹介しましょう。

継承するクラス

なので、しちめんどい set,get,update,delte,lookup などの処理は再実装しないで Driver::DBI にやってもらえばいいので、これを継承します。

package Data::Model::Driver::DBI::MasterSlave;
use strict;
use warnings;
use base 'Data::Model::Driver::DBI';

クラス初期化

Data::Model::Driver の初期化は new メソッドの引数を全て bless { %args }, $class のようにして保存してから、 init メソッドを単純に呼び出しています。

なので、独自 Driver の初期化処理は init メソッドの中で行います。

sub init {
    my $self = shift;
    my $master = $self->{master}
        or Carp::croak "'master' configuration is required";
    my $slave  = $self->{slave} || $master;

    if (my($type) = $master->{dsn} =~ /^dbi:(\w*)/i) {
        $self->{dbd} = Data::Model::Driver::DBI::DBD->new($type);
    }
    $self->{dbi_config} = +{
        master => +{ %{ $master } },
        slave  => +{ %{ $slave } },
    };
}

今回は rw_handle, r_handle を自由に差し替えたいという要求を設定しました。

Driver::DBI のでは、このあたりも自由に差し替えするコードを書きやすくしてあります。

状況に応じた DBI のインスタンスを複数作れる用になっており、複数のインスタンスを作るためには DBI の設定を複数設定しておく準備が必要です。

具体的には $self->{dbi_config} に config_name => $config という形で HASH リファレンスを指定します。

Driver::DBI::MasterSlave では master と slave という設定名を使って、二つの設定を保存しています。

$self->{dbd} に Data::Model::Driver::DBI::DBD のインスタンスを入れているところは Driver::DBI で各種 DBD に対応した SQL を吐くために必須ですので注意してください。

dbh を使い分ける

さぁ DBI インスタンスの設定を複数作ったら、あとはそれぞれ使うだけです。

これはrw_handle と r_handle のメソッドをそれぞれ上書きします。

sub rw_handle { shift->_get_dbh('master', @_) };
# トランザクション中は master のみを返す
sub r_handle  { my $self = shift;$self->_get_dbh( ($self->{active_transaction} ? 'master' : 'slave'), @_ ) };

見れば分かりますが $self->_get_dbh(config_name) といった形で _get_dbh のプライベートメソッドを読んでいます。

通常は、このように $self->{dbi_config} に格納した設定名を引数にして呼び出せば、その設定を引数にして自動的に DBI インスタンスを作ってくれるので、それを戻すだけでやりたい事が出来ます。

r_handle では $self->{active_transaction} が真だったら master を見るようにしていますが、これは txn_scope 下では常に master を見るべきという設計によるものです。

今の Data::Model の Driver::DBI では、このあたりもハンドリングしてあげる必要があります。

応用

例えば複数台の slave の設定を設定してランダムにその slave を使いたい場合は下記の用な Driver を書きます。

package Data::Model::Driver::DBI::ManySlave;
use strict;
use warnings;
use base 'Data::Model::Driver::DBI::MasterSlave';

sub init {
    my $self = shift;
    my $master = $self->{master}
        or Carp::croak "'master' configuration is required";
    my $slave  = $self->{slave} ? ref($self->{slave}) eq 'ARRAY'
        ? $self->{slave} : [ $self->{slave} ] : [ $master ];
    $self->SUPER::init(
        master => $master,
        slave  => $slave,
    );
}

slave のオプションを ARRAY ref にする感じです。

殆ど Driver::DBI::MasterSlave の実装を使いまわすので、ここは Data::Model::Driver::DBI::MasterSlave をそのまま継承します。

次は rw_handle と r_handle かと思いますが、 Driver::DBI::MasterSlave の物をそのまま使います。

では、 slave の r_handle を複数から選択するのは選択するの?という疑問ですが、新しく紹介するメソッドを上書きして使います。

dbi_config というメソッドを上書きします。

$self->{dbi_config} に DBI への設定を入れていたと思いますが、この設定を取り出すためのメソッドとして定義されています。

sub dbi_config {
    my($self, $name) = @_;
    return $self->{dbi_config}->{master} if $name eq 'master';
    my $slave = $self->{dbi_config}->{slave};
    return $slave->[rand(@{ $slave })];
}

このようにして master の時は $self->{dbi_config}->{master} を返して、 slave の時は slave の設定をどれかランダムで返すのです。

DBI のインスタンスを作る為のメソッドの中では dbi_config を使って DBI の設定を取得しているので、ここだけを変更すればうまく行きます。

使ってみる

さて、この作った Driver::DBI::ManySlave を使ってみますか。

my $many = Data::Model::Driver::DBI::ManySlave->new(
    master => {
        dsn => 'dbi:mysql:host=master.server:database=test',
    },
    slave => [
        { dsn => 'dbi:mysql:host=slave1.server:database=test' },
        { dsn => 'dbi:mysql:host=slave2.server:database=test' },
        { dsn => 'dbi:mysql:host=slave3.server:database=test' },
        { dsn => 'dbi:mysql:host=slave4.server:database=test' },
    ],
);

これだけです。

とりとめのない話

これだけの為にわざわざコード書くのはちょっと面倒なので Driver::DBI の設定だけでうまく行くようにしようと思います。

現状でも微妙に出来そうなコード片が入ってるのですが、完璧じゃないのでもすこし書き直してから公開しようとおもいます。

Driver::Cache を拡張する

さて、次は透過的なキャッシュをする Driver を独自の物に書いてみましょう。

標準では Perl 固有の HASH の中にキャッシュするか、 Memcached なオブジェクトへのキャッシュしか選択出来ません。

しかし Driver::DBI と比べてもさらにシンプルなんです。

基本的な Driver としての実装は Data::Model::Driver::Cache の中で実装されており、これを継承して Driver::Cache 用のインターフェイスを満たせば OK なんです。

これも既存の Driver::Cache::HASH のコードを元に説明しましょう。

データ追加

データの追加するメソッドを定義します。

sub add_to_cache {
    my($self, $key, $data) = @_;

    my $ret = $CACHE{$key} = $data;
    return if !defined $ret;
    return $ret;
}

add_to_cache の第一引数に key を、第二引数に value が渡されます。

成功したら value をそのまま返してください。

失敗時は undef を返します。

データ取得

データを取得する処理で使われます

sub get_from_cache {
    my($self, $key) = @_;

    my $ret = $CACHE{$key};
    return if !defined $ret;
    return $ret;
}

get_to_cache の第一引数に key が渡されます。

成功したら key に対応する value をそのまま返してください。

失敗時は undef を返します。

データ削除

データを削除する処理で使われます

sub remove_from_cache {
    my($self, $key) = @_;
    
    my $ret = delete $CACHE{$key};
    return if !defined $ret;
    return $ret;
}

remove_from_cache の第一引数に key が渡されます。

失敗したら undef を返してください。

成功したら undef 以外を返してください。

今現在 0 や '' などを返しても失敗したと誤認識するバグが発見されました。

その他

update 処理は、該当する key の削除のみを行うという挙動になっています。

トランザクションとの組み合わせは、現在完全な透過処理が行われません。

lookup_multi 系のクエリは get_multi_from_cache を上書きします。

以下に Memcached で利用してるコードを張り付けます。

sub get_multi_from_cache {
    my($self, $keys) = @_;

    my $ret = $self->{memcached}->get_multi($keys);
    return if !defined $ret;
    return $ret;
}

まったく新規に Driver を作る

もうちょっと詳細に書く予定でしたが、基本的に本日紹介した方法を見れば大体の Driver 作成の要求を満たせるかなと思ったので今回は省略させてください。

もし、そのような需要がある場合は Yappo を捕まえて相談してみてください。

他の DBD 対応

Driver とは直接関係ないですが mysql や SQLite 以外の DBD 対応へのポインタを示します。

Data::Model::Driver::DBI::DBD 以下の名前空間の実装を見てください。

基本的に SQL generator からの delegation されるコードですので delegation 元の Data::Model::Schema::SQL などを読んでみてください。

DBD::Pg に関しては sfujiwara さんが実装してくださったので僕の merge まちです＞＜

まとめ

本日は Driver hack についてあれこれ書きました。

さぁ、明日はいよいよ最終回です。

レプリケーションを使う

MySQL にはレプリケーション機能があるのはとても知られている事です。

レプリケーションの無い MySQL は、ブラウン管の無いブラウン管テレビくらいの物でしょう。

そして ORM でも切っても切れない物では無いでしょうか。

Data::ObjectDriver でも livedoor のどっかのサービスで自作 Driver 書いて使ってるとか

DBIC の世界でも DBIx::Class::Storage::DBI::Replicated なんて物があるようです。

もちろん Data::Model でも対応しています。

Driver::DBI::MasterSlave です。 Driver::DBI を使った事がある人ならとても簡単な物となっています。

  use Data::Model::Driver::DBI::MasterSlave;
  
  my $dbi_connect_options = {};
  my $driver = Data::Model::Driver::DBI::MasterSlave->new(
      # master の接続設定
      master => {
          dsn => 'dbi:mysql:host=master.server:database=test',
          username => 'master',
          password => 'master',
          connect_options => $dbi_connect_options,
      },
      # slave の接続設定
      slave  => {
          dsn => 'dbi:mysql:host=slave.server:database=test',
          username => 'slave',
          password => 'slave',
          connect_options => $dbi_connect_options,
      },
  );

  # base driver の設定をする
  base_driver $driver;

上記の用に master => $conf, slave => $conf という形で設定するだけです。 $conf の中身は先日紹介した Driver::DBI の設定と全く同じ物がつかえます。

仕組み

Driver::DBI も 内部的には DBI のインスタンスを使って DBI 接続を行っていて DBI::MasterSlave では DBI のインスタンスを2個作って、それぞれ master, slave 用として使います。

Driver::DBI は SELECT クエリでは r_handle を使い それ以外のクエリでは rw_handle を使っており、それぞれの handle にたいして master, slave の DBI のインスタンスを割り当てるので、うまい具合 master, slave でクエリを振り分ける事ができるのです。

注意

txn_scope を使ったトランザクション中は、全てのクエリが rw_master に向かいますので注意してください。

複数の slave を扱うにはどうするの?

DBIC の世界だと複数台の slave をうまいこと扱ってくれる仕組みがあるのですが Data::Model では、そのような仕組みはありません。

バグ?手抜き? いえいえ、元からこういう設計です。

そういった複数台の slave を持つ場合には lvs などを使って、より低いレイヤーにて分散環境を整えてください。

このような低いレベルでやるべき処理を Perl のレイヤでやるよりかは、それなりに実績がある低レイヤ処理するべきだと思っています。

しかも slave の分散クエリなんて lvs で十分事足りるし Perl のコード書くよりも高度な事ができるので良いです。

まぁ、インテグレーションというのは時と場合によって思うとおりの道具が使えないでしょうから、細かい要求などは Data::Model::Driver の自分向けに書いてくださいという事になります。この辺の詳しい話は後日書きます。

Q4M を使う

Data::Model の特色の一つとして Q4M 対応が行われているということです。

このあたりのエッセンスは3日目( http://perl-users.jp/articles/advent-calendar/2009/data-model/03.html )に紹介してますが、3日目は超応用編だったので今日は Driver::Queue::Q4M の使い方を紹介します。

Q4M とは

Q4M とは、サイボウズラボの奥一穂(以下略

スキーマ定義

スキーマ定義は、通常の定義と殆どおんなじ感じです。

    package TestQueue;
    use base 'Data::Model';
    use Data::Model::Schema;
    # Queue::Q4M の mixin が必須
    use Data::Model::Mixin modules => ['Queue::Q4M'];
    use Data::Model::Driver::Queue::Q4M;

    my $driver = Data::Model::Driver::Queue::Q4M->new(
        dsn => 'dbi:mysql:database=test'
    );
    base_driver $driver;

    install_model queue_test => schema {
        columns qw/ id job_name /;

        # as_sqls の為にも TYPE=Queue を入れとく
        schema_options create_sql_attributes => {
            mysql => 'TYPE=Queue',
        };
    };

Q4M 専用のメソッドを追加するために mixin を指定するのと CREATE TABLE 文の為に schema_options create_sql_attributes を指定します。

as_sqls で出来上がる SQL は下記のようになります。

CREATE TABLE queue_test (
    id              CHAR(255)      ,
    job_name        CHAR(255)      
) TYPE=Queue;

Q4M では index のサポートが行われていないので、 primary key などの事は忘れましょう。

もちろんユニーク制約なんてのも使えませんからね。

Queue を作る

Q4M の Queue を作るのはとても簡単です！

なんてったって普通の MySQL のテーブルの用に扱えるのが Q4M の良いところの一つなんで、普通に set メソッドして INSERT すれば良いんです.

    # queue を一つ作る
    $queue->set(
        queue_test => {
            id       => 1,
            job_name => 'get http://example.com/',
        },
    );

Queue を読む

Q4M を使う場合は queue_wait を使って dequeue してからデータを読むことが一般的ですが抜く、一応 Data::Model ごしでも Queue の内容を直接読むことが出来ます。

ただし primary key とかは無いので where とか使って見る必要があるでしょう。

index を使ってないですが、そもそも Q4M に Queue が大量に保存されてることはありえないので問題にならないでしょう。大量にあるんだったらお前のアプリの書き方がとち狂ってる。

    # queue を読む
    my($q) = $queue->get('queue_test');
    warn $q->job_name;

Queue の削除

普通は Q4M が勝手に削除するんですが、どうしても手動で消したい人の為に書いておきます。

基本的にはスキーマオブジェクトの delete メソッドを叩くだけです。

    # こういう delete はできない
    $q->delete;

    # 直接 query を吐いて delete する
    $queue->delete('queue_test', {
        where => [
            id => 1,
        ],
    });

    # DELETE FROM queue_test; はこれ
    $queue->delete('queue_test', {});

$q->delete のように Row オブジェクトの delete メソッドは primary key が無いテーブルには使えないため上記のコードのようなコメントになっています。

update

(略

dequeue する

Q4M では queue_wait を使って dequeue をします、細かいことはドキュメント読んでください。

まぁこんな SQL ですね。

mysql> SELECT queue_wait('high_priority_table', 'low_priority_table', 10);

これに相当する Data::Model の使い方としては queue_running メソッドを使います。

  my $queue = TestQueue->new;
  my $retval = $queue->queue_running(
      high_priority_table => sub {
          my $row = shift;
          # 何かの処理
      },
      low_priority_table  => sub {
          my $row = shift;
          # 何かの処理
      },
      timeout => 10,
  );

queue_running の引数に table_name => CODE リファレンス という構造の HASH を渡してあげます。

timeout だけは例外的に queue_wait に渡すタイムアウトを指定します。

table_name の queue table に enqueue されると、オーナーモードになった行の Row オブジェクトを引数としてコードを実行します。

簡単ですね。

queue_abort

Q4M では queue が何らかの処理で以上になった時に queue の先頭に enqueue してくれる queue_abort という物があります。

もちろん Data::Model でも使えます。

    my $ret = $queue->queue_running(
        queue_test => sub {
            my $row = shift;
            warn $row->id;
            warn $row->job_name;
            $queue->queue_abort;
        },
    );
    warn $ret;

このようにスキーマオブジェクトから生えている queue_abort メソッドを呼ぶだけです。

$ret の内容は、 queue_running が失敗してるだけ undef になります。

ちなみに CODE リファレンス中で die してしまった時も内部的には queue_abort されます。

    eval {
        my $ret = $queue->queue_running(
            queue_test => sub {
                die "abort"; # ここで queue_abort が呼ばれる
            },
        );
    };
    $@ and warn $@; # 'abort' と表示
    warn $ret;

ここの $ret も undef です。

queue_end

Q4M で queue の正常終了を表す queue_end という物が用意されています。

Data::Model では CODE リファレンスの中だけが Q4M のオーナーモードでいるという設計になっているので、 CODE リファレンスの中で queue_abort が呼ばれないまま return した時に自動的に queue_end が呼ばれます。

    my $ret = $queue->queue_running(
        queue_test => sub {
            return; # ここで queue_end が呼ばれる
        },
    );
    warn $ret; # 処理した queue テーブル名を表示

queue の処理が成功した場合に queue_running は queue_wait で処理した queue table 名を戻り値として返します。

queue_running と queue_abort はどこから来たの?

冒頭に Queue::Q4M mixin を使う設定をすると書いてありますが、この Mixin がスキーマオブジェクトに queue_running と queue_abort メソッドを生やしているんです。

単純に Driver に処理を delegation してるだけです。

まとめ

今日は、レプリケーションと Q4M を Data::Model で使う為にどうするかといった事を紹介しました。

サックリ紹介するつもりが長文になって DNBK です。

明日はキャッシュ戦略について紹介します。

Driver

Data::Model を ORM 的に使うには use base 'Data::Model' して use Data::Model:Schema して DSL を使ってスキーマ定義をすると説明してきました。

ただ、これだけではデータベースと接続する事ができません。なぜならスキーマ定義にはデータベースと接続する機能がないからです。

データベースなどのデータソースと接続するためにはドライバーを利用しなければなりません。

このあたりは Data::ObjectDriver と同じです。もしかしたら DBIx::MoCo も当てはまるかもしれません。

簡単な Driver の定義は下記のような形です。

    use Data::Model::Driver::DBI;
    my $driver = Data::Model::Driver::DBI->new(
        dsn => 'dbi:SQLite:dbname=mybookmark.db'
    );

new のオプションは Driver によって異なります。

DBI Driver の全オプションを含めると以下のようなコードになります。

  my $driver = Data::Model::Driver::DBI->new(
      dsn             => 'dbi:mysql:host=localhost:database=test',
      username        => 'user',
      password        => 'password',
      connect_options => $dbi_connect_options,
      reuse_dbh       => 1,
  );

dsn, username, password などは DBI のあれと同じですね。

connect_options は DBI->connect( $dsn, $user, $pass, $connect_options ) の $connect_options に渡されるものと同等です。

default で RaiseError => 1, PrintError => 0, AutoCommit => 1 がそれぞれ設定されます。

reuse_dbh は、同じ dsn の接続は1つの接続を使いまわすようにしてくれます。

例えば、 DB::User, DB::Bookmark, DB::Diary, DB::Fotolife と複数のスキーマ定義をしておいて、それぞれ別々の Data::Model::Driver::DBI インスタンスを使っているときに、 dsn は同じ物を利用していた場合に reuse_dbh を真にしておくと DB 接続は一つだけにしてくれるようになります。

様々な Driver

Data::Model では DBI 以外にも様々なデータソースが扱えます。代表的な物としては Driver::Memcached なのですが、これは17日に dann さんが素敵な紹介を寄稿していただいたのでそちらを参照ください。

http://perl-users.jp/articles/advent-calendar/2009/data-model/17.html

kumofs にデータを出し入れするために僕は使っています。

この Driver の圧縮オプションをつけまくる事で素の Cache::Memcached などのライブラリを使うよりは利点があると思っています。

Driver::Memory

依存ライブラリ無しでかつ on memory でデータの管理をしてくれるドライバです。

sort や where や index, unique を始めとした Driver::DBI とほぼ同等のクエリが利用出来ます。

一応 Driver::DBI と同じテストコードを通しているので品質もそこそこです。

Driver::Logic

モデルロジック処理をデータソースとして扱うためのラッパーを書くたに作りましたがちょっと不評ちゃんです。

もうちょっと作戦立ててから作り替えて使いやすくしようと思ってますが、あまり使って欲しくないので undocumented なのです。

Driver::HASH

スキーマレスになデータモデルに好きなときに好きなだけ index はれたりするような物を作ろうとしてますが現在コードがありません。

Driver::DBI::MasterSlave

Driver::Queue::Q4M

Driver::Cache

上記3種類はそれぞれ個別で紹介しようと思います。

スキーマ定義の設定

最初の方でスキーマ定義を下だけではデータソースを使うことができませんとありました。

実際にスキーマ定義と Driver を紐づける必要がありますので以下で紹介します。

ちなみにここでのサンプルは全て Data::Model::Driver::Memory を使ってます余計なコードないので。

スキーマ定義の中で全テーブルに設定する

基本的に DB サーバの database の単位や、役割ごとにスキーマ定義ファイルを書くと思いますが、そういった場合はもちろんスキーマクラスの中で定義されている DSN やら DB サーバは同一になるはずなので一括で Driver の設定を行います。

package MyDatabase;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::Memory;
my $driver = Data::Model::Driver::Memory->new;

# MyBookmark の中で定義したテーブル全てで $driver を使う
base_driver $driver;

base_driver 関数でスキーマ定義全体で使う Driver を設定します。

テーブル毎に Driver を変える

基本的にはありえないのですが、テーブル毎に driver を変える事が出来ます。

package MyDatabase;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::Memory;
my $driver1 = Data::Model::Driver::Memory->new;

# MyBookmark の中で定義したテーブル全てで $driver1 を使う
base_driver $driver1;
install_model yappo => schema {
};

my $driver2 = Data::Model::Driver::Memory->new;
install_model nekokak => schema {
    # このテーブルだけ $driver2 をつかう
    driver $driver2;
};

# kan さんは $driver1
install_model kan => schema {
};

driver は install_model の定義の中だけで使えます。

base_driver で設定した driver を部分的に上書きするので、 yappo, kan は $driver1 を使って nekokak は $driver2 を使います。

使うときに設定する

スキーマ定義の中だけではなくて、そのスキーマ定義を実際に利用する時に定義することが出来ます。

これは　Web フレームワークの中に Data::Model を組み込んだ際に実行環境によって Driver の設定を変えたい時に利用すると便利になります。

    my $model = MyDatabase->new;

    # MyDatabase の base_driver として $driver1 を設定する
    my $driver1 = Data::Model::Driver::Memory->new;
    $model->set_base_driver( $driver1 );

    # MyDatabase の nekokak テーブルの driver として $driver2 を設定する
    my $driver2 = Data::Model::Driver::Memory->new;
    $model->set_driver( nekokak => $driver2 );

スキーマ定義の時に使った driver と base_driver に set_ の接頭辞をつけたメソッドをスキーマオブジェクトにはやして使います。

その他関連メソッド

今これを書いてる時に気がついたのですがスキーマクラスに生えている set_driver や set_base_driver が undocument でした。

ついでに関連する未文書なメソッドを紹介します。

driver 定義を取得する

set_driver や set_base_driver のついとなる get_driver などのメソッドがあります。

    my $model = MyDatabase->new;

    # MyDatabase の base_driver を取り出す
    $model->get_base_driver;

    # MyDatabase の nekokak テーブルの driver をとりだす
    $model->get_driver( 'nekokak' );

定義されたテーブルの一覧を取り出す

スキーマ定義にて定義した install_model もテーブルの一覧を返すメソッドがあります。

    my $model = MyDatabase->new;
    # 定義されたテーブルのリストを返す
    # yappo, nekokak, kan が返る
    say join ',', $model->schema_names;

普通の人はあまり使わないかもしれませんが Data::Model->as_sqls にて以下のように使っています。

sub as_sqls {
    my $self   = shift;
    my $target = shift;
    my @sql = ();
    for my $model ($self->schema_names) {
        next if $target && $model ne $target;
        push @sql, $self->get_schema($model)->sql->as_sql;
    }
    @sql;
}

まとめ

本日は Data::Model の重要な要素の Driver に関して紹介しました。

どのようにしてデータソースとつなげるかが理解できたかと思います。

これからラストまで Driver 関連の解説を行う予定です。

    install_model txn_test => schema {
        key 'id';
        columns qw( id name );
        schema_options create_sql_attributes => {
            mysql => 'TYPE=InnoDB',
        };
    };

CREATE TABLE txn_test (
    id              CHAR(255)      ,
    name            CHAR(255)      ,
    PRIMARY KEY (id)
) TYPE=InnoDB;

使ってみる

# トランザクションの開始
my $txn = $db->txn_scope;

# INSERT
$txn->set(
    txn_test => 1 => { name => 'Yappo' }
);

# トランザクションを終了してデータを commit する！
$txn->commit;

このように書くと、 txn_scope メソッドを呼び出したときに帰ってくるオブジェクトを保持しているあいだ

トランザクションが有効となります。

なので

# トランザクションの開始
my $txn = $db->txn_scope;

# LOOKUP
my $row = $txn->lookup( txn_test => 1 );

# data の update
$txn->update($row);

die 'oooops';

# トランザクションを終了してデータを commit する！
$txn->commit;

set/update/delete メソッドの後の処理が die などで異常終了した場合、

set/update/delete メソッドでの更新が rollback されます。

もっと詳しくいうと、 $txn のスコープが外れた時に $txn->commit されていなければ強制的に rollback されます。

これは DBIx::Class::Storage::TxnScopeGuard とほとんど同じ挙動です。

通常との違い

上記の例では、 $db->set を使わずに $txn->set などを使って INSERT していました。

これは、トランザクションスコープ内では直接レコードの更新を許さないという設計によるものです。

START TRANSACTION してる間に他のメソッドを呼びだして、そのメソッドの中で意図しない更新クエリが走った時に抑制してくれたりします。

実際にトランザクションスコープ中に通常の方法で更新系を呼び出すと、下記のようにエラーになります。

my $txn = $db->txn_scope;
eval {
    $db->set(
        txn_test => 1 => { name => 'Yappo' }
    );
};
warn $@ if $@;# say "The 'set' method can not be performed during a transaction."

eval {
    $row->delete;
};
warn $@ if $@;# say "The 'delete' method can not be performed during a transaction."

これは、 lookup などして取得した Row オブジェクトなどに生えている update, delete メソッドに対しても有効となっています。

なので、更新系は txn_scope が返すインスタンス経由で実行する必要があります。

Row オブジェクトの update, delete メソッドは $txn->update($row) などとして txn_scope が返すインスタンスのメソッド経由で更新します。

# INSERT
$txn->set(
    txn_test => 1 => { name => 'Yappo' }
);

# LOOKUP
my $row = $txn->lookup( txn_test => 1 );
warn $row->name;

# UPDATE
$row->name('nekokak');
$txn->update($row);

# GET
my $itr = $txn->get('txn_test');
while (<$itr>) {
    warn $_->name;
}

# delete
$txn->delete($row);

$txn->commit;

まとめ

トランザクションをうまく使うとデータの一貫性を保証した処理を書くことができますので

びしばしつかってみてください。

have a nice data-model days!:)

install_model bookmark => schema {
# 略
    column 'global.epoch' => 'create_at' => {
        default => sub { time() },
    };
    alias_column create_at => create_dt => {
        inflate => 'DateTime',
    };

install_model create => schema {
# 略
    column 'global.epoch' => 'create_at' => {
        default => sub { time() },
    };
    alias_column create_at => create_dt => {
        inflate => 'DateTime',
    };

定義する

まずは Column Sugar の定義を変更します。

前回までは以下の形だったのを

column_sugar 'global.epoch'
    => int => {
        required => 1,
        unsigned => 1,
    };

次のように変更します。

column_sugar 'global.epoch'
    => int => {
        required => 1,
        unsigned => 1,
        alias => {
            epoch_dt => {
                inflate => 'DateTime',
            },
            epoch_dt_utc => {
                inflate => 'DateTimeUTC',
            },
            epoch_dt_jst => {
                inflate => 'DateTimeJST',
            },
        },

    };

alias という値を追加します。ここで与える HASH リファレンスは aliased_name => \%append_params という形式になっています。

新しいエイリアスカラム名を key にして、それに対する追加カラム定義を value とした HASH リファレンスです。

HASH リファレンスなので、複数の定義も同時に行えるので epoch_dt, epoch_dt_jst, epoch_dt_utc と作ってみました。

DateTimeUTC, DateTimeJST それぞれの Inflate 定義の中身は割愛します。

定義を利用する

こうして作ったエイリアス定義済みの Column Sugar を使ってみましょう。

もちろん

    column 'global.epoch' => 'create_at' => {
        default => sub { time() },
    };

すれば, table.create_at という形で使えます。使えますが、 alias されたカラムを使う時は $table->create_dt とかなって欲しいのに $table->epoch_dt とかになってしまいます。

これはちょっと混乱して大変ですよね。

なので、この Column Sugar で定義されたエイリアスカラムのカラム名を変更する仕組みも用意されています。

下記のようにして column 定義することによりリネームできます。

    column 'global.epoch' => 'create_at' => {
        default      => sub { time() },
        alias_rename => {
            epoch_dt     => 'create_dt',
            epoch_dt_utc => 'create_dt_utc',
            epoch_dt_jst => 'create_dt_jst',
        },
    };

column 定義の追加定義欄に alias_rename という key で HASH リファレンスを渡します。

HASH リファレンスの内容は、元のエイリアス名 => リネーム後のエイリアス名 という形です。これも複数個指定可能です。

使ってみる

ここまで準備できれば、あとは何も考える必要がありません。

alias されたカラムメソッドを使うだけです。

複数にエイリアスを張っていた時に、どれかのエイリアスの値を変更してもきちんとすべてのエイリアスの値は変更されています。

試しに以下のように使ってみますか。

    my $yappo = $bookmark->set( user => { nickname => 'Yappo' } );
    my $diary = $diary->set(
        diary => {
            user_id => $yappo->id,
        }
    );

    printf "create_at    : %s\n", $diary->create_at;
    printf "create_dt    : %s\n", $diary->create_dt;
    printf "create_dt_utc: %s\n", $diary->create_dt_utc;
    printf "create_dt_jst: %s\n", $diary->create_dt_jst;

    # create_dt_jst から生えてるメソッドを変えても Data::Model は検知できないので
    # 他のエイリアスに値が反映されないので、意図的に set しなおしてます
    $diary->create_dt_jst(
        $diary->create_dt_jst->
            set_year(2012)->set_month(12)->set_day(21)->
                set_hour(12)->set_minute(0)->set_second(0)
    );
    print "\nchange ddate\n";

    printf "create_at    : %s\n", $diary->create_at;
    printf "create_dt    : %s\n", $diary->create_dt;
    printf "create_dt_utc: %s\n", $diary->create_dt_utc;
    printf "create_dt_jst: %s\n", $diary->create_dt_jst;

実行した結果は下記のようになります。

create_at    : 1261383942
create_dt    : 2009-12-21T08:25:42
create_dt_utc: 2009-12-21T08:25:42
create_dt_jst: 2009-12-21T17:25:42

change ddate
create_at    : 1356058800
create_dt    : 2012-12-21T03:00:00
create_dt_utc: 2012-12-21T03:00:00
create_dt_jst: 2012-12-21T12:00:00

create_dt_jst を変えただけなのに、 create_at, create_dt, create_dt_utc と全てが変更されてる事がわかりますね。

まとめ

本日までで Data::Model のユニークな Column Sugar 並びに Alias Column についての紹介をしました。

他の ORM よりも柔軟にかつ簡単に役割を追加できる事がわかったとおもいます。

このあたりの機能はきちんとテストケースが書かれているので安心して利用できます。

という事で次回からはまた別の方面の紹介をします。

カラム定義を再利用可能に

前回のカラム定義では、特定のスキーマ定義クラスの中で定義されてしまうので、他のクラスから使いたい時には使えません。

例えば MyDiary.pm の中に以下のような定義を行うと

column_sugar 'diary.id'
    => int => {
        required => 1,
        unsigned => 1,
    };

install_model diary => schema {
    key 'id';
    index user => [qw/ user_id id /];

    column 'diary.id';
    column 'user.id';
};

下記のようなエラーが発生して実行が停止しています。

$ perl -MMyDiary
Undefined column of 'user.id' at example/MyDiary.pm line 27

これは use MyBookmark してしまえば、 MyBookmark.pm の中で定義されている user.id が利用出来るのですが、もし MyBookmark で定義したテーブルを使わない時は無駄になってしまいます。

そういう時はカラム定義を外出ししてあげて、他のクラスからも再利用可能にしてあげる事ができます。

例えば Columns.pm といった形で以下のようにコードを書きます。

package Columns;
use strict;
use warnings;
use Data::Model::Schema sugar => 'mycolumns';

column_sugar 'user.id'
    => int => {
        required => 1,
        unsigned => 1,
    };

column_sugar 'diary.id'
    => int => {
        required => 1,
        unsigned => 1,
    };

column_sugar 'global.epoch'
    => int => {
        required => 1,
        unsigned => 1,
    };

1;

MyBookmark.pm と MyDiary.pm で定義したものを全部こっちに移動しました。

use Data::Model::Schema する時に sugar => sugar_name というオプションを与えてるのがポイントです。

このオプションを与える事で、複数の column_sygar 定義での定義名の衝突が防げるようになります。

デフォルトの sugar name としては default がしようされています。

sugar name をデフォルトから変更したので MyBookmark.pm と MyDiary.pm の use Data::Model::Schema に対してもオプションを変えてあげる必要があります。

package MyBookmark;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema sugar => 'mycolumns';
use Data::Model::Mixin modules => ['+MyBookmark::Mixin::Count', 'FindOrCreate'];
use Columns;

package MyDiary;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema sugar => 'mycolumns';
use Columns;

column sugar 定義クラスで mycolumns として定義したので、これを使う側のスキーマ定義クラスでも mycolumns をしていします。

またちゃんと use Columns; として Columns.pm をロードしておく事も重要です。

まとめ

本日は、ある程度の規模の時に便利になってくる Column Sugar のライブラリ化についての紹介を行いました。

明日は Column Sugar の最後のトピックの Column Alias との連携について書きます。

Data::Model::Driver::Memcachedの空間効率を含めるための工夫

Data::Model::Driver:::Memcachedでは、以下のような流れでデータを保存します。

• データ全体のtable名をrenameし圧縮
• データのvalueからkeyを削除
• データのkey名をrenameし圧縮
• データをMessagePack(defaultでは）で圧縮
• 最後にMemcachedなどのKVSに保存

このように、データを圧縮することで空間効率を高めています。

valueからのkey名の削除

Data::Modelでは、テーブルに格納するデータをシリアライズして圧縮して、KVSに保存しますが、そのときにはvalueにはkey名は不要なのでkey名をvalueから削除しています。

strip_keysというオプションをdriverに設定することで利用できます。

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';

...

base_driver(
    Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new(
            { servers => [ { address => "localhost:11211" }, ], }
        ),  
        strip_keys => 1,
    )
);

...

テーブル名の圧縮による省スペース化

Data::Modelでは、キー名にテーブル名を含めるのですが、テーブル名をuという短い文字列に圧縮することができます。

schema_options model_name_realname => 'u'; で設定をしています。

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';

...

install_model user => schema {
    schema_options model_name_realname => 'u';
    key 'id';
    index 'name';
    columns qw/id name nickname/;
};

...

キー名の圧縮による省スペース化

テーブル名だけでなく、キー名も圧縮することができます。

以下のようにキー名を数値にマッピングしておくことで、実行時にキー名を数値にリネームしてキーのサイズも圧縮することが出来ます。

schema_options column_name_renameでその設定をしています。

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';
...

install_model user => schema {
    key 'id';
    index 'name';
    columns qw/id name nickname/;
    schema_options column_name_rename => {
        id       => 1,
        name     => 2,
        nickname => 3,
    };  
};
...

シリアライザにMessagePackを使うことによる省スペース化

シリアライザは選択できるようになっていて、DefaultはMessagePackという空間効率的なシリアライザを使われます。Data::Modelがこのようにシリアライズを切り替えられるようになっていることで、この効率化が実現できるところがポイントです。

base_driver(
    Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new(
            { servers => [ { address => "localhost:11211" }, ], }
        ),  
        serializer => 'Default',
    )   
);

どのように圧縮されるのかは、MessagePackの仕様に書かれているので、それをみるのがいいです。MessagePackがとても空間効率を意識して設計されていることがわかると思います。

http://msgpack.sourceforge.jp/spec

Data::Modelでは、テーブル名・キー名が短くなったデータに対して、さらにMessagePackで圧縮をしているため、かなり空間効率がいいと言えます。

アプリケーションのコードのシンプルさ

以下のようにモデルを定義しておけば、アプリケーションのコードは、どのように圧縮されるのかを意識することなく、効率的にキー名及びデータの格納が行えます。

上記で述べたモデルの設定を実際にまとめてみましょう。

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::Memcached;
use Cache::Memcached::Fast;

base_driver(
    Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new(
            { servers => [ { address => "localhost:11211" }, ], }
        ),
        serializer => 'Default',
        strip_keys => 1,
    )
);
install_model user => schema {
    schema_options model_name_realname => 'u';
    key 'id';
    index 'name';
    columns qw/id name nickname/;
    schema_options column_name_rename => {
        id       => 1,
        name     => 2,
        nickname => 3,
    };
};

1;

Memcachedなどに格納するときには、以下のようにすることで格納できます。

特に利用する際には、データの圧縮などについて意識することなく利用することが出来ます。

セットする場合

$model->set(
    user => '1',
    {   name     => 'Warai',
        nickname => 'Meshi',
    }   
);

getする場合

my ($get) = $model->get( user => '1' );

空間効率について

Data::Modelでのオプション設定による空間効率について、以下のような簡単なテストコードで確認してみます。

use strict;
use warnings;
use Test::More;
use MyApp::Schema;
use Data::Dumper;

my $model = MyApp::Schema->new;
$model->set(
    user => '1',
    {   name     => 'Warai',
        nickname => 'Meshi',
    }   
);

my ($get) = $model->get( user => '1' );
is( $get->id,       '1',     'id' );
is( $get->name,     'Warai', 'name' );
is( $get->nickname, 'Meshi', 'nickname' );

done_testing;

実行して、telnet localhost 11211でmemcachedに接続して確認してみましょう。

Data::Modelのデフォルト状態で圧縮した状態

デフォルトの設定

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::Memcached;
use Cache::Memcached::Fast;

base_driver(
    Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new(
            { servers => [ { address => "localhost:11211" }, ], }
        ),  
    )   
);
install_model user => schema {
    key 'id';
    index 'name';
    columns qw/id name nickname/;  
};

1;

telnetでmemcachedにつないでサイズの確認をしてみましょう。

STAT bytes 106

defaultでは、106バイトになりました。

Data::Modelのオプションで圧縮した場合

モデルは、以下のものとします。

package MyApp::Schema;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
use Data::Model::Driver::Memcached;
use Cache::Memcached::Fast;

base_driver(
    Data::Model::Driver::Memcached->new(
        memcached => Cache::Memcached::Fast->new(
            { servers => [ { address => "localhost:11211" }, ], }
        ),
        serializer => 'Default',
        strip_keys => 1,
    )
);
install_model user => schema {
    schema_options model_name_realname => 'u';
    key 'id';
    index 'name';
    columns qw/id name nickname/;
    schema_options column_name_rename => {
        id       => 1,
        name     => 2,
        nickname => 3,
    };
};

1;

telnetでmemcachedにつないでサイズの確認をしてみましょう。

STAT bytes 69

圧縮した場合には69bytesになりました。

サイズの比較

Data::Modelのオプションを使って圧縮した場合には69bytes、デフォルト状態（Data::ObjectDriverのDriverなど）の場合では106bytesになりました。

したがって、今回のケースでは、圧縮した場合にデフォルト状態と比較して0.65倍となり、空間効率がかなりいいことが確認できました。

まとめ

Data::Model::Driver::Memcachedは、KVSをデータストアとして使うために、空間効率を意識した設計がなされています。

具体的には、キーの値からの削除、テーブル名及びキー名の短縮、MessagePackによる圧縮、により空間効率を高める工夫をしています。

Data::Modelユーザーだけではなく、他のMemcachedプロトコルに対応したNoSQLサーバーを使われる方も、Data::ModelのDriverの実装を参考にされるのがいいのではないかと思います。

それでは、次回は再びyappoさんです。お楽しみに！

What is Column Sugar?

これは何をするものかというと、カラム定義の雛形を登録しておいて複数のカラムから雛形を作るという事ができます。

たとえば、レコードの作成日付を保存する created_on なんていうのは複数のテーブルで同じ定義をつかいたいものですから、共通化できると便利です。

他にも user_id なんかのカラムは複数のテーブルへカラム定義するケースが多いでしょう。特に正規化などをちゃんとするほど。

定義化をすると何がいいのか

個人的な小さいアプリケーションや、開発のごく初期ではカラム定義の内容を細かく変えるケースがあるんじゃないかと思います。

そういう時は Schema Loader を使ったり ALTER TABLE しまくったり(もしくは DROP TABLE & CREATE TABLE)することでしょう。

まぁ、それでいいんですけど、開発の初期なんかは DROP TABLE & CREATE TABLE してた方が手っ取り早かったりすると思います。

で、この DROP TABLE & CREATE TABLE しまくりの時に SQL で CREATE TABLE 文を書く、そして前述のいろんなテーブルで使われるような user_id の定義を変える。

といったときに Column Sugar で設定したカラム定義を一箇所書き換えるだけで済むので定義の変更漏れとかがなくなるというマニアックのシチュエーションがあります。

その他には、前述の通りにたような役割のカラムを一回だけ定義しておけば、テーブルのカラム定義では定義名を指定するだけで使いまわせるので楽になります。

たとえば Inflate の設定やら Default 値を CODE リファレンスで作ってるようなカラム定義で楽ができますよ。

定義してみゆ

さて、さっそくここで Column Sugar の定義でもしてみようと思います。

主に user テーブルの id カラムを作る人向けの定義は以下のようになります。

  column_sugar 'user.id'
      => int => {
          required => 1,
          unsigned => 1,
      };

普通のカラム定義の column の使い方とほとんど同じです。

column の代わりに column_sugar を使います。また、 column は install_model $tablename => {}; の中でしか利用できませんが、 column_sugar はどこで書いても OK です。

第一引数が "テーブル名.カラム名" という感じで、テーブル名とカラム名を . でつなげた形で指定します。

第二引数はカラム型。

第三引数がカラムの詳細な定義となります。

二と三は column と同じです。

重要なのが第一引数で "user.id" と定義した Column Sugar は、 user テーブルのカラム定義の中で使うと id というカラム名になり、 bookmark テーブルの中のカラム定義で使うと user_id というカラム名になります。

実際先程の column_sugar の定義を使ってみましょう。

install_model user => schema {
    key 'id';
    unique 'nickname';
    column 'user.id';
    columns qw/ nickname /;
};
install_model bookmark => schema {
    key [qw/ url_id user_id /];
    index 'user_id';
    column url_id => int => {};
    column 'user.id';
};

このような定義をすると以下のような CREATE TABLE 文に対応します。

CREATE TABLE user (
    id              INT             UNSIGNED NOT NULL,
    nickname        CHAR(255)      ,
    PRIMARY KEY (id),
    UNIQUE (nickname)
);
CREATE TABLE bookmark (
    url_id          INT            ,
    user_id         INT             UNSIGNED NOT NULL,
    create_at       INT             UNSIGNED NOT NULL,
    PRIMARY KEY (url_id, user_id)
);
CREATE INDEX user_id ON bookmark (user_id);

user.id は user テーブルの中だと user の部分を省略して id というカラム名になって、 user テーブル以外だと user_ の prefix がついて user_id というカラム名になってることがわかると思います。

定義を上書きする

さて、カラム定義の使い回しがし易いという column_sugar なんですが、定義を流用したいけども部分的に定義を変更したいケースがあると思います。例えば auto_increment をつけるとか。

そういった差分で上書きしたいときもちゃんと上書きして設定する事ができます。

例えば以下のようにcolumn_sugar の定義つけた unsigned => 1 を無効化したいときに以下のようかけます。

install_model user => schema {
    key 'id';
    unique 'nickname';
    column 'user.id' => {
        unsigned => 0
    };
    columns qw/ nickname /;
};

これは下記の SQL になります。

CREATE TABLE user (
    id              INT             NOT NULL,
    nickname        CHAR(255)      ,
    PRIMARY KEY (id),
    UNIQUE (nickname)
);

先程あった、 UNSIGNED の属性が消えてるのがわかると思います。

今度は、属性を追加したいときは単純に追加するだけです。

install_model user => schema {
    key 'id';
    unique 'nickname';
    column 'user.id' => {
        auto_increment => 1,
    };
    columns qw/ nickname /;
};

このように auto_increment 属性を追加した場合は

CREATE TABLE user (
    id              INTEGER         NOT NULL PRIMARY KEY,
    nickname        CHAR(255)      ,
    UNIQUE (nickname)
);

以上のように PRIMARY KEY 属性が追加されました。

カラム名を変更する

さて、今度はカラム名だけを変えたいという時もあるでしょう。

そういう時は、以下のように定義すると名前だけかえられます。

# global.epoch という定義
column_sugar 'global.epoch'
    => int => {
        required => 1,
        unsigned => 1,
    };


install_model bookmark => schema {
    key [qw/ url_id user_id /];
    index 'user_id';
    column url_id => int => {};
    column 'user.id';

    # create_at を生の値でも使いたい
    column 'global.epoch' => 'create_at';
};

単純に、 column の第二引数に書き換えたいカラム名を指定するだけですみます。

上記の定義は下記の　 CREATE TABLE になります。

CREATE TABLE bookmark (
    url_id          INT            ,
    user_id         INT             UNSIGNED NOT NULL,
    create_at       INT             UNSIGNED NOT NULL,
    PRIMARY KEY (url_id, user_id)
);

じゃぁ名前変更と属性変更を同時にしたい場合はどうするか！？という時は、単純に書き換えたカラム名の次の引数に差し替えたい属性の HASH リファレンスを書けばいいだけです。

install_model bookmark => schema {
    key [qw/ url_id user_id /];
    index 'user_id';
    column url_id => int => {};
    column 'user.id';

    # create_at を生の値でも使いたい
    column 'global.epoch' => 'create_at';
        default => sub { time() },
    };
};

まとめ

今日は Data::Model らしい Column Sugar に関して紹介しました。変に長文になってしまってあれですけど、明日は今日の続きを書きたいなとおもいます。

utf8 対応

DBIC やら良くある最近の ORM では、カラムの値を flagged utf8 に inflate してくれるような仕組みがついてる事でしょう。

Yes, もちろん Data::Model にも仕組みがあります。

utf8_column と utf8_columns です。

    utf8_column 'column_name';
    utf8_columns qw/ column_name1 column_name2 column_name3 column_name4 /;

先日紹介した column と columns に utf8 flagged してくれる inflate を wrap したカラム定義をしてくれます。

例えば以下のような定義をすると

{
    package TestTable;
    use base 'Data::Model';
    use Data::Model::Schema;
    use Data::Model::Driver::DBI;

    my $driver = Data::Model::Driver::DBI->new(
        dsn => 'dbi:mysql:database=test'
    );
    base_driver $driver;

    install_model utf8_test => schema {
        key 'id';
        column 'id';
        utf8_column name
            => char => {
                required => 1,
                size     => 32,
            };
    };
}

次のように使えます。

use utf8;
use Encode;
my $db = TestTable->new;

$db->set( utf8_test => 1 => { name => '大沢和宏' } );
my $row = $db->lookup( utf8_test => 1 );
if (Encode::is_utf8($row->name)) {
    print $row->name . "\n";
}

$row->name には普通に　utf8 flag が立つのできちんと名前が表示されます。

utf8 column に inflate をかける

utf8_column したカラムに inflate 処理を追加したい事もあるでしょう。

それも、もちろんできます。

    utf8_column foo
        => char => {
            inflate => sub {
                my $val = shift; # utf8 flag 付きで値が入る
            },
            deflate => sub {
                return $utf_flagged_val; # utf8 flag 付きの値を返す

            },
        };

のような感じで、 inflate する CODE リファレンスには utf8 flag を立てた状態の値が渡されます。

deflate で return する値はもちろん flagged utf8 な値である必要があります。

例として先程の　TestTable の utf8_test テーブルに対して utf8_column な inflate 定義をします。

ついでなので alias_column でエイリアス張ったカラムに inflate 設定しましょう。

        utf8_column name
            => char => {
                required => 1,
                size     => 32,
            };

        alias_column name => obj => {
            inflate => sub { Name->new($_[0]) },
            deflate => sub { $_[0]->name },
        };

Name は以下のようなコードです。

    package Name;
    sub new {
        my($class, $name) = @_;
        bless \$name, $class;
    }
    sub name { ${ $_[0] } }

実際に動かしてみましょう。

use utf8;
use Encode;
my $db = TestTable->new;

$db->set( utf8_test => 1 => { name => '大沢和宏' } );
my $row = $db->lookup( utf8_test => 1 );
if (Encode::is_utf8($row->name)) {
    print $row->name . "\n";
}
if (Encode::is_utf8($row->obj->name)) {
    print $row->obj->name . "\n";
}

# update してみる
$row->name('ねこかくたろう');
if (Encode::is_utf8($row->name)) {
    print $row->name . "\n";
}
if (Encode::is_utf8($row->obj->name)) {
    print $row->obj->name . "\n";
}
$row->update;

my $row2 = $db->lookup( utf8_test => 1 );
if (Encode::is_utf8($row->name)) {
    print $row->name . "\n";
}
if (Encode::is_utf8($row->obj->name)) {
    print $row->obj->name . "\n";
}

結果は以下のようになっています。

大沢和宏
大沢和宏
ねこかくたろう
ねこかくたろう
ねこかくたろう
ねこかくたろう

ちゃんと decode 処理してないで print するので Wide character とか出ますが、 utf8 flag がきちんと立ってることがわかると思います。

まとめ

今日は utf8 column の使い方と inflate との組み合わせについて解説しました。

カラム定義まわりは、まだちょびっとだけ続くぞ。

超簡単なカラム

Data::Mode;;Schema を use すると、スキーマ定義に必要な DSL がインストールされる旨はだいぶ初回の時に説明しましたが、カラムする為の DSL も各種インストールされています。

column と columns が良く使われる定義で、それぞれ1つのカラム定義か複数のカラム定義を行えます。

使い方はそれぞれ

    column 'column_name';
    columns qw/ column_name1 column_name2 column_name3 column_name4 /;

となります。

この使い方は、カラム名だけ引数に与えて与えた引数でのカラム名定義を行ってくれます。

カラム定義を真面目にする

上の簡単な使い方だとカラムの型やら具体的な定義が書かれてないので NOT NULL 制約があるのか何なのか良くわかりません。

そこで、 DBIC とかの良くあるちゃんとした定義を書きます。

これには先の column を利用します。 columns では詳細な定義はできません。

    column column_name
        => int => $options;

このように書きます。

第一引数はカラム名。

第二引数はカラム型。

第三引数がカラムの詳細な定義となります。

カラムの詳細な定義とは、 NOT NULL 制約やら DEFAULT の設定やカラムのサイズなどです。

具体的に定義可能なパラメータは http://search.cpan.org/dist/Data-Model/lib/Data/Model/Schema.pm#COLUMN_OPTIONS に記載してあります。

例えば

    name CHAR(16) NOT NULL

という定義をしたいときは

    column name
        => char => {
            required => 1,
            size     => 16,
        };

という定義を行います。

DEFAULT 値

    name CHAR(16) DEFAULT 'Yappo'

というような DEFAULT の定義をするには

    column name
        => char => {
            default  => 'Yappo',
            size     => 16,
        };

と書けば良いだけなのですが、例えば特定の計算結果(YUID とか)を DEFAULT として入れておきたい場合もあるかと思います。

そんな時は default => sub {} のように CODE リファレンスを書いておくと INSERT するタイミングで CODE リファレンスを実行してくれて、その戻り値を INSERT する用になります。

    my @names = qw/ Yappo nekokak kan /;
    column name
        => char => {
            default  => sub {
                @names[rand(@names)]
            },
            size     => 16,
        };

とかやれば、 Yappo, nekokak, kan のいづれかが DEFAULT として利用されます。

AUTO INCREMENT

さて、いよいよ auto increment の出番です。

といっても、とても簡単で auto_increment => 1 するだけです。

    column id
        => int => {
            required       => 1,
            unsigned       => 1,
            auto_increment => 1,
        };

これだけなんで、とっても簡単ですね。この定義で SQLite と MySQL ともに動きます。

ちなみに unsigned => 1 ってのは INT UNSIGNED ってするだけです。

さて、 MySQL の MyISAM, BDB テーブルでは複合 primary key の二つ目のカラムに AUTO_INCREMENT を指定できます。

http://dev.mysql.com/doc/refman/5.1/en/example-auto-increment.html

一つ目の値のグーループに対する auto increment をつけてくれるのですが Data::Model で以下のようにスキーマ定義を行ってテーブルを作れば対応可能です。

{
    package TestTable;
    use base 'Data::Model';
    use Data::Model::Schema;
    use Data::Model::Driver::DBI;

    my $driver = Data::Model::Driver::DBI->new(
        dsn => 'dbi:mysql:database=test'
    );
    base_driver $driver;

    install_model auto_increment_test => schema {
        key [qw/ id entry_id /];
        column id
            => int => {
                required => 1,
                unsigned => 1,
            };
        column entry_id
            => int => {
                auto_increment => 1,
                required       => 1,
                unsigned       => 1,
            };
    };
}
print join(";\n", TestTable->as_sqls, '');

使い方は以下の通りで

my $db = TestTable->new;

$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 2 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 2 );

my $itr = $db->get('auto_increment_test');
while (<$itr>) {
    printf "id = %d, entry_id = %d\n", $_->id, $_->entry_id;
}

結果は下記のようになります。

my $db = TestTable->new;

$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 2 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 1 );
$db->set( auto_increment_test => 2 );

my $itr = $db->get('auto_increment_test');
while (<$itr>) {
    printf "id = %d, entry_id = %d\n", $_->id, $_->entry_id;
}

まとめ

本日はカラム定義の詳細を書きました。

明日は他のカラム定義を見ていきます。

    alias_column original_name => alias_name => { ... };

定義

さて実際に、定義してみましょう。先日からいじっている bookmark テーブルの　create_at カラムに対してこの美味しいエイリアスを仕込みます。

    # create_at を生の値でも使いたい
    column create_at => int => {
        required => 1,
        unsigned => 1,
        default => sub { time() },
    };
    # Inflate するのはエイリアスで
    alias_column create_at => create_dt => {
        inflate => 'DateTime',
    };

単純に create_at の定義から Inflate の設定を抜いて alias_column で create_dt というエイリアスカラムを張って、そこのカラムに　DateTime の Inflate 定義を設定しています。

使ってみる

さて、先日までのサンプルスクリプトを create_dt に対応させて利用例を見てみましょう。

    $bookmark->set( bookmark => [1, 1] );
    my $row = $bookmark->lookup( bookmark => [1, 1] );
    print "--- insert\n";
    print $row->create_at . "\n";
    print $row->create_dt . "\n";

    my $dt = DateTime->new( year => 1978, month => 3, day => 20 );
    $row->create_dt( $dt );
    print "--- update 1978/3/20\n";
    print $row->create_at . "\n";
    print $row->create_dt . "\n";
    $row->update;

    my $row2 = $bookmark->lookup( bookmark => [1, 1] );
    print "--- lookup 1978/3/20\n";
    print $row2->create_at . "\n";
    print $row2->create_dt . "\n";
    $row2->create_at( 0 );
    print "--- update 0\n";
    print $row2->create_at . "\n";
    print $row2->create_dt . "\n";
    $row2->update;

    my $row3 = $bookmark->lookup( bookmark => [1, 1] );
    print "--- lookup 0\n";
    print $row3->create_at . "\n";
    print $row3->create_dt . "\n";

結果は以下のとおりです。

--- insert
1260772604
2009-12-14T06:36:44
--- update 1978/3/20
259200000
1978-03-20T00:00:00
--- lookup 1978/3/20
259200000
1978-03-20T00:00:00
--- update 0
0
1970-01-01T00:00:00
--- lookup 0
0
1970-01-01T00:00:00

create_at, create_dt メソッドそれぞれに値を入れたら即座にお互いの値も変更されてるのがわかると思います。

先日 DateTime の deflate 定義として数値と DateTime オブジェクト両方受け入れられるようにした時に epoch time を直接いれてしまうと、それいこう DateTime オブジェクトで取得出来ない問題がありましたが、エイリアスカラムを使うと常に値が入れられたタイミングで同期されるので安心です。

まとめ

数日連続して Inflate 関連の話題を書きました。

alias_column は、元データと加工後のデータがそれぞれ必要なときに便利です。

ということで次回はまた別のジャンルのネタにしようとおもいます。

inflate_type の設定

使い回し可能な Inflate の設定をするには Data::Model::Schema::Inflate が export する inflate_type 関数を利用します。

昨日の DateTime の Inflate 設定を行うには以下のように書きます。

    # inflate setup
    use Data::Model::Schema::Inflate;
    use DateTime;

    inflate_type DateTime => {
        inflate => sub {
            DateTime->from_epoch( epoch => $_[0] );
        },
        deflate => sub {
            ref($_[0]) && $_[0]->isa('DateTime') ? $_[0]->epoch : $_[0];
        },
    };

inflate_type の第一引数に定義名を書き、第二引数に inflate, defulate を key にして value に CODE リファレンスを書いた HASH リファレンスを渡します。

HASH-ref の中身の inflate と deflate の中身は全く変わっていません。

これを、利用するには column の定義の中の inflate に対して定義名を渡すだけです。

    column create_at => int => {
        required => 1,
        unsigned => 1,
        default => sub { time() },
        inflate => 'DateTime',
    };

ちょっと簡潔になりましたね。

ちなみに、組み込みの inflate 定義として URI と Hex があります。

定義は以下のように成っています。

# in Data::Model::Schema::Inflate
my %INFLATE = (
    inflate => {
        URI  => sub { URI->new($_[0]) },
        Hex  => sub { unpack("H*", $_[0]) },
    },
    deflate => {
        URI  => sub { $_[0]->as_string },
        Hex  => sub { pack("H*", $_[0]) },
    },
);

使ってみる

利用方法は昨日のコピペですが以下のようになります。

以下のように使います。

    $bookmark->set( bookmark => [1, 1] );
    my $row = $bookmark->lookup( bookmark => [1, 1] );
    print $row->create_at . "\n";

    my $dt = DateTime->new( year => 1978, month => 3, day => 20 );
    $row->create_at( $dt );
    print $row->create_at . "\n";
    $row->update;

    my $row2 = $bookmark->lookup( bookmark => [1, 1] );
    print $row2->create_at . "\n";
    $row2->create_at( 0 );
    print $row2->create_at . "\n";
    $row2->update;

    my $row3 = $bookmark->lookup( bookmark => [1, 1] );
    print $row3->create_at . "\n";

結果は下記の通り。

(この行は実行した時間が入ります)
1978-03-20T00:00:00
1978-03-20T00:00:00
0
1970-01-01T00:00:00

まとめ

本日は再利用可能な Inflate に関して説明しました。

明日は Inflate と組み合わせると便利になる昨日の紹介をします。

スキーマ定義

さて、実際に Inflate を使ったカラムを作ってみましょう。

MyBookmark の bookmark テーブルは、ブックマークした時間が保存出来ないので、保存出来るようにします。

そして、ブックマークした日時を DateTime のオブジェクトとして扱えるようにしましょう。

データベースには epoch time を保存しておいて、通常は DateTime として扱いたい場合を書いてみます。

以下のようなコードになります。

    column create_at => int => {
        required => 1,
        unsigned => 1,
        default => sub { time() },
        inflate => sub {
            DateTime->from_epoch( epoch => $_[0] );
        },
        deflate => sub {
            ref($_[0]) && $_[0]->isa('DateTime') ? $_[0]->epoch : $_[0];
        },
    };

INSERT 時に値を省略出来るように　default の定義をしています。今回は INSERT した時の time の値をそのまま入れます。

inflate の第一引数はデータベースから取り出したままの値です。

今回は epoch time が入ってくるので DateTime オブジェクトにして返します。

deflate の第一引数は row オブジェクトで利用している、そのカラムの値です。

inflate と比べて若干ややこしいですが、 $row->create_at( time() ) などと DateTime ではなく直接 epoch time を入れられる事に対応するためにこうなってます。

使ってみる

使い方は特に変わった事をする必要はありません。

create_at が DateTime オブジェクトを返すという事と、 create_at に epoch time と DateTime を入れられるという事位です。

以下のように使います。

    $bookmark->set( bookmark => [1, 1] );
    my $row = $bookmark->lookup( bookmark => [1, 1] );
    print $row->create_at . "\n";

    my $dt = DateTime->new( year => 1978, month => 3, day => 20 );
    $row->create_at( $dt );
    print $row->create_at . "\n";
    $row->update;

    my $row2 = $bookmark->lookup( bookmark => [1, 1] );
    print $row2->create_at . "\n";
    $row2->create_at( 0 );
    print $row2->create_at . "\n";
    $row2->update;

    my $row3 = $bookmark->lookup( bookmark => [1, 1] );
    print $row3->create_at . "\n";

結果は下記の通り。

(この行は実行した時間が入ります)
1978-03-20T00:00:00
1978-03-20T00:00:00
0
1970-01-01T00:00:00

0 になってる部分は、 create_at に 0 を入れたため、そのまま出てきてしまっています。

あくまでもデータベスから値を出すときに inflate 処理されているという事です。

これは、回避策がありますがまた今度の機会に。

まとめ

本日は Inflate を使ったカラムの作り方を扱いました。

明日はもう少し Inflate について掘り下げます。