hide-k.net#blog

[ Diary] taspo

日本では今日からtaspoが導入されて自動販売機でタバコを買うことが出来なくなりますね。
未成年の喫煙を防ぐのが目的らしいですが、何でも申し込みが面倒くさいらしく、喫煙者には迷惑な話だと思います。
税金が上がって1000円くらいになるって話だし、喫煙者はどんどん肩身が狭くなりますね。

あ、僕はタバコ辞めたのでかんけいないですけどね。

hide 2008.07.01 10:19 Permalink Comments (2) Trackbacks (0)

[ Perl] Kazuho式フレンド・タイムライン実装をDBICで表してみた

Kazuho@Cybozu Labs: フレンド・タイムライン処理の原理と実践

奥さん本人の中でブームが去った感もあるRDBMSで実現するフレンド・タイムライン処理ですが、そういえばDBICで使ってみたのを思い出したので晒してみます。

要はDBICからストアドプロシージャの叩き方を知りたかっただけなんですけどね。

パッケージ名はWebインターフェースはどーせCatalystで作るでしょってことでCatalyst + Twitter = Catatter…って安直なネーミングですね。

記事中ではプッシュ型とプル型が紹介されているのですが、データ量やfollow, removeの際のコストとか考えたらプル型の方が好みかなってことでプル型を採用してみました。

また、基本的にスキーマやストアドプロシージャはオリジナルと同じですが、DBICでPKをマルチカラムにするとめんどっちーのでサロゲートキーを追加したりしてます。

CREATE TABLE user (
    id int(10) unsigned NOT NULL AUTO_INCREMENT,
    screen_name varchar(255) NOT NULL,
    PRIMARY KEY (id)
) ENGINE=innodb;

CREATE TABLE message (
    id int(10) unsigned NOT NULL AUTO_INCREMENT,
    user_id int (10) unsigned NOT NULL,
    body varchar(255) NOT NULL,
    PRIMARY KEY (id),
    KEY userid_id_id(user_id, id)
) ENGINE=innodb;

CREATE TABLE follower (
    id int(10) unsigned NOT NULL AUTO_INCREMENT,
    user_id int (10) unsigned NOT NULL,
    follower_id int (10) unsigned NOT NULL,
    PRIMARY KEY (id),
    UNIQUE (user_id, follower_id),
    KEY user_id_follower_id (user_id, follower_id),
    KEY follower_id(follower_id)
) ENGINE=innodb;

DELIMITER //
CREATE PROCEDURE fetch_timeline_ids (IN uid int unsigned)
BEGIN
  DECLARE fid,maxid int unsigned;
  DECLARE done int DEFAULT 0;
  DECLARE fid_maxid_cur CURSOR FOR
    SELECT follower_id,(
      SELECT id FROM message WHERE user_id=follower.follower_id
      ORDER BY user_id DESC,id DESC LIMIT 1) AS max_id
    FROM follower WHERE user_id=uid ORDER BY max_id DESC LIMIT 20;
  DECLARE CONTINUE HANDLER FOR NOT FOUND SET done=1;
  CREATE TEMPORARY TABLE IF NOT EXISTS fetch_timeline_tt (
    id int unsigned NOT NULL PRIMARY KEY
  ) ENGINE=heap DEFAULT CHARSET=utf8;
  DELETE FROM fetch_timeline_tt;
  OPEN fid_maxid_cur;
  REPEAT
    FETCH fid_maxid_cur INTO fid,maxid;
    IF NOT done THEN
      INSERT INTO fetch_timeline_tt
        SELECT id FROM message WHERE user_id=fid
        ORDER BY id DESC LIMIT 20;
    END IF;
  UNTIL done END REPEAT;
  CLOSE fid_maxid_cur;
END;

CREATE PROCEDURE build_max_ids_of_followers (IN uid int unsigned,IN max_id int unsigned)
BEGIN
  DECLARE fid int unsigned;
  DECLARE done int DEFAULT 0;
  DECLARE fcur CURSOR FOR
    SELECT follower_id FROM follower WHERE user_id=uid;
  DECLARE CONTINUE HANDLER FOR NOT FOUND SET done=1;
  CREATE TEMPORARY TABLE IF NOT EXISTS max_ids_of_followers (
    user_id int unsigned NOT NULL,
    max_id int unsigned NOT NULL
  ) ENGINE=heap DEFAULT CHARSET=utf8;
  DELETE FROM max_ids_of_followers;
  OPEN fcur;
  REPEAT
    FETCH fcur INTO fid;
    IF NOT done THEN
      INSERT INTO max_ids_of_followers SELECT fid,max(id) AS m FROM message
        WHERE user_id=fid AND id<max_id HAVING NOT ISNULL(m);
    END IF;
  UNTIL done END REPEAT;
  CLOSE fcur;
END;

CREATE PROCEDURE fetch_timeline_ids2 (IN uid int unsigned,IN maxid int unsigned)
BEGIN
  DECLARE fid,fmaxid int unsigned;
  DECLARE done int DEFAULT 0;
  DECLARE fid_maxid_cur CURSOR FOR
    SELECT user_id,max_id FROM max_ids_of_followers
    ORDER BY max_id DESC LIMIT 20;
  DECLARE CONTINUE HANDLER FOR NOT FOUND SET done=1;
  CREATE TEMPORARY TABLE IF NOT EXISTS fetch_timeline_tt (
    id int unsigned NOT NULL PRIMARY KEY
  ) ENGINE=heap DEFAULT CHARSET=utf8;
  DELETE FROM fetch_timeline_tt;
  CALL build_max_ids_of_followers(uid,maxid);
  OPEN fid_maxid_cur;
  REPEAT
    FETCH fid_maxid_cur INTO fid,fmaxid;
    IF NOT done THEN
      INSERT INTO fetch_timeline_tt
        SELECT id FROM message
        WHERE user_id=fid AND id<=fmaxid
        ORDER BY id DESC LIMIT 20;
    END IF;
  UNTIL done END REPEAT;
  CLOSE fid_maxid_cur;
END;
//

Catatter::Schema

package Catatter::Schema;

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_classes;

1;

Catatter::Schema::User

package Catatter::Schema::User;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(
    "Core",
);
__PACKAGE__->table("user");
__PACKAGE__->add_columns(
    "id",
    {   data_type     => "INT",
        default_value => undef,
        is_nullable   => 0,
        size          => 10
    },
    "screen_name",
    {   data_type     => "VARCHAR",
        default_value => "",
        is_nullable   => 0,
        size          => 255
    },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->has_many(
    messages => 'Catatter::Schema::Message',
    { 'foreign.user_id' => 'self.id' }
);

sub following_timeline {
    my $self   = shift;
    my $max_id = shift;
    my $cond   = shift;
    my $attrs  = shift || {};

    my $source  = $self->result_source;
    my $storage = $source->storage;
    $storage->dbh_do(
        sub {
            my ( $storage, $dbh, @cols ) = @_;
            if ($max_id) {
                my $sth = $dbh->prepare('Call fetch_timeline_ids2(?, ?)');
                $sth->execute( $self->id, $max_id );
            } else {
                my $sth = $dbh->prepare('Call fetch_timeline_ids(?)');
                $sth->execute( $self->id );
            }
        }
    );

    $source->schema->resultset('Message')->search(
        {%$cond},
        {   join => [qw/messages/],
            %$attrs
        }
    );
}
1;

Catatter::Schema::Message

package Catatter::Schema::Message;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(
    "Core",
);
__PACKAGE__->table("message");
__PACKAGE__->add_columns(
  "id",
  { data_type => "INT", default_value => undef, is_nullable => 0, size => 10 },
  "user_id",
  { data_type => "INT", default_value => "", is_nullable => 0, size => 10 },
  "body",
  { data_type => "VARCHAR", default_value => "", is_nullable => 0, size => 255 },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->belongs_to(user => 'Catatter::Schema::User', {'foreign.id' => 'self.user_id'});
__PACKAGE__->belongs_to(timeline => 'Catatter::Schema::FetchTimelineTt', {'foreign.id' => 'self.id'});

1;

Catatter::Schema::Follower

package Catatter::Schema::Follower;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(
    "Core",
);
__PACKAGE__->table("follower");
__PACKAGE__->add_columns(
  "id",
  { data_type => "INT", default_value => undef, is_nullable => 0, size => 10 },
  "user_id",
  { data_type => "INT", default_value => "", is_nullable => 0, size => 10 },
  "follower_id",
  { data_type => "INT", default_value => "", is_nullable => 0, size => 10 },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->add_unique_constraint("user_id", ["user_id", "follower_id"]);
__PACKAGE__->belongs_to(user => 'Catatter::Schema::User', {'foreign.id' => 'self.user_id'});
__PACKAGE__->belongs_to(follower => 'Catatter::Schema::Userr', {'foreign.id' => 'self.follower_id'});

1;

Catatter::Schema::FetchTimelineTt

package Catatter::Schema::FetchTimelineTt;

use strict;
use warnings;

use base 'DBIx::Class';

__PACKAGE__->load_components(
    "Core",
);
__PACKAGE__->table("fetch_timeline_tt");
__PACKAGE__->add_columns(
  "id",
  { data_type => "INT", default_value => undef, is_nullable => 0, size => 10 },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->belongs_to(message => 'Catatter::Schema::Message', {'foreign.id' => 'self.id'});

1;

で使い方は

use Catatter::Schema;

my $schema = Catatter::Schema->connect('dbi:mysql:catetter', 'user', 'pass');
my $user = $schema->resultset('User')->find(1);
my $timeline = $user->following_timeline(
    undef, 
    {}, 
    {order_by => 'me.id DESC', rows => 20}
);
my $minid;
while (my $message = $timeline->next) {
    print $message->user->screen_name . ': ' . $message->body . "\n";
    $minid = $message->id;
}

こんな感じ。ただ、pageは効かないので次のページを取るには現在のresultsetの一番小さいidを渡してやる必要があります。

my $timeline = $user->following_timeline(
    $minid, 
    {}, 
    {order_by => 'me.id DESC', rows => 20}
);

ちなみに自分のタイムラインは

my $timeline = $user->messages(
    {}, 
    {order_by => 'me.id DESC', rows => 20}
);

で取れます。

結論から言うと、DBICから綺麗にストアドプロシージャを叩く方法がわからず生のDBHを叩くというどーなんだ？的な解決方法になってます。

全体的に無理やり感がありますが、まーこんな感じでもできるよって感じで。

hide 2008.06.30 15:01 Permalink Comments (0) Trackbacks (0)

[ Catalyst] Catalyst::Controller::RequestToken 0.01 release

あちこちで叫ばれている、むやみやたらにCatalystのPluginを作るべきではない運動。(この辺はトクヒロムさんがキャンペーンを張ってるので一読して方がいいです。)
まー言われていることはもっともで、ComponentでできることはComponentにすべきなわけです。
で、拙作のCatalyst::Plugin::RequestTokenなる代物も一部finilizeを使っているものの、明らかにControllerにするべきなので、C::P::RequestTokenをdeprecateさせてCatalyst::Controller::ReqeustTokenってのをとりあえず作ってCPANでリリースしました。

使い方は

package MyApp::Controller::Foo;
use base qw(Catalyst::Controller::RequestToken);

sub form :Local {
    my ($self, $c) = @_;
    $c->stash->{template} = 'form.tt';
    $c->forward($c->view('TT'));
}

sub confirm :Local :CreateToken {
    my ($self, $c) = @_;
    $c->stash->{template} = 'confirm.tt';
    $c->forward($c->view('TT'));
}

sub complete :Local :ValidateToken {
    my ($self, $c) = @_;
    if ($self->validate_token) {
        $c->response->body('complete.');
    } eles {
        $c->response->body('invalid operation.');
    }    
}

confirm.tt

<html>
<body>
<form action="complete" method="post">
<input type="hidden" name="_token" values="[% c.req.param('_token') %]"/>
<input type="submit" name="submit" value="complete"/>
</form>
</body>
</html>

とかすると、トークンにより/foo/confirm -> /foo/complete のトランザクションが保証され、/foo/completeの二重サブミットやCSRF攻撃を防ぐことができます。

Controllerにすることによってfinilizeのフックが出来なくなってprepare_tokenが再現できないのですが、その他はほぼ同じ動きをするし、見た目こっちの方がわかりやすいと思います。

これに伴いCatalyst::Plugin::RequestTokenはdeprecateされたのでご注意ください。

hide 2008.06.05 09:18 Permalink Comments (0) Trackbacks (0)

[ Diary] 新車購入

先日、奥さんと知り合う機会があって一緒に飲ませていただいたのですが、その際に家がご近所ということが発覚。
奥さんは赤坂までチャリンコ通勤してるそうで(この日も渋谷までチャリで来てました)僕が麹町まで電車通勤してるって言ったらドン引きされました。

ってことで、15年くらい乗り続けてたママチャリはさすがにあちこちへたってきてたので、ドンキで新車を購入して早速チャリ通勤始めたよ。

全速力でダッシュしたら確かに電車よりは早いかも。

hide 2008.06.04 10:06 Permalink Comments (1) Trackbacks (0)

[ Tech] VAIO延命処置

猫も杓子もMacな世の中で、未だに2004年に発売されたVAIO T90PSを使い続けています。
別に不満はなかったのですが、最近ハードディスクが変な音を出すようになってまずいなーとか思ってました。
んで、重い腰を上げてハードディスクの換装に乗り出したのですが、こいつにくっついてるのは巷で出回ってる2.5インチではなく、iPodとかで使われている1.8インチという事実上東芝しか作っていない特殊なやつ。
しかも、コネクタが現行のものは使えず、最大容量でMK8007GAHという80GBの物を最後にモデルが生産終了になってるんですね。
しかもこいつが高い。このご時勢で80GBで2万円前後。
とはいえ、生産終了ってことは在庫にあるものがはけたら入手困難必至になり、新しくノートを買う羽目になるので、背に腹は変えられんってことで購入したわけです。

とにかくちっちゃい。

で、本体ばらして乗せ換え。

途中、部品が余ったりして冷や汗でましたが、なんとなく完了。

んで、容量増えて密度が上がったので多少はパフォーマンス上がるかなと、とりあえずWinXP入れてみたら、何となく体感でわかる程度に上がった気がします。
少なくとも異音がしなくなったので快適。

っつーわけで、容量増えて20GBくらいWindowsに割けるようになったのでPCDJでも始めようかなとか思ってます。

hide 2008.05.23 10:12 Permalink Comments (0) Trackbacks (0)

[ Diary] Re: 正しい読み方

正しい読み方 - Hatena::Diary::Neko::kak 500 Internal Server Error

nekokakの読み方についてなんか本人の居ないところで色々言われているようです。

人事ではない話題＞＜

僕の場合、本人を目の前にして色々言われているわけです。
まーここのドメイン名から推察するとhide-kってことは「ひでき」ではないわけですよ。
で、ややこしいのがWebサービスによってはハイフンなんかがアカウントとして取れないことがままあり、そんな時はhidekにしてるので、そーすっと「ひでき」と読むのが普通らしいわけですね。

種明かし(ってほどのものではないんだけど)hide部が名前でk部が苗字なわけです。
超安直。
もともとの由来はDJネームからなんですけど、まー字面にすると誤解を招きまくるわけです。

ま、全くこだわりはないので
「ひで」
「ひでけー」
「ひでき」
好きなように呼んでもいいし、相手が不快にならない程度にフュージョンも自由です。

でも、似たようなハンドル名構成なのに座敷の置くから大声で「ひでけーだかひできだかわからないけど、とりあえずこっちこいや」的なことを言っておきながら「どちらさんでしたっけ？」ってのはやめてね。

泣くよ？

結論から言うと
「ハンドル名を決める時は計画的に」

hide 2008.05.21 01:13 Permalink Comments (0) Trackbacks (0)

[ Perl] Perl-users.jp

Perl-users.jp - 日本のPerlユーザのためのハブサイト

以前より Shibuya.pm 界隈では、初心者や複雑な Perl の話題をキャッチアップ出来ない Perl 利用者をどうすくい上げるか、という議論を盛んに行っておりました。 Schwern の言う通り Perl で検索してもなかなかいい情報にたどり着けなかったりと、それは酷い現状をどうにかしたいという思いは YAPC::Asia 2008 のスピーカー陣に共通するものであると思っています。

Yappo++

前のエントリーでも紹介したSchwernのPerl Is unDeadに対するYappoスタンダードの答えがこれ。すばらしい。

前々からmiyagawaさんを初めとする最前線を張っている人たちと、レンタルサーバーで掲示板をインストールするのに四苦八苦してる人たちの間の隔たりがすごいなーとか思ってたので、その辺を埋めてくれるサイトに成長してくれたらいいなーって思います。

後は飽きずに継続させることが重要だなーって思うわけです。

っつーか、何か知らんけどコアメンバー候補に挙がってるので僕も何かしらアクションを起こさないとね。
人選の基準が「オヤジ」って気がするのは被害妄想ってことにしておこう。

hide 2008.05.20 22:16 Permalink Comments (0) Trackbacks (1)

[ Perl] テストのもう一つの使い道

品質保証だとか、リファクタリング時の精神安定剤だとか言われてるテストですが、実はもう一つ重要な使い道があります。

それは実践的なドキュメントとしてです。

まぁ、もともとTDD(テスト駆動開発)なんかだと仕様の代わりとして扱われるのだから、当たり前って言えば当たり前なんですけどね。

CPANモジュールには大体POD(Perl Old Document)が付いててSYNOPSIS(使い方)が最初のほうにドンと書いてあるのですが、大雑把過ぎたり機能のごく一部だけだったりでちょっと物足りないという貴兄や、英語で長々と説明されるよりも実際の使われ方見たほうが早いっていう貴兄にはテストを眺めるのがもってこいです。

Perlモジュールのテストを見るにはアーカイブを展開してt/以下をのぞいてみてください。まともなモジュールなら山ほどテストが見つかるはずです。運がよければ探してる機能が見つかるはず。

実際のテストを見るには、アーカイブを持ってきて展開して見るのもいいけど、cpanシェルならもっと簡単にできます。

[hide@localhost hide]# cpan
...
cpan[1]> look Moose
...
[hide@localhost Moose-0.44-4RfUBu]#

こんな感じでパッケージが展開されたビルドディレクトリに入れるので後はt/以下を探検するといいと思います。

ちなみにMooseでは
t/000_recipes
t/200_examples
など見ると初歩的な使い方がたくさん載ってていいと思いますョ。

hide 2008.05.20 16:38 Permalink Comments (0) Trackbacks (0)

[ Perl] MooseのPODの翻訳始めたよ

YAPCでのMichael Schwernのトーク、"perl is unded"を聞いて、Perlは確かに死んじゃいないけど新しい人材は必要だよねって思ったわけです。
で、今年のYAPCには会社の若い子たちを誘って行ったんだけど、口を揃えて言うのが難しい上にさらに英語だからたまらんと。
気持ちは分からんでもないんですよ。僕もあまり得意な方じゃないし。

で、未熟な僕でも何かできないかなーと思ったのがpod(マニュアルね)の翻訳。
しかもMooseなら、敬遠されがちなPerlのややこしいオブジェクト指向プログラミングを分かりやすく書けるので、他の言語の人にも受け入れられやすいかなーと。
まぁ単に今はやりだってだけだけどね(Yapooさん曰く来年にはないらしいけど)。

で、やったもん勝ちってことで、つたない翻訳だけどとっとと始めちゃいました。
とりあえず、日本人が多いってことでcodereposに上げてます。

http://coderepos.org/share/browser/docs/moose-ja

本家の方には話を通してあって、近いうちに本家のtrunkにも放り込んでいくのでじゃんじゃん添削・追記してください。

tokuhiromさんやYappoさんは日本独自でCookbook書いてくれるそうなので、そっちも乞うご期待。

Perlは怖くないよ。楽しいよ。

hide 2008.05.20 02:45 Permalink Comments (1) Trackbacks (0)

[ Perl] YAPC::Asia 2008

今年もYAPC::Asiaに参加してきたよ。
今年は前夜祭からHackathonまで猛烈に堪能してきました。
各セッションの感想は山ほど上がってると思うので個人的な感想を書くよ。

去年辺りから積極的に勉強会やカンファレンスで周りに声をかけるようになったせいで、今年は顔見知りも多くなり、また違った空気を楽しめました。

タバコミニケーションではYusukebeさんとオッパイDetect論をしたり、弾さんとSQLをdisったり、飲み会ではオヤジクラスタのZigorouさんやcharsbarさんと新橋的なノリで話したりと本編以外のとこでもかなり楽しませてもらいました。

あと、毎度のこと感動するのがスタッフのホスタビリティ。takesakoさんを初めとするスタッフの方々には足を向けて寝れないっす。本当にありがとうございました。

typesterさんに誘ってもらったHackathonでは酒も一滴も飲まずに12時間くらいひたすらコードを書きまくっててあまり会話には参加できなかったのがちょっと残念。
明け方にMooseでちょっと詰ってnothingmuchに質問したら、あっという間に解決方法を書いてくれて超感動した。おまけにcommitbitまでくれた。っていうかnothingmuchは本当にいいやつ。

来年までの課題はもうちょっとまともに英会話できるようにしておくこと。
来年はネタがあればSpeakerで是非参加してみたいな。

オマケ：
懇親会のクジで当たったモバ指的なナニか。
使い道が良く分からないけどありがとうございます。

hide 2008.05.19 00:11 Permalink Comments (0) Trackbacks (0)

[ Perl] Moose::RoleでSeparation of Concerns

AOPが騒がれ始めた辺りでJavaを辞めたので、AOPをよくわかってない。
で、AOPに関する記事を斜め読みしてたら「Separation of Concerns」ってのと「Crosscutting Concern」ってのが出てきたのでMooseでやってみた。

良くありがちな銀行口座クラスをMooseで作ってみる。

package BankAccount;

use Moose;

has 'balance' => (is => 'rw', isa => 'Int', default => 0);

sub deposit {
    my ( $self, $amount ) = @_;
    $self->balance( $self->balance + $amount );
}

sub withdraw {
    my ( $self, $amount ) = @_;
    $self->balance >= $amount
        ? $self->balance( $self->balance - $amount )
        : confess 'account overdrawn';

1;

基本的なMooseによるクラス定義。一応説明しておくと

has 'balance' => (is => 'rw', isa => 'Int', default => 0);

balance(残高)という属性を持っていて$self->balanceがgetter。
$self->balance($amount)がsetter。
型チェックが行われてIntのみ受け付ける。
デフォルトはは0。

メソッドは二つで、depositが入金でwithdrawが出金。
これは普通のPerl OOのメソッドと同じ。

このクラスは普通に

my $account = BankAccount->new;
warn $account->balance;
$account->deposit(10000);
warn $account->balance;

みたいに使えて結果は

0
10000

で、ここに要件として

「depositの後にいくら入金されたかログとして表示しなさい」

ってのが追加されたとする。

普通は

sub deposit {
    my ( $self, $amount ) = @_;
    $self->balance( $self->balance + $amount );

    warn "log: deposited $amount ";
}

とかやるんだけど、これだと
1. 本質的な処理(ここで言うと入金された金額を残高に足す)って処理に本来関係ない処理(いくら入金されたか表示する)が含まれて見通し悪い。
2. 更に、ロギングとかって他にも使い道あるんだからまとめたい。

1.のようにコードの関心事を切り分けることをAOPでは「関心事の分離(Separation of Concerns)」っていう。
2.のようにいくつものクラスにまたがって利用される関心事をAOPでは「横断的な関心事(Crosscutting Concern)」っていう。

これをMooseで実装するにはどうするかというとMoose::Roleを使う。RoleはJavaで言うとこのInterfaceに実装を加えられるようなもの。

package BankAccount::Role::Logable;

use Moose::Role;

requires qw(deposit withdraw);

after 'deposit' => sub {
    my ($self, $amount) = @_;

    warn "log: deposited $amount ";
};

1;

requires qw(deposit withdraw);

は、このRoleを使うにはdepositメソッドととwithdrawメソッドを実装する必要がある、という意味で、
で、

after 'deposit' => sub {...

は、depositメソッドを呼ばれた後に以下のコードを実行するって意味。

で、

package BankAccount;

use Moose;

with 'BankAccount::Role::Logable';

has 'balance' => (is => 'rw', isa => 'Int', default => 0);

sub deposit {
    my ( $self, $amount ) = @_;
    $self->balance( $self->balance + $amount );
}

sub withdraw {
    my ( $self, $amount ) = @_;
    $self->balance >= $amount
        ? $self->balance( $self->balance - $amount )
        : confess 'account overdrawn';

1;

ってする。

with 'BankAccount::Role::Logable';

は、BankAccount::Role::Logableを使うよっていう宣言。Javaで言うとimplementsみたいなもん。これをすることによってRoleで宣言されているメソッドを実装する必要が出てくる。

で、さっきのを実行すると

0
10000
log: deposited 10000

って見事ログが表示されてdepositメソッドを変更することなく要件は満たした。

つまり関心事を分離したことによって本来の関心事(Core Concern)に変更を加えることなく新たな関心事を付け加えることが出来るのでコードが見やすい。

ちなみにafterの他に当然beforeもあって、もう一つaroundってのもある。

「出金の前後にログを表示しなさい」

ってな要件が加わったらBankAccount::Role::Loggableに

around 'withdraw' => sub {
    my ($next, $self, $amount) = @_;

	print "log: before withdraw $amount:\n";
	$next->($amount);
	print "log: after  withdraw $amount: \n";

}

的なことを加えればいい。BankAccountには何も変更なし。

ちょっといい例が思いつかないけど、同じようにBankAccount::Role::Loggableをwithしてdepositとwithdrawを実装したら同じようにログを吐いてくれる。

とにかく、こーゆーことをすることによってコードは見やすくなり、クラスの再利用しやすくなる…って理解してる。

hide 2008.05.06 01:18 Permalink Comments (0) Trackbacks (0)

[ Perl] MooseとClass::MOPでメタプログラミング始めた

今、超熱いMoose始めたよ。
で、Moose理解するにはClass::MOP理解しなきゃいけなくて、Class::MOP理解するにはMOP理解しなきゃいけないので、ircでえろい人たちに色々教わったのでメモ。

メタプログラミング メタプログラミング - Wikipedia

ロジックを直接コーディングするのではなく、あるパターンをもったロジックを生成する高位ロジックによってプログラミングを行う方法

んで、これを実現するために必要なのがメタクラスとMOP。

MOP(メタオブジェクトプロトコル)
メタクラスを通してオブジェクトシステムへアクセスするAPI

メタクラス
クラスの振る舞いを定義したクラスでイントロスペクション(introspection)とインターセッション(itercession)を備える

イントロスペクション
オブジェクトの属性を得る能力 ex) 何のクラスを継承しているかとか、何のメソッドを持ってるかとか

インターセッション
オブジェクトの振る舞いに変更を加える能力 ex) 親クラスを変更するとか、メソッドを追加するとか。

で、Class::MOPはPerl 5のオブジェクトシステムに対してのMOPを提供してくれるモジュール。
Class::MOPには大きく分けて4つのモジュールでプロトコルが提供されてる。

Class::MOP::Class - クラスに対するプロトコル
Class::MOP::Attribute - アトリビュートに対するプロトコル
Class::MOP::Method - メソッドに対するプロトコル
Class::MOP::Instance - クラスのインスタンス生成に対するプロトコル

で、これらを使うとこんな風に書けちゃう。

use strict;
use warnings;

use Class::MOP;

{
    package Hoge;
    use metaclass;
}

my $meta = Hoge->meta;
my $meth_hello = Class::MOP::Method->wrap( sub { print "hello\n"; } );
my $attr_foo = Class::MOP::Attribute->new( '$foo' => ( accessor => 'foo' ) );
my $attr_bar = Class::MOP::Attribute->new( '$bar' => ( accessor => 'bar' ) );
my $hoge = Class::MOP::Instance->new($meta)->create_instance;

$meta->add_method( 'hello' => $meth_hello );
$meta->add_attribute($attr_foo);

$hoge->hello; # hello
$hoge->foo('FOO');
warn $hoge->foo; # FOO

eval { warn $hoge->bar; };
warn $@; # Can't locate object method "bar" via package "Hoge"

$meta->add_attribute($attr_bar);

$hoge->bar('BAR');
warn $hoge->bar; # BAR

で、MooseはClass::MOPをラップして使いやすくしてくれる＋α的なモジュール。

use strict;
use warnings;

{
    package Hoge;

    use Moose;

    has 'foo' => (is => 'rw');
    sub hello {
        my $self = shift;

        print "hello\n";
    }
}

my $hoge = Hoge->new;
$hoge->hello; # hello
$hoge->foo('FOO');
warn $hoge->foo; # FOO

もちろんメタクラスにアクセスできるので

$hoge->meta->add_attribute('$bar', accessor => 'bar');
$hoge->bar('BAR');
warn $hoge->bar; # BAR

てなこともできる。

すっげー便利。

参考:
Class::MOP - A Meta Object Protocol for Perl 5 - search.cpan.org
Moose - A postmodern object system for Perl 5 - search.cpan.org
meta-object-protocol
meta object protocol について考えてみる - TokuLog 改めだまってコードを書けよハゲ

hide 2008.05.05 01:26 Permalink Comments (0) Trackbacks (0)

[ Catalyst] CatalystCon#1

CatalystCon#1に行って来たよ。
一応スピーカーとして話してきたよ。

で、感想。

MVC論 - dann
- とってもJava的で懐かしかった。
Controller::Resouces - ikasam_a
- 出て意外と早く触ってたけど、やっぱ便利
- ROAって妙に説得力がある
$c <3 C - charsbar
- Catalystの歴史の話が面白かった
- Pluginはなるべく作らない方向で
- やっぱり時間足りなくて途中で加速装置が働いてた
コピペをしないための10の方法 - typester
- catalyst.plを最初に否定した人なので説得力あった
- 最後のほうは苦しかった
Model::Apadtor - hide-k
- ここにあげておいた
Catalyst☆Complex - tokuhirom
- Sledge::Request::Catalyst
- どっちがウケか結論が出てなかったので気持ち悪い
HTTP::Server::Wrapper - Yappo
- Okinaはこれで完成したも同然だね☆

Twitter使ったデモをしようと思ったら寸前でタイムラインがぐちゃぐちゃになってるのに気がついてあわててWassrに切り替えようとNet::Wassrをインストールしようとしたら、autoboxとかModule::Compile::TTとか作りたての環境にあるわけもないモジュールを要求されて冷や汗が出ました。
ま、そんな思いをして作ったデモも時間切れでスルーだったんですけどね。

で、二次会も行ったんだけどnothingmuchとか来てて超面白かった。