時計を壊せ

駆け出してからそこそこ経ったWebプログラマーの雑記

トップ > perl

callbackを直列化してみる遊び

javascript perl

JSDefferedとかData::Monad::CondVarとかあるし車輪の再発明だけど、
頭の体操にはよいかなーとか思ってミニマルな実装を心がけてcallbackを直列化してみた。


たぶん上から順に

  • JSでOOPっぽく実装
  • JSで単純なfunctionによる実装
  • PerlでOOPっぽく実装
  • Perlで単純なfunctionによる実装

ってなってるとおもふ。

Mouse::Util::TypeConstraints等を使って新しい型を定義するときのベストプラクティス

perl Mouse Moose

更に追記

MouseX::Typesですが、その後検証してみたかんじ、
要素を「=>」で繋げてしまうと左辺が文字列として認識されてしまうようなので、
要素を「,」で繋げなければいけないようです。
等価だと思っていましたが微妙に違うんですね。

package HogeProject::MouseType;
use strict;
use warnings;
use utf8;

use MouseX::Types -declare => [qw/UInt/];
use MouseX::Types::Mouse qw/Int/;
subtype UInt,
    as Int,
    where { $_ >= 0 };

1;

追記

id:gfxさんによるとMo[ou]seX::Typesがまさにそんな機能を持っているとの事。知らなかった！
http://search.cpan.org/~gfuji/MouseX-Types-0.06/
http://search.cpan.org/~drolsky/MooseX-Types-0.31/
こんな感じで書けるようです。

package HogeProject::MouseType;
use strict;
use warnings;
use utf8;

use MouseX::Types -declare => [qw/UInt/];
use MouseX::Types::Mouse qw/Int/;
subtype UInt
    => as Int
    => where { $_ >= 0 };

1;

use strict;
use warnings;
use utf8;

use 5.10.0;
use Data::Validator;

use HogeProject::MouseType qw/UInt/;

sub hogeaddone {
    state $rule = Data::Validator->new(
        hogecount => +{ isa => UInt }
    );
    my $arg = $rule->validate(@_);

    return $arg->{hogecount} + 1;
} 

say+hogeaddone(hogecount => 1); # say 2

どう考えてもこっちの方が便利だしイケてるので、
下の方法はどうしてもMo[ou]seX::Typesが使えない環境とかだけに留めて、
なるべくMo[ou]seX::Typesを使用すると良いでしょう。
gfx++

原文

Mouse::Util::TypeConstraints等を使って新しい型を定義すると、
型はグローバルな名前空間に置かれるので、
複数の場所で名前が衝突してしまった場合に問題がわかりにくい。


プロジェクトの名前空間等、独自のprefixを付ける事によってこの問題は解消出来る。
しかし、prefixがつくと型名が長くなってしまってだるいので、
以下のような感じでprefixを勝手に付けてくれる君を作っておくとよいのではないか。

package HogeProject::MouseType;
use strict;
use warnings;
use utf8;
use parent qw/Exporter/;

my $PREFIX = __PACKAGE__ . '::';
our @EXPORT_OK = qw/local_type lt/;
sub local_type {
    my($type, $inner) = @_;

    my $local_type = $PREFIX . $type;
    return $inner ? "${inner}[${local_type}]" : $local_type;
}
*lt = \&local_type; # shortcut

use Mouse::Util::TypeConstraints;

subtype lt('UInt')
    => as 'Int'
    => where { $_ >= 0 };

no Mouse::Util::TypeConstraints;
1;


これは他のClassからは以下のように使える。

use strict;
use warnings;
use utf8;

use 5.10.0;
use Data::Validator;

use HogeProject::MouseType qw/lt/;

sub hogeaddone {
    state $rule = Data::Validator->new(
        hogecount => +{ isa => lt('UInt') }
    );
    my $arg = $rule->validate(@_);

    return $arg->{hogecount} + 1;
} 

say+hogeaddone(hogecount => 1); # say 2


だいぶすっきりしていますね。
こんな感じで書くと良いのではないでしょうか。


「もっと良い方法があるよ！」とか、「この方法はクソだ！」とか、「既出だわボケが！」とかあれば教えて下さい！
enjoy!

正月発火村に行って来た。あるいはXOClockの話。

perl hackathon

さりげなくないけど今年初bloggingです。
あけましておめでとうございます。

正月発火村とは

主に 僕 と @kfly8 が「ハッカソンやりたい！」とか言って適当に集まった面子で、
水上温泉に行ってやってきたhackathonです。
僕はXOClockというものをPerlで開発していました。

XOClockってなに

指定した時刻に指定したJobを実行するJobQueueサーバーです。
例えば、

Facebookでつながってるフレンドをあらかじめ選択して登録しておくと、
2012-02-14 00:00:00にそのフレンドのWallに「Give me chocolate!!」というpostをするWebサービス

を実装したいケースなどで役に立つと思います。

ぶっちゃけ、あまり需要は無いと思いますが、
こんなものがあったら便利になるケースもありそうかなーって思って作りました。

バレンタイン支援WebサービスのWorkerを実装してみる。

上の例を実際に実装してみましょう。*1

まずは以下のような、
アクセストークンとpost対象のユーザーのID一覧を貰えば、
「Give me chocolate!!」
とpostする簡単なWorkerを書きましょう。

package MyProj::Worker::Valentine;
use strict;
use warnings;
use utf8;
use 5.10.0;

use parent qw/XOClock::Worker/;

use Facebook::Graph;

sub run {
    my($self, $args) = @_;

    my $fb = Facebook::Graph->new(access_token => $args->{access_token});                                                                 
    foreach my $id (@{ $args->{id_list} }) {
        $fb->add_post
            ->to($id)
            ->set_message('Give me chocolate!!')->publish;
    }
}

1;


次に、簡単なconfigを書きましょう。
これはWorkerを登録するために必要です。
このファイルをxoclock.yamlという名前で保存してみましょう。

max_workers: 50
worker:
  Valentine: MyProj::Worker::Valentine

これをconfig_fileで指定してserverを起動しましょう。

$ xoclockd --config_file=xoclock.yaml
2012-01-10T01:07:44 [INFO][21229] running on pid: 21229. at /Users/karupanerura/perl5/perlbrew/perls/perl-5.14.2/lib/site_perl/5.14.2/XOClock.pm line 119
2012-01-10T01:07:44 [INFO][21229] load config from 'xoclock.yaml'. at /Users/karupanerura/perl5/perlbrew/perls/perl-5.14.2/lib/site_perl/5.14.2/XOClock.pm line 81
2012-01-10T01:07:44 [INFO][21229] create JSONRPC Server. listen: 0.0.0.0:5312 at /Users/karupanerura/perl5/perlbrew/perls/perl-5.14.2/lib/site_perl/5.14.2/XOClock/Server.pm line 301
2012-01-10T01:07:44 [INFO][21229] server start. at /Users/karupanerura/perl5/perlbrew/perls/perl-5.14.2/lib/site_perl/5.14.2/XOClock.pm line 182

みたいな感じで起動出来ると思います。

あとはWebApp等から、

use XOClock::Client;
my $client = XOClock::Client->new(
    host => '127.0.0.1',
    port => 5312,
);
my $res = $client->enqueue(
    name      => 'Valentine',
    datetime  => '2012-02-14 00:00:00',
    time_zone => $time_zone, # 2012-01-10 08:00頃追記。default: 'GMT', example: 'JST'
    args      => +{
        access_token => $access_token,
        id_list      => \@id_list,
    },
)->recv;

とJobをenqueueしてあげると指定したタイムゾーンの2012-02-14 00:00:00にJobが実行されて、
ユーザーが指定したフレンドにGive me chocolate!!と勝手にpostされると思います。


これを普通のJobQueueで実装しようとするとちょっと骨が折れると思いますが、
XOClockを使えばこのように簡単に実装出来ます。

どんなふうに動いてるのか

主にAnyEvent上で動いています。
ただし、Workerは

  • 同じ時刻や、近い時刻でJobが複数発生する事がある。
  • Workerではブロックせざるを得ない処理を行う事がある。
  • Workerでやらざるを得ない処理は単純に処理量が多い場合が多い。
  • 意図しないエラーが発生した場合にそれを捕捉してログに残したい。

等の理由で別プロセスで動くようになっています。
終了コードが0以外の時はエラーが発生したとして、リトライしたり、Jobが失敗した事をログに残したりします。


あとは、
enqueue等を受ける所はAnyEvent::JSONRPC::Liteで、
signalをcatchする所はAnyEvent->signal*2、
子プロセスの終了を捕捉する所はAnyEvent->childでやっています。


Forkまわりは最初はParallel::ForkManagerを使ってやっていたのですが、
waitする度にblockingしてしまうので、いろいろとhackをする事になってしまいました。
結局waitでblockしない（AnyEvent->childで子プロセスの終了を捕捉する）ようにしたAnyEvent::ForkManagerというモジュールを書きました。

AnyEvent::ForkManager

Parallel::ForkManagerと同じ事をAnyEventのイベントループをblockingしないように簡単に出来るようにしたモジュールです。
これは別途記事を書きます。

今後の展望

以下のような事がしたいなー、ぼんやりと考えています。
Githubで公開しています。

  • 監視用APIを用意する。
    • 動いているWorkerの数(どのJobがいくつ動いているのか)
    • Worker起動予約Queueの数
    • 時間予約Queueの数
  • cronの様にも使えるように繰り返し実行する機能を実装する。(1時間毎とか)
  • Dainamoに対応させる。
  • fork周りを外出ししたAnyEvent::ForkManagerを使うようにする。

正月発火村感想

  • 人が開発してるモノ見てて面白かった。
  • 温泉すばらしい。
  • 料理おいしい。
  • 雪見ながら開発出来た！
  • 環境が普段と違うので集中出来た！
  • まとまった長い時間を使える。
  • でも飯作らなきゃとか考えなくて良い。

温泉行ってまでコード書きたくないという人も居ると思いますが、
温泉旅行って結構、温泉+αな旅行になると思うので、

  1. αでhackathonやってると思えばあまり損な気分にもならない筈。

ぼくは雪を見ると無条件でテンションが上がる人なので、だいぶ楽しいhackathonでした！


他の人がやってたことについては、
なんか凄い事してる！！！
って感じでなんか凄すぎてなんで動いてるのかあまりよくわかってなかったので、
あとでソースじっくり読んで勉強したいと思います！
でも、かなり刺激を受ける事が出来てモチベーションがだいぶ上がりました！
ありがとうございました！

ngircdを立ち上げたりもしたけど、
基本的にはTwitterでやりとりしたりしてたので、
Togetterでまとめてみました。
気になる方はどうぞ！

*1:ここではWorker以外は実装しません

*2:SIGINT,SIGTERM,SIGQUITでgraceful shutdown, SIGHUPでgraceful restartします

blessed (?:array|hash|scalar)refに関して某IRCにて

perl

blessed arrayrefは色々と悪いのでblessed hashrefか、カプセル化したいならblessed scalarref使いましょうというお話。

12:11:00 tkhrm> あとあれ
12:11:05 tkhrm> ArrayRef を object にすると
12:11:15 tkhrm> 気軽に拡張できなくなる
12:11:27 tkhrm> あとから「やっぱこのアトリビュートいらないや!」ってなったときとか
12:11:29 tkhrm> しぬ
12:11:51 gfx> まあね。
12:12:03 tkhrm> からつかうなって damian っておじさんがいってた
12:12:07 tkhrm> ような気がする
12:12:09 gfx> ぼくもなんだかんだといろいろ試した挙句HashRefでいいや、ということになりました。
12:12:14 karupanerura< なるほど
12:12:17 tkhrm> [要出典]
12:12:18 gfx> ぼくが可能性を感じていたのはFieldHashだったんだけど。
12:12:23 tkhrm> ああ、そう
12:12:26 tkhrm> FieldHash とか
12:12:33 gfx> damian先生はFieldHashというかinside out派だからね。
12:12:38 tkhrm> についてドキュメントでふれられてないのがアレゲ
12:13:22 gfx> 手でいじりにくいってのはカプセル化を促すので決してマイナス要素ではないと思う。
12:13:45 tkhrm> んー。まあカプセル化されてる方がベターだけど
12:13:56 tkhrm> 現実的にはカプセル化されたオブジェクトって
12:14:03 tkhrm> よっぽどちゃんとつくってないとしぬよね
12:14:29 gfx> まあでも、実際にやってみるといいんじゃないかな！
12:14:45 gfx> KVSとかに突っ込んでるんでなければあとからでも変えられるし。
12:15:52 cho45> index access してたら死ぬ
12:16:21 tkhrm> w
12:16:31 tkhrm> Storable とかにいれたりとかしちゃうとさ
12:16:35 kazuho> ArrayRef でオブジェクトツクッルのって、継承どうするの？
12:16:39 tkhrm> index ちがくなったりしたらしぬよね
12:16:54 tkhrm> 継承した場合は 100 とばしからはじめる BASIC 方式で!
12:17:08 tkhrm> まあそれでも微妙かw
12:17:08 kazuho> wwww
12:17:31 karupanerura< 継承死にますねｗ
12:17:34 kazuho> ダメですねー mix-in 同士で id かぶるとか
12:18:06 gfx> それってC++だとどうやって解決しているのかしら。
12:18:23 kazuho> this アドレスが変わる [207/285]
12:18:31 gfx> なんと！
12:18:33 tkhrm> なんか
12:18:37 tkhrm> この流れ、すごいみたことある
12:18:38 kazuho> ていか this に型があるからできる
12:18:51 gfx> じゃあ $self->[0]にオフセットを入れておけばいいのかな。
12:19:15 tkhrm> なんか、そういう風にしてるやつあるよね
12:19:18 gfx> で、sub hoge { my($self) = @_; $self->[ $self->[0] + HOGE ] }とかにすると。
12:19:20 kazuho> この型からこの型に変換する時は offset いくつずらすってテーブルないとダメだし
12:19:41 kazuho> 全部の型で $self->[0] じゃなくて、型毎にテーブル用意しないとダメだよ
12:19:51 gfx> oh!
12:20:10 gfx> じゃあ$self->[ $offset_of{ ref $self } + HOGE ]か。
12:20:13 kazuho> てかそういうことやってたら hash より遅くなるんじゃw
12:20:14 gfx> やばいハッシュアクセスしちゃう！
12:20:20 tkhrm> bless [[qw/unko tinko gfx/], 1, 2, 3] MyClass
12:20:21 gfx> ですね！
12:20:31 tkhrm> みたいなのだれかやってた気がしたけどなんのモジュールだかおもいだせない
12:20:41 gfx> それpseudo hashじゃない？
12:20:47 tkhrm> ああ、そうか
12:20:59 gfx> [ { hoge => 0, fuga => 1 }, 'hoge value', 'fuga value']みたいにして
12:21:09 gfx> $self->[ $self->[0]{hoge} ]とする。
12:21:19 gfx> まあ、もう取り除かれた昨日だけど。
12:21:41 gfx> Class::XSAccessorも配列リファレンスモードがあったはず。
12:21:46 karupanerura< そんな機能あったんですね。
12:21:49 karupanerura< おお
12:21:51 gfx> それはC側でよしなにしてくれるから速いのかな。
12:22:09 tkhrm> どうだろうねえ
12:22:11 cho45> ハッシュ便利
12:22:33 tkhrm> Hash::Util でひとつ
12:23:42 tkhrm> まあまとめると、なんかわりとデメリット多いから arrayref を bless するのはオススメしないかんじということで
す!
12:23:43 gfx> Hash::Utilのexperimental臭は半端ない。
12:23:47 tkhrm> w
12:24:25 cho45> Hash::Util って perl の添付モジュールなんですね！ しらなかった！
12:24:28 tkhrm> HashRef >>>>(越えられない壁)>> ScalarRef >>>>>>> (越えられない壁) >> ArrayRef
12:24:31 tkhrm> ぐらいのかんじがする
12:24:34 tkhrm> 使用頻度。
12:25:06 tkhrm> ScalarRef はあんまつかわんけどw
12:25:07 kazuho> fetchall_arrayref がないと生きていけないw
12:25:15 tkhrm> いや、bless する場合、で
12:25:25 kazuho> あーtskn
12:25:43 karupanerura< デメリットはDumpしてもよく分からなくて死ぬくらいの事しか分からなかったですが、継承とかメンテナンス
性とか考えるとなるほどいらない子ですね
12:26:16 tkhrm> なんかそのへん、ちゃんとどこかにまとまってるんだけど
12:26:33 tkhrm> PBP あたりにのってるのかな
12:26:55 tkhrm> ないかもw
12:27:27 tkhrm> あと、このへんトゥギャっておいてくれると再度おなじ解説しなくてすむのでだれか!

事の発端は（たぶん）Class::Accessor::Listだというのは秘密。
というわけでClass::Accessor::Liteというかblessed hashref使いましょう！

間接オブジェクト記法の怪

perl 怖い話

怖い話

友人がこんなコードがうまく動かなくてハマっていました。


擬似コード

use strict;
use warnings;

# ...

sub hogemethod {
    # ...

    try {
        A;
    }
    catch {
        die $_;
#(comment out)        # ...
    };

    # ...
}

# ...

1;

このコードはtryの中で死ぬかもしれない処理Aをして、catchでエラーを受け取ってそのままdieする処理に見えます。
しかし、実際はtryを実行し終わったあと、catchも実行されてしまいます。


tryの中の処理が成功した場合はcatchは実行されない筈ですよね？
なぜ実行されてしまうのでしょうか。


答えは、Try::Tinyをuseしてなかったからです。


「じゃあ当たり前じゃん」と思った人はそのままブラウザバックするか、こんな時間にこんな記事読んでないで寝ると良いでしょう。
「なんで実行されるの。なにそれこわい。」と思った人は続きを読みましょう。

そのとき歴史が動いた

間接オブジェクト記法

突然ですが、Perlには間接オブジェクト記法というものがあります。
間接オブジェクト記法とは、あれです。あれ。

use MyClass;

# この記法です
my $text = get_text MyClass; # MyClass->get_text と等価

ちなみに、間接オブジェクト記法で、引数を渡すときは以下のようにします。

use MyClass;

# この記法です
my $text = get_text MyClass('Hoge', 'Fuga'); # MyClass->get_text('Hoge', 'Fuga') と等価

さらに、この間接オブジェクト記法はblessされたオブジェクトなどでも使う事ができます。

use MyClass;

# この記法です
my $obj  = new MyClass;
my $text = get_text $obj; # $obj->get_text と等価

さて、ここで、$objからcloneメソッドを呼んでもう一つMyClassオブジェクトを作り、
そのオブジェクトからget_textメソッドを呼んでみましょう。

use MyClass;

# この記法です
my $obj  = new MyClass;
my $text = get_text $obj->clone; # $obj->clone->get_text と等価？

おや、等価の後にクエッションマークが付いていますね。
答えを言ってしまえばこれは $obj->clone->get_text とは等価になりません。
正解は以下です。

use MyClass;

# この記法です
my $obj  = new MyClass;
my $text = get_text $obj->clone; # 本当は $obj->get_text->clone と等価

「じゃあ、変数に一度入れて渡すしかないじゃん。」と思ったあなた。
そんなあなたのためにPerlにはこんな方法も用意されています。

use MyClass;

# この記法です
my $obj  = new MyClass;
my $text = get_text { $obj->clone }; # $obj->clone->get_text と等価

よし。これで $obj->clone->get_text と等価になりました。めでたしめでたしですね。
あれ、こんなのどこかで見た事ありますね。

そうなんです

そうなんです。
try {} catch {};構文はそのまま書くと間接オブジェクト記法として解釈されてしまうんです。

use MyClass;

# この記法です
my $obj  = new MyClass;
my $text = try { $obj->clone }; # $obj->clone->try と等価

このコードは以下のように解釈されます。
（B::Deparseを活用するとPerlコードがどのようにPerlコンパイラに解釈されたかを知る事ができます）

use MyClass;
use warnings;
use strict 'refs';
my $obj = 'MyClass'->new;
my $text = do {
    $obj->clone
}->try;

ちなみに、Try::Tinyをuseした場合は以下のようになります。

use MyClass;
use Try::Tiny;
use warnings;
use strict 'refs';
my $obj = 'MyClass'->new;
my $text = try(sub {
    $obj->clone;
}
);

これは、Try::TinyからExportされたtryサブルーチンがプロトタイプ宣言を使ってCODEリファレンスを受け取るようにしている為、
このように解釈されるのです。


全然意味が違って来ますね！


なので、「おかしい！どこもおかしくない！」と思ったときは間接オブジェクト記法も疑ってみては如何でしょうか。
以上、間接オブジェクト記法怖いというお話でした。

初YAPCで初LTしてきました

perl yapc

YAPC::Asiaってなに＿

今日はYAPC::Asiaでした。
YAPC::Asiaは技術的なトークを中心としたカンファレンスです。
Rubyで言うRuby会議みたいなものでしょうか。（行ったこと無いですが）


YAPC自体は世界中で行われていて、今回はそのアジア版という位置づけみたいです。
海外からのゲストスピーカーの方も多数いらっしゃいました。


YAPC::Asia今日もやるので興味のある方はぜひ！

感想

見ていたトークの感想はだいたいTwitteにつぶやいていたので幾つか抜粋してまとめてみました。

  • 今後のPerl: 互換性をあまり意識せずに最新の機能を使ってプログラミング出来るようになる。凄い。
  • Carton: 開発しているタイミングで依存しているモジュールとそのバージョンをコアモジュールかどうかを開発者が意識する事なく管理出来る。凄い。
  • はてな: JavaScriptフリーで本当に大丈夫なのだろうか・・・。
  • スイーツエリアで殆どみんな無言のなか、ももクロが流れていてまじシュール。
  • IDC移行: サービスを停止せずに違うネットワーク間を如何に移行するか。OpenVSNでVPNを貼った上で様々な工夫を凝らして問題を解決していた。凄い。
  • Mゲー: やはりユーザー数の多いサービスは大変な模様。しかしあえて一時的にレプリケーションを止めるなど様々な工夫を凝らして問題を解決していた。凄い。

LT

LTもして来ました。スライドはこちら
外で一人で脳内プレゼンリハしてたら、何やら @kfly8 君から電話が。

kfly8「プロジェクターの接続テストで呼ばれてるぞ！」
僕「えっ！そんなのやるの！」

となって慌てて最前列に向かう。（考えてみたらやるのは当然ですが）

  • 開始直前に接続テスト！が、動かない・・・・ッ！
  • しかもMBPもフリーズしてしまった！何が起こったのかとあわあわ。（この時点でだいぶ動揺してる）
  • 別室で試させて貰うが同様の現象。更に慌てる。このままではLTが出来ない！
  • 運営の方（すみません、名前は失念してしまいました）にPCをお借り出来る事に！（本当にありがとうございました）
  • どうやらMBPとプロジェクタをつなぐ奴がイカレてるらしい事に気付く。
  • 本番の所には運営が用意してくれた同じモノがあるが、本番ぶっつけで接続勝負するとかエンジニア的に無いだろうという事でやめる。
  • 順番が来たのでいざ登壇。
    • 人めっちゃいる！めっちゃいる！！
  • 落ち着け俺。2のn乗を数えて落ち着くんだ！
  • 操作ミスであわあわ
    • 今のでだいぶ時間無駄にしたんじゃね？ドキドキ
  • 時間のプレッシャーに負けて緊張しまくり。
    • 時間やばくね？時間やばくね？


オチを言おうとしたらドラでオチがつきました。

反省

  • 接続テストは早めに。
  • 時間をあえて意識しない。
  • スライド数は少なめに（調整しやすいので）
  • もっと場数を踏む。練習する。

で、LTで結局何を喋ったの？

Class::VirturlAccessorという勢いだけで作った小物モジュールの紹介でした。
アクセサのよくある問題点を解決出来る感じです。
中では大した事はやってないのでモジュールにするまでもないかもですが。


こんな感じで使います。

package Hoge;
use strict;
use warnings;
use parent qw/Fuga/;
use Class::VirturlAccessor (# Class::Accessor::Lite like interface
    ro => [qw/hoge fuga/],
    rw => [qw/foo/],
    disable => ($ENV{PLACK_ENV} eq 'deployment'), # If this is true value, access control disable. But fast!
);

sub new {
    my $class = shift;

    $class->SUPER::new(@_)->with_vaccessor;
}

sub some_method {
    my $self = shift;

    $self->{hoge} = 'some value'; # this is read only valiable! croak!
    $self->{fpp}  = 'some value'; # this is typo! croak!

    return $self->{hoge};         # this is ok!
}


これはクラスにblessされたhashrefに読み書きの制約条件を付けて、かつ存在しないキーにアクセスしようとした場合はtypoと見なして死んでくれる、
しかしVariable::Magicでhookしているので遅いので、本番環境では無効にする事も出来る。
という機能を持ったモジュールです。
Class::Accessor::Liteとかとも併用出来るので、Variable::Magicが嫌いで無ければぜひ使ってみてください！


でも次はもうちょっとまともなプレゼン出来るように頑張ります＞＜
来年リベンジします！宜しくお願い致します！

IO::KQueueでディレクトリとファイルを監視する

Perl FreeBSD

経緯とかなんか

Filesys::Notify::SimpleとかAnyEvent::Filesys::NotifyとかがKQueueに対応していないので自分で書くことにしました。
そのうちこれらのライブラリをKQueueに対応させてpull req送ろうと思います。


AnyEvent::Filesys::NotifyはMoose使ってるっぽいのでRoleだけ書いてそのうちCPANに上げられたら良いなぁ。
と思ってリポジトリだけ作っておきました。
https://github.com/karupanerura/p5-AnyEvent-Filesys-Notify-Role-KQueue


やっつけで書いたコードは以下。


これ何やってるの？

ファイルやディレクトリを「ファイルとして開いて」（これが気持ち悪い）そのファイルディスクリプタをKQueueに渡してあげて監視してます。

sub add_dir {
    my($self, $dir) = @_;

    $self->{_files}{$dir} = do {
        my $fh = IO::File->new($dir, 'r') or die("Can't open '$dir': $!");
        die "Can't get fileno '$dir'" unless defined $fh->fileno;

        # add to watch
        $self->kqueue->EV_SET(
            $fh->fileno,
            EVFILT_VNODE,
            EV_ADD | EV_CLEAR,
            NOTE_DELETE | NOTE_WRITE | NOTE_RENAME | NOTE_REVOKE,
            0,
            $dir,
        );

        $fh;
    };

    find(+{
        wanted => sub { $self->add($File::Find::name) },
        no_chdir => 1,
    }, $dir);
}

ディレクトリをファイルとして開いています。気持ち悪いですね。
ディレクトリ開いたらファイルディスクリプタとかねーじゃん！とか思ってハマりました。