YappoLogs

PHPの関数と同等の実装をPerlでどう書くリファレンスプロジェクト開始のお知らせ

ふとしたきっかけでPHPのリファレンスマニュアルにある関数と同等の機能をPerlで実装するにはどうするか?といったリファレンスを作るプロジェクトを始めました。

PHP使いの人がPerlを弄る時に「PHPのこれPerlでどうやれば良いんだ！」といった要望や、ごく普通のPerl使いの人が「これどうやって書けば良いのかな?」って時に使うcookbook代わりに使える事を想定しています。

ドキュメント管理にはgithubhttp://github.com/yappo/docs-php-funcref-in-perlを使い、ドキュメントのビューワーとしてwikihubWikiHub :: php-funcref-in-perl :: READMEを使っています。

書いて欲しいと思った人にはあらかたコラボレータ入れてるので、ドキュメント充実させたいと思ったらすぐにprivate repoをcloneして書けると思います。「俺入って無いし書きたいよ！」って人が居たら言ってもらえればコラボレータ追加します。
別にforkしてpull requestでもいいんですが、面倒なんでコラボにぶっ込みたい所。

書き方などはREADMEを読んでください。

今のところ書いてる人はPerl側の人間が多いので、もしPHPな人で気になった人が居たら参加してもらったら嬉しいなーとは思う所。なんかそのほうが完成度高くなりそう。

この形に落ち着くまでcodereposにしたりnim+perl-usersとか色々やってたんですが、miyagawa伝説とwikihubでの見た目が奇麗とsyntax highlightした時の組み込み関数にphp.netやperldoc.perl.org等にリンクされて便利ってのがwikihub採用の決め手でした。

とりあえず環境もろもろはいつも通り僕が用意したんですが、4000を越えるPHPの関数群のテンプレートファイルをyusukebeが用意してくれました。

ってことでどうぞよろしくです。

kumofs での Data::Model の使い方

スケート頑張りすぎて足首が痛いYappoですみなさまウインタースポーチュしてますか?

本日kumofsが公開されたので、折角なので Data::Model から kumofs を実際にどうつかっているかを紹介しようかとおもいます。

kumofs については 分散Key-Valueストア「kumofs」を公開しました！ - 古橋貞之の日記 を Data::Model::Driver::Memcached については dann さんによる Data::Model::Driver::Memcachedで超効率データ保存 - JPerl Advent Calendar 2009 を別途参照すると良いでしょう。

スキーマ定義

では実際に kumofs をつかった場合のスキーマ定義を下記に貼ります。
ちなみに、それらしいような定義をしてますが全部フィクションです。本当に。

解説 その1

Data::Model::Driver::Memcached のインスタンスを作る所で、 Cache::Memcached::Fast のインスタンスを指定する所で、3つのオプションを渡しています。

一つ目が、 serializer => 'Default', で、 Cache::Memcached 標準の直列化手段をつかわずに Data::Model::Driver::Memcached 標準の直列化手段を利用します。
即ち MessagePack を使った直列化を施します。 Data::Model で必要な MessagePack のコードは Pure Perl で内部的に実装されているのですが、実用的にするには Data::MessagePack をインストールしておくと、そっちを使って高速に直列化してくれます。

二つ目は、strip_keys => 1, です。
通常の方法だと、 primary key も KVS の Value として直列化してストレージに格納しようとするのですが、 KVS だったら既に Key のほうに値が入っているべきで、この重複が無駄なので削除して直列化します。
例えば、上記のコードを使った場合に以下のようなデータ構造だった場合に

{
    file_id    => 'dankogai',
    media_type  => 1,
    client_type => 5,
    is_broken   => undef,
},

{
    media_type  => 1,
    client_type => 5,
    is_broken   => undef,
},

三つ目としては ignore_undef_value です。
これは何をする物かと言うと、カラムの値が undef だった場合は、その項目を DELETE してから直列化します。
そして lookup などで kumofs から Data::Model の Row オブジェクトに戻す時点で、直列化されてるデータにカラムのデータが無ければ value が undef だったと解釈をして復元するのです。
今回の例では、画像が壊れてた時だけ kumofs のストレージサイズが増加します。
上ので書いたデータ例に適用すると下記の用に is_broken が削除されて kumofs に格納されます。

{
    media_type  => 1,
    client_type => 5,
},

ユースケースとしては、稀にフラグを立てる必要があるんだけど、フラグ立って無いレコードに対してもディスク容量を消費するのが嫌だ！という時に使えます。
SQL だと、別途 file_broken 的なテーブルを作って JOIN すれば済む話でしょう。
あいにく kumofs では JOIN 出来ないので、このような時は別の Key-value にデータを突っ込まないといけません。
そうすると GET する時のクエリの数が倍になったりするのでトレードオフしてどっちにするか選ばなきゃいけなくなるんですが、 ignore_undef_value を使っとけば、必要な時に必要なだけストレージを使いつつ GET する時のクエリ数も増えないので良い感じになるんです。

細かいこと言うと SQL で別テーブル使って JOIN するよりかは空間効率やらなんやらは良いと思うすけど。特に比較検証してないんでこれ以上はやめとくす。

解説 その2

今度は model 定義部分をみてみましょう。ポイントは二つあります。

一つ目は schema_options model_name_realname => 'f_m'; です。
これは、 memcached protocol の key の所に入れる model namespace を短縮するのに使います。
例えば key=file_id が 'dankogai' だとして、 schema_options model_name_realname が指定されてない場合は、このコード例では

kumofsfile_meta:dankogai

kumofsf_m:dankogai

二つ目は schema_options column_name_rename の所です。
これは直列化する直前で Key を任意の値に変換してから直列化をかけます。
Data::Model 標準のシリアライザの MessagePack では、数値をとても効率よく直列化してくれるので、 media_type だとかいう長ったらしい key name を 2 とか言う数値に変換してしまいます。
2 とかという小さい値だと直列化後も1バイトしか容量食わなくて嬉しいんです！

実際、上のほうで書いてるデータ例だと以下の用になります。

{
    2 => 1,
    3 => 5,
},

MessagePack の specをみても解るとおり、15要素以下の HASH に1バイト、 7bit 以下の unsigned int では1バイトの容量しかかからないので、上記の圧縮後の value は5バイトという驚異的なサイズとなって kumofs の value に格納されます。

まとめ

今日は kumofs 公開したということで、 Data::Model からだったらどう使えるか、どう使うかという視点で書いてみました。
Data::Model 側で用意してるオプションを使い切る事により、プログラムコードは書き易く、かつ空間効率を驚異的に高めて利用出来る事が解ったかと思います。
もちろん Data::Model::Driver::Mecached は kumofs 専用という訳でなく Tokyo Tyrant やらなんやらでも利用できますので、機会があればお試しください。

まぁ、もちろんこんなレイヤ介さずに直接使えばいいって話も出てきそうですがね。

あわせて読みたい：YappoLogs: KVSでORマッパーを使うという事

Mooseを使うべきでない理由とMooseを使う理由

twitterにでも書いて終りにしようと思ったけど140文字じゃ無理なんで。
Mooseの欠点やら利点やらMouseがどうだとかは今更感過ぎて割愛するし、下手な抽象的な表現も面倒なんでしない。

Mooseを使うべきでない理由

あなたが、再利用性の高いライブラリを作りたい場合はMooseを使うべきではない。
なぜならMooseはフレームワークだからであるからだ。
たとえ有用な再利用性の高いライブラリを作ったとしても、Mooseというフレームワークに依存してしまっては、あなたの有用なライブラリを選択してもらえない事もあるだろう。
誰かが小さいスクリプトを書くために、あなたが書いた有用なライブラリを使う事で楽が出来るとする、だがMooseというフレームワークに依存したばっかりに、その有用なライブラリの後ろに控えるものの大きさに臆して選択してくれないかもしれない。

もちろんMooseを使わなければ生産性が格段に落ちるだろう。メンテナンスも大変になるだろう。Mooseを使わないことによるペナルティの代わりに誰からも利用されるライブラリの作者になれると言うことだ。素敵だろ。

Mooseを使う理由

じゃぁCPANへ上げるライブラリはMooseを使うなってことか?いいや違う。
何度も言うがMooseは生産性を恐ろしく高める、だがしかし再利用性の高いライブラリでは使うべきでないと言っただけだ。
例えば App::* 名前空間のコードでは積極的に使っても良いだろう、Catalystだってそうだ。
え?Catalystは再利用性の高いライブラリじゃないか!だって?いいや、Catalystはとても有用なフレームワークだ。Catalystの中だけで世界が閉じているのだ。

総論

そう、Mooseを使う場面と使わない場面と言うのは、書こうとしているコードがそのコードの世界で閉じたものなのか、または閉じないものなのか。そういった基準を見るという視点があると良いのではないだろうか。
例えばDBICなんかは閉じた世界でないのでMooseに依存するべきでは無い。
たとえばDBI.pmがMooseに依存してたらどうする?
HTTP::Engineは?うーん微妙だ。
Plack何かは閉じた世界では無いので使うべきでは無い。
じゃぁFeyはどうだ、、、、うーんMooseをたくさん使うという世界に閉じた中で使うと言う点ではありなんじゃないか?

繰り返すがMooseを使わないべきとは言っていない。良く考えて使うべきだと言っているのだ。

Plack::Middleware::Debug のアイコンをどかす Middleware

Plack処女喪失したての金曜日の天使ですおげんきですか。

Plack::Middleware::Debug を使って Debug のメニューを消したときって

みたくなってなんか邪魔なので、端っこにどかすCSSを適用するMiddleware書いてみた。

やりたい事としては、アプリとは関係ないファイルの管理をしないで PM::Debug のcssだけを置換して使いたいって事。
Plack::Middleware::Debug は、必要なjsやらcssをshareディレクトリ以下に入れて自分の好きなように書き換えて使えるんですが、それやるとアプリ以外にファイル管理しなきゃいけないので面倒なのでやりたくないというワケ。

上のコードを app.psgi に入れとくと

な感じになってくれました。
とりあえず目的は達成。

この

builder{
    enable {
        my $app = shift;
        sub { $app->(@_) };
    };
    sub {};
};

< miyagawa> middleware でいいですよ

Golang の interface type 風味の duck type する関数を作る Object::InterfaceType っての作った

だいぶ前に作って放置してたんですが、そこそこCPANに上げられる感じにはしてあったので年末の倉庫整理をかねて CPAN にあげました。 http://github.com/yappo/p5-Object-InterfaceType

Goではクラス定義で云々するんじゃなくて、interfaceで定義されてるメソッド群をすべて実装されてたらOKといった感じなんですが、まぁいわゆるduck typingできればおｋみたいな感じですね。

Perlの世界では if ($foo->can('bar') && $foo->can('baz')) みたいなコードで duck type可能かを調べるんですが、見た目がごちゃごちゃしがちになるので、Goのinterface type的な感じのものをPerlの世界に持ってきました。

if ($obj->can('read') && $obj->can('seek')  && $obj->can('close')) {

if ((interface_type [qw/ read seek close /])->($obj)) {

my $is_filehandle = interface_type [qw/ read seek close /];
if ($is_filehandle->($obj)) {

interface_type filehandle =>[qw/ read seek close /];
if (is_filehandle($obj)) {

canばっかり呼ばれてるコードって見たこと無いのですが、そういうコードはすっきりとかけるようになるんじゃないでしょうか。

コンセプトは夢の中で思いついて起きて1時間くらいで実装した。

ajax/javascriptテスト環境の JSTAPd を CPAN にあげました

ちょっと前のacotiethoneの時にlestrrat++さんがドキュメントを英訳してくださったのでCPANにアップロードしました。

http://search.cpan.org/dist/JSTAPd/

それなりに頑張って日本語でもドキュメント書いたので、lestrratさんが気に留めて使う気になって英訳してくださったんだとおもいます。
おかげでCPANへリリースすることもできました。

テストも重要ですがドキュメントも重要ですね。

Module::Requires について hacker track last day を書きました

依存モジュールの管理を実際のコード内で行う為にあったら便利そうなモジュールを思いついたので思いつきのまま CPAN にアップロードして advent calendar に書きました。

http://perl-users.jp/articles/advent-calendar/2009/hacker/25.html

たぶん、 advent calendar で紹介されたモジュールの中で一番新米なんじゃないかと思います。

あとは casual track が完走すれば JPerl Advent Calendar 2009 は全部完走となります。

今から寿司がたのしみです＾＾

あなたがData::Modelを使う10の理由

前口上

一昨年書いた『あなたがRuby on Railsを使わない10の理由』を書いたら、おおむね好評とともに読んでもらえたみたいで(ほんとかー?)うれしい限り。実際あのあとも記事の影響ってわけじゃないと思うけどRoR使ってくれた人もたくさんいるし、ますます広まってきているみたいでこれも私設営業の人としてはとてもうれしい。

略
(例によって書きかけなので今後もいろいろ変わったりするかも)

Data::ModelはCPAN Moduleである

まあ上でああいったけどやはりCPAN Moduleであることそのものの価値ということにまずは言及しておく。
いまのPerlはまぎれもないCPAN Moduleベースの言語なのだ。それ自体は実のところ単なる偶然の産物なんだけど。でもさまざまに紆余曲折あってCPAN Moduleベースになったおかげで、Perlが得た恩恵はとても大きい。
Perlはその根幹はCPAN Moduleであるということは、CPAN Moduleの四半世紀の歴史がはぐくんできた膨大な蓄積をPerlも同様に備えているということだ。おかげでプログラマだったらPerlがどんな挙動をするかというのはだいたい想像がつくわけ。

Data::ModelはiPodと相性がいい

この項、あとで書く

いまData::Modelを使い始めると世界で三番目にヘビーなData::Modelユーザになれる

あなたが何かの分野で世界第三位の位置に立つことを考えて欲しい。思った以上に道のりが険しいという事が誰でも想像がつくであろう。
しかし、そんなただの人が世界で三番目の位置に立てる分野がある。そうData::Modelのユーザとしてなら世界第三位のヘビーユーザーになれるチャンスがあるのだ。
現在Data::ModelのヘビーユーザはYappoとtokuhiromしか居ない。ここにあなたの名前が連ねるのだ。
どうだい魅力的ではないか?

え、DBIx::Skinnyがいいって?ありゃ駄目だ。nekokakを始めとしてモバイルファクトリーの全社員が使ってい。あなたはモバイルファクトリーの社員数を数えられるか?
それにyusukebeやnekoyaやnihenやnobuなんとかやmixiの連中まで唾をつけてやがる。
そんな手垢のついたものばっかり使ってるから君は世界三位の位置にいつまでたってもつけないんだよ。

それが、Data::Modelを使えばチャンスが巡ってくる。どうだい?簡単だろう。
それに今ならAdvent Calendar期間中で使い方のドキュメントが揃って来てるしね。
http://perl-users.jp/articles/advent-calendar/2009/data-model/

以下蛇足

この記事を書いている私はもともとCDBIファンだったんだけど、いまのData::Modelは古き良きCDBIが持っていたcultureと、DBICが持っていたcultureの両方を備えたこれ以上はないほど魅力的なORMになっている。ある意味、CDBIよりもCDBIらしいと思う。この業界の先端を走っている人全員ではないけれど、かなり多くの人はData::Modelを使っているし、これからますます増えてくると思う。

JPerl Advent Calendar hacker track で Module::Setup の事書いたよ

ガイアックスさんのご好意で会場提供された hackathone の成果として Module::Setup 0.07 を shipit する事ができたので、当日担当だった Advent Calendar に Module::Setup の紹介と新要素紹介を行いました。
Module::Setup でらくらくモジュール作成 - JPerl Advent Calendar 2009

実に14月ぶりくらいのメジャーリリースで、様々な機能が追加されています。
おもに flavor 開発者にとって便利な物が大量投入されてます。

他にも Ark などの helper script をより便利に作れる Helper support 機能が投入されてます。

一般向けとしては XS flavor が追加されており、多分 id:gfx がよりモダンな flavor にしてくれることでしょう。

そしてようやく GitHub flavor も投入されました。スケルトン作るときに GitHub のリポジトリセットしたり git remote の設定を自動でやってくれたりします。
お望みとあれば、出来立てのスケルトンをそのまま git push してくれますがそんな変態はいないでしょうか。

ということで Module::Setup をご利用ください。

ガイアックス++

# 最初は本気で東小金井に行きかけたのはないしょのつぼみ

goo.gl の API を叩いて goo.gl のショートURLを作る WWW::Shorten::Google ってモジュールかいた

http://goo.gl/ ってのが巷では始まっていますが、まだ勝手に tinyurl を作れないようなので
簡単に http://goo.gl/hoge な tinyurl を作る WWW::Shorten::Google ってモジュールを書きました。

http://github.com/yappo/p5-WWW-Shorten-Google

CPAN には、各種 tinyurl を使って url を短くするための統一インタフェイスとして WWW::Shorten ってのがあるので、それの流儀にしたがって作りました。

JPerl Advent Calendar 2009 はじまりました

という事で始まりました。
http://perl-users.jp/articles/advent-calendar/2009/
gfxさんがまとめてくれたPerl界隈のAdvent Calendarの便利リンク集も有るので便利です！

今回はトラックが二つに別れた事の他にDBIx::SkinnyとData::Modelのトラックが出来てるのに気づくかと思います。
これは、本来予定されていたものでは無くて、今回のJPerl Advent Calendar 2009は結構便利に書ける仕組みだったので、便乗して開始したといういきさつです。
Advent Calendar書く為の準備をする必要が特にないので参入障壁が低いと言う事ですね。

何が言いたいかというと、もし何かのテーマでPerl Advent Calendarをやってみたい！って人は気軽に始めると良いですよ。という事。

$ git clone http://git.coderepos.org/share/websites/jperl-advent-calendar-2009.git/
$ cd jperl-advent-calendar-2009
$ cp -r data/data-model data/anatano-track
# data/anatano-track の中のファイルを諸々書き換える
# s/data-model/anatano-track/ みたいな事とか
# trackの名前変えたりとか
$ $EDITOR data/anatano-track/\d+.txt して、内容書く
$ git add data/anatano-track
# 必要だったら .nim とか data/index.html とか data/base.html も追加しとくと良いよ
$ git push

その他

本当は今回GitHub Pagesを使うとかいう話があったんですが、コラボレータ追加作業が面倒という事で特に手間がないCodeRepos使うと言う話になった。
あとnimいいですね、全トラックのRSSをまとめたRSSとか作るのもPlagger使わないでnimだけで作れる。

Data::Model Advent Calendar

YAPC 2009 (Yet Anther jPerl advent Calendar 2009) という事で、Data::Mode用のトラックを作りました。

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

あまりにも文書としてまとまってない Data::Model のドキュメントを増やすチャンスですね！
ちなみに全部書ききったら、別途kanさんに寿司奢ってもらうつもりです。

Ajax アプリ等の為の JavaScript コードのテストツール JSTAPd を作ってるよ

Data::ObjectDriverをDISってる人の話題が三周目に突入した今日この頃ですが皆さんは何をDISってますか?Yappoです。

JavaScript にもテストツールが色々とあると思うんですが、 Ajax アプリの XHR リクエストとかも含めてラクチンにテストできるツールが見つからなかったので JSTAPd というツールを作りました。

http://github.com/yappo/JSTAPd

名前の通りテスト結果はTAPで出力してるのでproveコマンドとかを使ってPerlの作法でテストできます。
ブラウザの連携の設定をすれば prove -v foo/hoge.t とかをコマンドで打ち込めば勝手にブラウザ立ち上げてテストコード実行してブラウザ閉じて結果をコンソールに吐いてくれます。
もちろんデーモンとして常駐化できるので複数のOS&ブラウザを使って自動的にテストするなんて構成も取れるでしょう。

1テスト1ファイルにまとめて書く事が出来て、実際にテストに関係するJavaScript, HTML, Server APIのコードを書くだけですむようになっています。
JSコードのテストを細かくサクサク量産できる事を目標にしてます。

文章で説明を呼んでもいまいちピンと来ないと思いますので、実際にJSTAPdを使っている所のデモンストレーション動画を撮ったのでご覧下さい。

あと、日本語でチュートリアルも作ったので細かい内容についてはそっちを参照してください。
http://yappo.github.com/JSTAPd/tutorial/ja.html

文法エラーとか補足しきれなかったりまだまだ細かい所がかゆいんですが徐々にまともにしてくつもりなので乞うご期待。

Makefile polyglot (make And perl Makefile)

Careless you doing "perl Makefile", then you take many error messages.
Your trouble will be solved if the polyglot technology is used.

# Example Makefile
irst_labe: length
X;$Y=Z;
dummy_label: length
        0;
        print "perl world\n";
        $x = <<'END_OF_MAKEFILE='
length:
        echo "make world"

END_OF_MAKEFILE=

$ perl Makefile 
perl world

$ make
echo "make world"
make world

Makefile is processible into Makefile.PL polyglot by perl code shown below.

perl Makefile.PLをperl Makefileと打ち込まんでエラーメッセージを出しちゃうドジっ娘さんは沢山いらっしゃるとおもいます。
そんな悩みを解決すべくperl Makefileと打ち込んでもexec $^X, 'Makefile.PL'を実行してくれるMakefileのsnipetを作りました。

規則名をlabelとして扱わせて、その次にperlの構文のlengthをぶち込み、セミコロン必要な所は何故かGNU makeでX;$Y=Z;が通ったので、それでごまかしてlengthの規則名を定義してmakeで実行させる規則を作りつつ。perlで実行された時にはlengthの規則の定義部分は$xにぶち込まれるようにしてあるという具合です。(説明めんどう

ExtUtils::MakeMakerにパッチあてれば良い感じになりますか?

GNU Make 3.81 で確認済み

thanks to tokuhirom and takesako

AUTOLOAD is so crazy

it is useful to what? i don't know.

my $path = 'foo/bar/baz'; Class->$path

HTTP::Engine 0.03001 has streaming response now / multipart/mixedなストリームをHTTP::Engine/Plackでpushする

thanks many ideas from yusukebe, mattn, miyagawa.
I created a streaming response support for HTTP::Engine. it was a too easy hack.
example here

[ゆ]: multipart/mixedなストリームをPlack/PSGIでpushする みて、HTTP::Engineの上で動くかと思ったけど全然動かなかったので、HTTP::Engine側で対応して動くようにしました。
http://github.com/yappo/fast-twitter-stream

IO::Handle::Utilで作った$fhをHTTP::Engine::Response->new( body => io_from_getline sub {} )しただけだと、Content-Lengthが無いとエラーになってしまってbackend interfaceに渡せなかったんですね。
なんで、PSGIみたくバックエンド側でストリーミング的なコンテンツが扱えるinterfaceの時はContent-Length無しでも通るようにしました。

で、出来たのが以下のコードです。オリジナルと殆ど同じです。

use strict;
use warnings;

package FastTwitterStream;
use Coro;
use Coro::Channel;
use Coro::AnyEvent;
use AnyEvent::Twitter::Stream;
use HTTP::Engine::Response;
use IO::Handle::Util qw(io_from_getline);
use Encode;

my $username = $ENV{TWITTER_USERNAME};
my $password = $ENV{TWITTER_PASSWORD};
my $boundary = '|||';

my $streamer;
my %queue;
my $count = 0;
sub request_handler {
    my $req = shift;

    if ( $req->path eq '/push' ) {
        my $now = ++$count;
        $queue{$count} = Coro::Channel->new;
        $streamer ||= AnyEvent::Twitter::Stream->new(
            username => $username,
            password => $password,
            method   => 'filter',
            track => 'twitter',
            on_tweet => sub {
                $_->put(@_) for values %queue;
            },
        );
        my $body = io_from_getline sub {
            my $tweet = $queue{$now}->get;
            if( $tweet->{text} ){
                return "--$boundary¥nContent-Type: text/html¥n" .
                    Encode::encode_utf8( $tweet->{text} );
            }else{
                return '';
            }
        };

        return HTTP::Engine::Response->new(
            headers => {
                'Content-Type' => qq{multipart/mixed; boundary="$boundary"},
            },
            body => $body,
        );
    }
    if ( $req->path eq '/' ) {
        return HTTP::Engine::Response->new( body => html() );
    }
};

sub html {
    my $html = <<'HTML';
<html><head>
<title>Server Push</title>
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.3.1/jquery.min.js"></script>
<script type="text/javascript" src="/js/DUI.js"></script>
<script type="text/javascript" src="/js/Stream.js"></script>
<script type="text/javascript">
$(function() {
var s = new DUI.Stream();
s.listen('text/html', function(payload) {
$('#content').prepend('<p>' + payload + '</p>');
});
s.load('/push');
});
</script>
</head>
<body>
<h1>Server Push</h1>
<div id="content"></div>
</body>
</html>
HTML
    return $html;
}

package main;
use HTTP::Engine;
use Plack::Builder;

my $engine; $engine = HTTP::Engine->new(
    interface => {
        module => 'PSGI',
        request_handler => ¥&FastTwitterStream::request_handler,
    },
);

builder {
    enable "Plack::Middleware::Static",
        path => qr{¥.(?:png|jpg|gif|css|txt|js)$},
            root => './static/';
    sub { $engine->run(@_) };
};

ブラウザから"http://localhost:8080/"にアクセスすると、もの凄い勢いでつぶやきが追加されていくのが分かるかと思います。しかも切断していないのでかなり高速です。

multipart/mixedとこのDiggライブラリの組み合わせ、いいですね。というわけで、元ネタになったyusukebeさん、Plackでpush配信の仕方を教えてくれたmiyagawaさんありがとうございました。
Enjoy!

HTTP::Engine meets PSGI

I shipped HTTP::Engine 0.03. Interface::PSGI is enclosed from this time.
async server became easy by PSGI.

use strict;
use warnings;

use HTTP::Engine;
use Plack::Loader;

my $he1    = HTTP::Engine->new(
    interface => {
        module => 'PSGI',
        request_handler => sub {
            HTTP::Engine::Response->new( body => 'plack 1' );
        },
    },
);
my $he2    = HTTP::Engine->new(
    interface => {
        module => 'PSGI',
        request_handler => sub {
            HTTP::Engine::Response->new( body => 'plach 2' );
        },
    },
);

Plack::Loader->load('AnyEvent', port => 18081)->register_service(sub { $he1->run(@_) });
Plack::Loader->load('AnyEvent', port => 18082)->register_service(sub { $he2->run(@_) });
AnyEvent->condvar->recv;

Interface::PSGI を同梱した HTTP::Engine 0.03 をリリースしました。
思う所があって、PSGI対応周り以外にももすこし機能追加しようかなという気分になってきました。

HTTP::Request::StreamingUpload - 省メモリでrequest bodyをupload

Today I created a good wrapper for request body upload HTTP::Request.
this module is use few memory on file upload. also too big file.

http://search.cpan.org/dist/HTTP-Request-StreamingUpload/
http://github.com/yappo/p5-HTTP-Request-StreamingUpload

DESCRIPTION

HTTP::Request::StreamingUpload is streaming upload wrapper for HTTP::Request. It could be alike when $DYNAMIC_FILE_UPLOAD of HTTP::Request::Common was used. However, it is works only for POST method with form-data. HTTP::Request::StreamingUpload works on the all HTTP methods. Of course, you can big file upload using few memory by this wrapper.

  my $req = HTTP::Request::StreamingUpload->new(
      PUT     => 'http://example.com/foo.cgi',
      path    => '/your/upload.jpg',
      headers => HTTP::Headers->new(
          'Content-Type'   => 'image/jpeg',
          'Content-Length' => -s '/your/upload.jpg',
      ),
  );
  my $res = LWP::UserAgent->new->request($req);

LWPとか使って大きなファイルアップロードするときは$HTTP::Request::Common::DYNAMIC_FILE_UPLOAD使ってアップロードするとメモリに優しくアップロードできるってのは有名ですが、あれってform-dataの時しかやってくれないので、例えばPUTメソッドでデッカいファイル送りたい時には使えません。

HTTP::Request->new( PUT => $uri, $headers, sub { read $fh, my $buf, 1978; $buf } )

HTTP::Request::StreamingUpload->new( PUT => $uri, headers => $headers, fh => $fh )

Content-Length を入れない場合は LWP::UserAgent の中で使ってる LWP::Protocol::http が chunked で送ってくれるので、予め送りたいサイズが解らない場合でも安心して使えます。

PSGI Implのsendfileについて

PSGIなServerはsendfileを扱う時にどうするかのメモ。

• $env->{'psgix.sendfile'}がセットされてれば、そこに書いてあるファイルパスを使う
• $res->[2]がGLOBだったら fileno($res->[2])して sendfile に fd を渡す
• $res->[2]->can('fileno') が生えてたら、$res->[2]->filenoからfdを取って使う
• $res->[2]->can('path') が生えてたら、$res->[2]->pathからファイルパスを取って使う

以上が、基本的なsendfileを使を行うときのパターンになる。
また、response headerにX-Sendfileなどの任意のヘッダが入っていて、その中にファイルパスが入っていれば、そのファイルパスを元にしてsendfileするのはServer実装者の自由である。
が、アプリの設定したヘッダはむやみに弄るべきではないので、後述するMiddleware等が設定したpsgix.sendfileを使うべき。だし、そもそも->pathとかをduck typeして取った方が奇麗だ。
というか、好き勝手にやればよい。と言うのがだいたいのsendfile扱うときの定石かな。

多分psgix.sendfileを最優先に使えば良いと思うけど。
たぶんMiddlewareがX-Sendfileなどをpsgix.sendfileに突っ込む等の方向性になるんじゃないか、まだ良くわかんない。

nginx embed perl は、今のところ $r->sendfile($path) しか提供されてなんだけど$r->sendfile_by_fd($res->[2]->fileno)とか出来るようにするつもりです。

AnyEvent で plagger-ircbot 的なのかいた

AneEvent二日目なので plagger irc bot的に使えるのを書いてみた。
http://github.com/yappo/perl-anyevent-irc-message-proxy

POEってのはIKCっていう便利なRPC的に便利に使えるのが有るんですが、まぁplagger irc bot的なのにはそんな大げさの物も要らないので、jsonでデータ送ったらその中身をirc serverにNOTICEで出してくれるのを書いてみた。
そもそもjsonにしなくても良いんだけど、jsonの中に発言したいchannelとか指定出来るように拡張する時とかのためですね。

このくらいだと別に直でAnyEventのコード書いても良い感じすなー
plaggerのそれとはコードも比べ物にならない程適当なんですが、似たような処理をAnyEventで書くとこんなにすっきりするんだなぁ。と思いましたですね。ハイ

AnyEvent はじめ

そろそろAnyEventでもやってみようと思ったので

AntEvent::Handle

いわゆるIOまわりの面倒を色々便利にやってくれる君。イベントベースなIOと言うよりかはevent queueなIOみたいな捉え方するとすんなり。
read/writeの処理はqueue的な感じで登録できるの。
->push_read() で、どんどんqueueにreadイベントを登録してく。fhがreadableになったらread queueがどんどん処理されるってわけ。
->unshift_read() だと、queueの先頭に突っ込んでく。
そう、まさしくperlのarrayへのpush/unshiftそのもの。AnyEvent::Introを読むとその辺の命名に関する思いが読める。
->push_write() だと、writeイベントを登録してく。writeできるようになるとどんどんfhにデータが送られる。
もしかしたらこれの対としてunshift_writeが出来るとか出来ないとか。

eventベースなのでpush_readとかしてもfhの都合考えないですぐにレスポンスが帰ってくる。
もしエラーとかタイムアウトをハンドリングしたければon_timeoutやらon_errorなどにハンドラ渡せ。

->on_drain() なんてのもある、排水溝。write bufferが空っぽになったら呼び出されるの。
空っぽの排水溝に汚物という名のdataをpush_writeしまくるか、汚物が無くなったらpush_shutdownしてsocketという排水溝を閉じてしまうかは好きにすれば良い。

こんだけ解ってればPlack::Impl::AnyEvent読むのは苦労しないよ。

つづく

YAPC::Asia 2009 発表資料など

まだ終わってないですが発表資料等。

1日目の Data::Model の資料は
http://yappo.ficia.com/pl/album/1E8DF4EE-9DB6-11DE-B1EE-7BD1A805B909

2日目の LT nginx に突いての資料は
http://yappo.ficia.com/pl/album/9509705E-9EAA-11DE-ADEA-3624873069EA

一応テキスト版を置いてあります。
http://github.com/yappo/talk-yapcasia2009/tree/master

なお LT で発表した nginx with memcached は
http://github.com/yappo/ngninx-ngx_http_memcachep_module/tree/master
にて。

Plack::Impl::Nginx に関しては
http://github.com/yappo/p5-Plack-Impl-Nginx/tree/master
nginx 本体にパッチいります

Yet Another Another Conference として、東工大の中の芝生で
1日目： MySQLカンファレンス
2日目： 画像配信サービスカンファレンス
が開催されました。
特に2日目は、無茶な呼び出しにも関わらずお集りいただきありがとうございました。

詳しい事は後で書く予定かも。。。。

写真等は
前夜祭http://yappo.ficia.com/pl/album/71902ED4-9D5F-11DE-AC2C-90D36E373816
1日目http://yappo.ficia.com/pl/album/BD7137E4-9DF0-11DE-8BEA-3624873069EA
2日目http://yappo.ficia.com/pl/album/850F7D50-9EAB-11DE-8946-7BD1A805B909
でみれます。

ハッカソンが終わって家に帰るまでYAPCなので、まだまだこれから。。。

PSGIの簡易ランチャー作ったよ

HTTP::Engineは、ちょっとした一枚スクリプトをサーバ化する便利な利用方法がありますが、それをPSGI実装向けにやってくれるアプリを昨日の帰りの電車の中で書きました。
http://github.com/yappo/App-Ksk/tree/master

使い方は簡単で、下記のようなスクリプトを書いて

package KskExample::Sample1;
use strict;
use warnings;

sub handler {
    my($class, $ksk, $req) = @_;

    my $body = qq{
<h1>Welcome To Ksk World.</h1>

you request uri is @{ [ $req->uri ] }.<br />
};
    my $res = $ksk->psgi_response_class->new({ status => 200, body => $body });
    $res->header( 'content-type' => 'text/html' );
    $res;
}

1;

もちろんPSGI実装は差し替え可能で次の用にするとAnyEventを使ってサーバを上げます。

package KskExample::AnyEvent;
use strict;
use warnings;

use Plack::Impl::AnyEvent;

sub ksk_init {
    +{
        psgi_setup => sub {
            my $handler = shift;

            my $ae1 = Plack::Impl::AnyEvent->new(port => 18081);
            $ae1->psgi_app($handler);
            $ae1->run;

            my $ae2 = Plack::Impl::AnyEvent->new(port => 18082);
            $ae2->psgi_app($handler);
            $ae2->run;
        },
        run_finalizer => sub {
            AnyEvent->condvar->recv;
        },
    };
}

sub handler {
    my($class, $ksk, $req) = @_;

    my $body = qq{
<h1>Welcome To Ksk World.</h1>

you request uri is @{ [ $req->uri ] }.<br />
};
    my $res = $ksk->psgi_response_class->new({ status => 200, body => $body });
    $res->header( 'content-type' => 'text/html' );
    $res;
}

1;

ちなみにrequest classとしてPlack::Requestを、response は Plack::Response を使っていますが、これも差し替え可能で

Another::Request->new($env);

my $psgi_res = Another::Response->finalize;

ついでにハンドラー周りのクラスも差し替えられるけどオマケです。

という事で快適なPSGIライフをお過ごしください。

とりあえず

PSGI自体がまだまだ流動的なので、落ち着くまでHTTP::Engine::Interface::PSGIを作ってお茶を濁す事にするよ。

PlackX::Request も HTTP::Engine のそれとは大きく違う感じになったし、そもそもMoose/Mouse/Any::Moose使わなくしちゃったし。

なんか流れ的にもHTTP::Engineはもう使わないでPSGI実装とかを使う流れにもなりそうなんで、あんまやりすぎても無駄な感じだから静観する方向で。

HTTP::Enginについて

昨日のHTTP::Engineは死なないよってのは間違いじゃないけど、プロジェクト的には老後生活に入る方向になってました。
仕様は PSGI になり、 Interface 実装は　PSGI 実装に、 Request の実装は PlackX::Request に移る方向性っぽいです。

具体的に言うと PSGI の実装を Interface レイヤで使って、Request部分を PlackX::Request を使うラッパーという形になります。

本来の HTTP::Engine も Interface の部分からデータを受け取って Request オブジェクトを作って、アプリケーションのコールバックを呼んで
アプリケーションから帰って来たResponseオブジェクトを受け取って、それをWebサーバに戻すんですが、これをこれから

PSGI実装からPSIGプロトコルのデータ受け取って、 PlackX::Request を extends した HTTP::Engine::Request でくるんでアプリケーションに渡して、アプリケーションは HTTP::Engine::Response で返すんで、それを PSGIプロトコルに変換してPSGI実装に返す感じになります。

本来のHTTP::Engineのコアとやる事はあまり変わり無いです。

PlackX::Request は、すでに HTTP::Engine を元にして作ってあります。
http://github.com/yappo/p5-PlackX-Request/tree/master

で、PSGIは仕様の名前であって実装は別になるので、エンドユーザはPSGI実装を自由に選ぶ感じになります。
最初の内はPlackを使って行く予定です。

HTTP::EngineとPSGI - HTTP::Engine is died?

HTTP::Engine は元々
・各種Webサーバに依存した処理がWAF毎に分散してるのをまとめたい！
・Request/Responseも共通化したい！
という所からスタートしたプロジェクトな訳ですが、今回PSGIが始まる事によって前段の部分をPSGIに委譲して、Req/Resの共通化は今まで通りありますよと言う話。

今回のPSGIは「HTTP::EngineのInterfaceのレイヤとReq/Resのレイヤが絡み付いてて良く無いんで、良い感じに分離したいよね」という所から始まった感じ。

結局はPSGIは仕様なので、それを実装するのはHTTP::Engineの内部になるかもしくはRack的な物を外に作ってやるかという事になるけど(後者の方向)、HTTP::Engineの内部でPSGIと既存のRequest/Response/handlerの吸収を行うので、利用者側からしたら意識する必要は無いです。

なにが良くなるかというとHTTP::Engineのデペロッパにとってのコードの見通しが良くなるのと、真の意味でのWSGIをPerlが手に入れるという事ですね。

利用者側の視点では、HTTP::EngineがPSGIの実装を選べると言うのも選択肢が広がって良いのではないでしょうか。
例えばmod_psgiとかいうapacheモジュールが出たとしたら、HTTP::Engineが直接mod_psgiと繋げるなんて事が出来る訳ですね。mod_perl強すぎで必要性あんま無いけど。

既存のHTTP::Engineを受け入れにくいプロジェクトでも、良さげなPSGI実装の上でアプリを書けるので嬉しい事も多いでしょう。

ここまで読んで頂ければ解りますが、表題の答えは No ですね。

HTTP::Engine は国産か否か

最近「国産のHTTP::Engine」のような文章を立て続けに見たので、HTTP::Engineは国産なのかどうかを考えてみたけどやっぱり国産じゃないんですよね。
そりゃディストリ作り出してメンテやりだしたのは日本人だけども、コードベースはCatalystだしMoose化の際にはnothingmuchの多大なる貢献があったし、大元のアイデアはPythonからの物だしで、そんなに国産と言う思いは無かったり。

だってさ、Pugsが台湾産だなんて言いかた聞かないでしょ?強いて言えばPerlコミュニティ産ってのがしっくりくるなという感じ。

中の人が日本語ばっかり使うから日本人が使うには気軽で良いという点くらいしかないんだけど、それって全体で見ると利点でなくて英語の情報が余りにも少なすぎてあんま良く無いなと思ってる所なんだけど、日本語ですらドキュメント書けてない困ったちゃん状態。

Ruby(以下省略

iPhotoは取り込んだ写真にExif追加します

eyefiで上げまくる生活をした後にiPhotoに残ってる古い写真も上げようと思ったらeyefiで上げ済みの写真も上がっててバビった今日この頃皆様いかがお過ごしでしょうか。

iPhotoに取り込まれた写真はExif情報を追加するといったことが一般的に知られていますが、実際にどんなデータが追加されてるかを見てみました。

材料：iPhoto通してない写真 1枚
iPhoto通した同じ写真 1枚
下記のスクリプト

use strict;
use warnings;
use Image::ExifTool ':Public';

my $eyefi  = ImageInfo(shift);
my $iphoto = ImageInfo(shift);

while (my($k, $v) = each %{ $eyefi }) {
    my $iphoto_v = delete $iphoto->{$k};
    my $is_changed = 0;
    if (ref($v) eq 'SCALAR') {
        if (ref($iphoto_v) eq 'SCALAR') {
            $is_changed = 1 unless $$v eq $$iphoto_v;
        } else {
            $is_changed = 1;
        }
    } elsif ($v ne $iphoto_v) {
        $is_changed = 1;
    }
    next unless $is_changed;

    printf "key: %s¥n  eyefi: %s¥n iphoto: %s¥n", $k, $v, $iphoto_v;
}

print "¥niPhoto's append data¥n";
while (my($k, $v) = each %{ $iphoto }) {
    printf " %s => %s¥n", $k, $v;
}

さぁ実行しましょう

key: FileName
  eyefi: eKHPjLGE3hGDx7EShzBp6g.jpg
 iphoto: DLQpgnuI3hGrj3qvqAW5CQ.jpg
key: FileModifyDate
  eyefi: 2009:08:09 15:54:57+09:00
 iphoto: 2009:08:14 11:38:11+09:00

iPhoto's append data
 CMMFlags => Not Embedded, Independent
 ConnectionSpaceIlluminant => 0.9642 1 0.82491
 ProfileCMMType => appl
 ProfileDescription => Camera RGB Profile
 ProfileID => 0
 DeviceModel => 
 GreenMatrixColumn => 0.35332 0.67441 0.09042
 ChromaticAdaptation => 1.04788 0.02292 -0.0502 0.02957 0.99049 -0.01706 -0.00923 0.01508 0.75165
 BlueTRC => SCALAR(0x8356ec)
 RedTRC => SCALAR(0x8d5f84)
 ProfileClass => Input Device Profile
 BlueMatrixColumn => 0.15662 0.08336 0.71953
 PrimaryPlatform => Apple Computer Inc.
 RedMatrixColumn => 0.45427 0.24263 0.01482
 ProfileDescriptionML => Camera RGB Profile
 ProfileVersion => 2.2.0
 RenderingIntent => Perceptual
 ProfileCreator => appl
 ProfileFileSignature => acsp
 DeviceManufacturer => appl
 ProfileCopyright => Copyright 2003 Apple Computer Inc., all rights reserved.
 ProfileDateTime => 2003:07:01 00:00:00
 GreenTRC => SCALAR(0x8d60c8)
 DeviceAttributes => Reflective, Glossy, Positive, Color
 ColorSpaceData => RGB 
 MediaWhitePoint => 0.95047 1 1.0891
 ProfileConnectionSpace => XYZ 

メタデータ変わったら違う画像になるのか、それとも画像自体が同じなら同じファイルなのかとかそういう話もありますが今日はこの辺で。

ちなみに元画像はここから落とせます

YAPC::Asia 2009 で「Key Value Store と ORM」について話します

このところ、MySQL と KVS と ORM 関連のエントリをいろいろ書いていますが、それは、スケールアウト可能で、かつ、インフラの人に怒られないアプリケーションを、今まさに作っている、という理由があるからです。

ただ、ブログエントリだとどうしても細切れになるので、一連のモジュールやプログラムを組み合わせて、どうやってスケールするインフラと繋げる部分を作るのかという話を YAPC::Asia 2009 でさせていただくことにしました。

YAPC::Asia 2009 は9月10日(木)と11日(金)の2日間、東京工業大学大岡山キャンパスで開催されます。今日からチケット販売も始まったので、興味のある方はお越しいただければ、と思います。

YAPC::Asia 2009
Key Value Store with O/R Mapper: YAPC::Asia 2009 - Sep 10-11 in Tokyo, JAPAN

【参考文献】
http://d.hatena.ne.jp/hirose31/20090807/1249611130

Data::Model with mysql's reconnection

DBD::mysql は mysqld との接続が切れたら自動的に繋ぎ直す機能があるのですが、 Data::Model の reuse_dbh 機能を作るにあたりとてもはまりました。というようなエントリの建設予定地です。

Tasks for my cpan module projects

The task which I have about cpan modules is as follows

HTTP::Engine

HTTP::Engine::Interface::AnyEvent is taken in. created by miyagawa.
async support for HTTP::Engine::Interface::POE. patches by miyagawa.

Data::Model

add Driver::PostgreSQL. patches by sfujiwara.
few relationship support.

Module::Setup

release to 0.07

The project into which I am putting power now.

KVSでORマッパーを使うという事

ケイレキ.jpの中でケイレキ.jpに招待して欲しい人を呼びかけても絶賛スルーされてるYappoです。さて今回は今巷で大人気のKey Value StorageでORマッパーを使う事についてお話するのじゃ。

一般的にORマッパーとはオブジェクトとリレーショナルデータベースをマッピングする為の仕組みの呼び名だと言うのは知られている所です。はい、そうするとKVSってのはハッシュデータベースであるわけなのでおかしいですね。今回の話はData::Model::Driver::Memcachedを使う事を前提としてるので問題が無いのです。なぜなら「data/object mapper」とか書いてあるから。

いわゆるPerlなORマッパーってのは行データをHASHで管理します。それはRDBが一般的に表形式でデータを管理しているからなんだと思います。なんでKVSをオブジェクトにマッピングするなら他の方法でも良いかもしれませんが、Data::Modelは異種ストレージでも同じインターフェィスで使えるようにする。例えば最初はSQLiteで動かすけどあとあとTokyoTyrantに乗せ替えるみたいな事をやる時にアプリケーションをほぼ変更無しで乗せ替えを可能にするといった事を考えて作ってあります。
厳密に言うとwhereとかindexとか使うクエリ使ってしまったら今のところ駄目ですけども。。。

本題に入るけども、先ほどリリースしたData::ModelからDriver::Memcachedを大幅に強化して各種KVSへデータを保存するのに有利な仕組みをいくつか追加しました。Driver::Memcachedはmemcached protocolに対応したサーバもしくは、Cache::Memcachedと互換なインターフェィスをストレージとして利用します。素のmemcached以外の物で使ってもらう事を考えてますが、データの生存期間に合わせてそのへんは選べば良いと思います。僕も特定のデータだったらmemcachedの方に突っ込んでるし。

テーブル名変換

Data::Modelはmemcachedのkeyにテーブルを含めます。
またinstall_modelでkeyとして定義されたkeyの値もふくまれます。
例えば「test_table」 という名前のテーブルで、keyに「1」があるレコードだとmemcachedのkeyとして「test_table:1」というkeyになります。

ただし、これだとtest_tableという名前は人間にはわかり易いけどスペース効率的によろしく無いケースもあるでしょう。
そういった時は

  install_model test_table => schema {
      schema_options model_name_realname => 't';
};

カラム名変換

これも、思想としてはテーブル名変換と同じで、memcachedのvalueにはカラム名を含むハッシュを保存するため、カラム名を短縮形式に変換すると省スペースになります。

  install_model simple => schema {
      schema_options model_name_realname => 's';
      key 'id';
      column 'id';
      column 'name';
      column 'nickname';
      schema_options column_name_rename => {
          id       => 1,
          name     => 2,
          nickname => 3,
      };
  };

key data strip

KVSはたいがい行データのkeyカラムをkey/valueのkeyとして保存しておくので、シリアライズされたvalueのなかにkeyの値が入ってると重複して無駄なので、シリアライズするハッシュ要素からkeyのデータを取り除きます。
lookup/getした時は、検索するのに使ったkeyから行データを復元する感じです。

シリアライズ

普通にmemcached使ってるなら$memcached->add( $key, { k => 'v' })みたいにしてオブジェクト突っ込めば良いんだけど、この場合サーバがあるFLAGを保存するようにしないとgetする時に上手く動かなかったりします。風の噂でTokyoTyrantがそのまんまだと使えないとか聞きました。
こういった事を解消する為に、シリアライザを自由に変更出来るようにしました。Cache::Memcached::Fastでもシリアライザ変更出来るけども、全然別のモジュール使うときを考えてData::Modelのレイヤでシリアライズする感じです。

  my $driver = Data::Model::Driver::Memcached->new(                                                                                                                                             
      memcached  => Cache::Memcached::Fast->new({ servers => [ { address => "localhost:11211" }, ], }),                                                                                         
      serializer => 'Default', # default is L<Data::MessagePack> or messagepack minimum set for Data::Model                                                                                     
  );

MessagePackはサイズ効率よくシリアライズができるようで、上記のカラム名変換機能で数値カラム名に変換するとMessagePackのFixNumという超省スペースなデータが使われるため、とても効率が良くなります。

Cache::Memcached::Fast標準で使われるStorableだとバージョンの差異でデシリアライズとか出来なくなってはまるときもあるのですが、MessagePackだと当面そういった事も無いでしょう。

全部組み合わせると。。。

実装のし易さやユーザの選択が出来るように、これらの要素はバラバラに設定するようになってますが、基本的に全てのオプションを全部使う事でKVSにとっても嬉しいデータを作り出すようになっています。
シリアライズ以外の要素は、その効果がとてもわかり易いですが、シリアライズの部分もStorableを使ったよりもサイズがコンパクトになります。

例えば

install_model bookmark => schema {
      schema_options model_name_realname => 'b';
      key 'id';
      column 'id' => int => { unsigned => auto_increment => 1 };
      column 'user_id';
      column 'url_id';
      column 'bookmark_at';
      schema_options column_name_rename => {
          id          => 1,
          user_id     => 2,
          url_id      => 3,
          bookmark_at => 4,
      };
  };

$model->set( bookmark => {
    user_id     => 1,
    url_id      => 1,
    bookmark_id => time(),
}

Driver::Memcachedの利点

と、これまでに紹介してない利点としては、KVSに保存するのはシリアライズされたハッシュオブジェクトなので、カラムの追加とかを自由に出来ると言う事ですね。ALTER TABLEなんかやらないでもアプリケーションのコードを変更するだけでカラムが増やせたり減らせるので簡単です！(減らしてもデータは消されないけど。)
特定のカラムの値でしかlookupしないのであれば、KVSをストレージとして選択してしまうというのもありかもしれませんね。
あんまり良くわかってないけどRemedieとかもそういう使い方をSQLiteでやってる?

特定のkey以外でもKVSを使ってデータの取得をするインターフェィスも作りたいとは思ってるので、それなりにRDBMSの置き換えとかできるかもしれないです。

まとめ

KVSで簡単にORM風なインターフェィスを使うのにはData::Modelが最高というお話でした。

sfujiwaraさんがPostgreSQL用のDBDドライバも作ってくださってるようなので、ますます広がるData::Modelの可能性にご期待下さい！

Test::系モジュールを書いてたので注意した

Test::系のモジュールを書いている人は要注意 - Charsbar::Note
注意に気づいたので Test::PPPort を直してshipitしました。

ちなみに何する物かと言うと、XS用のppport.hはperl ppport.hとするとXSなコードを色々検査してくれるという事で有名ですが、このテストをあなたのテストスイートに組み込んで快適なXSライフが実現出来るというとても素敵なTest moduleなのですよ旦那さん！

YAPC::Asia 2009

そういえば、今年から SHIBUYA PERL MONGERS から JPA 名義のイベントになるんだなーと去年のパンフみて思い出した。

Imager::ExifOrientation - Exifの情報を元にして画像を回転するよ

全国的にみんな真面目だな〜。勉強会の目的なんてないよ。楽しいからやっている。それで何が悪いのかな？の実況中継、その勉強会への 参加そのものについてちょっと考えなおした方がいいかもしれない。

Imager::ExifOrientationをCPANにうpりました。
Exif の Orientation というパラメータを元にして回転済みのImagerオブジェクトを返します。
一緒に Imager::Filter::ExifOrientation もバンドルしてるので、filterとしても利用出来ます。
Orientationは何かと言うと、カメラに縦方向センサーが入ってる機種で、画像に対してカメラの上方向はどちらかというような情報が入っている所です。
わかり易い説明は500で見れないのでgoogleのキャッシュを見てみてください。

使い方は簡単で、exif入りの画像のパスをrotateメソッドに渡すとexif情報に基づいて回転したimager objectが帰ってきます。

my $image = Imager::ExifOrientation->rotate(
      file => 'foo.jpg'
  );

my $data = do {
      open my $fh, '<', 'foo.jpg';
      local $/;
      <$fh>;
  };
  my $image = Imager::ExifOrientation->rotate(
      data => $data
  );

カメラで撮ったオリジナルのjpegファイル自体を回転させるのもいいですが、Imagerのフィルターとしても使えるようにしました。

 use Imager;
  use Imager::ExifOrientation;

  my $img = Imager->new;
  $img->filter(
      type => 'exif_orientation',
      path => 'foo.jpg',
  );

試しにfilterを使ってacotieを回転させてみましょう。
以下ソース

use strict;
use warnings;
use Imager;
use Imager::Filter::ExifOrientation;

for my $i (1..8) {
    my $img = Imager->new;
    $img->read( file => 'acotie.png' );
    $img->filter( type => 'exif_orientation', orientation => $i );
    $img->write( file => "おうっふ_$i.jpg" );
    `open おうっふ$i.jpg`;
}

Orientation の 3 は、単純に180度回転なのですが、Imagerのrotateを使うと汚くなるのでclip( dir => 'hv' )して、左右上下反転しました。
rotateは計算して頑張って画像を回転させるというのと、flipは単純にピクセルを並び替えるという差が奇麗さの差になってると思います。rotateはデータをコピーして計算するし。
90度やら270度回転は、流石にrotate使うしか無いけど。

追記:
そもそも90度づつの回転の場合は $img->rotate( right => 90 * $x );使うべきなので、書き換えて0.03をshipiしました。 90度やら270度の回転した画像も奇麗になた！

Data::Model っていう ORM みたいの CPAN にあげたよ

あざーす。循環参照しすぎるとバターになる。。なんでそんなに人の目を気にするのだろうと、マジレス。

早速ですが Data::Model っていう O/Rマッパー 的な物を CPAN にあげました。
Data::Model
http://github.com/yappo/p5-Data-Model/tree/master
元来は MVC モデルで言う所の Model を一括でまかなえるつもりで実装していますが、ロジック処理は普通の Perl のクラスで書いちゃった方が潰しが聞くため、主にストレージを Perl のオブジェクトにマッピングする ORM 的な使い方が主流となっています。
そして、 Data::Model の多くの実装や設計などは Data::ObjectDriver を参考にして開発しました。
他にも後述してる ORM の実装を参考にしています。
あ、あとは tokuhirom 先生による日本語チュートリアルがあります。

現在の所の情報源は CPAN に上がってるドキュメントの他に http://d.hatena.ne.jp/tokuhirom/searchdiary?word=Data%3a%3aModelとかhttp://d.hatena.ne.jp/yappo/searchdiary?word=Data%3a%3aModelぐらいですね。
あと、Hatetterのコードも結構参考になると思います。

Perl の ORM といえば、 Class::DBI をはじめに DBIx::Class, Data::ObjectDriver, Fey::ORM, Rose::DB, Jifty::DBI, DBIx::MoCo など( DBIx::Skinny も github にあるよ )があり、再実装する必要が無いようにも思います。
しかしながら既存の物は、 Inflate/Deflate まわりが貧弱で ForuceUTF8 的な事をやるのもちょっと大変だったり不安定だったり、 cache させるのが面倒だったり、 Moose 使ってたり、 社内の最新リポジトリと CPAN のバージョンが乖離していたりと「こいつと一緒にやりたい！」的な物が見つかりませんでした。確かに DBIC なんかは良いものだとは思いますが、複雑な事が出来てしまうがためにgdgdしてしまう事もあったりしたのです。
Data::ObjectDriver がだいぶ希望に近かったのですが、ドキュメントや利用事例が少なくてユーザになるのに二の足を踏みました。

という現状の ORM に持っていた不満点もあったのですが、それ以外の要因としては RBDMS を kvs 的なインターフェィスで使いたいな。そもそも Web アプリケーションだったら RDBMS の R の要素って使わなくても、やってけてるんじゃないか? だったら kvs 的に使えるように下ほうがさっくり DB の処理書けるんじゃないかな? という観点で作り始めました。
そういったスタンスなので Data::Model::Driver::Memcached という memcached protocol を喋るストレージサーバをバックエンドストレージとして使えるようになってます。

あまり長文はアレなので軽く特徴を

column sugar

user テーブルの id というカラムと同じ役割のカラムを別のテーブルに持つ。それも沢山のテーブルで user id なんかを持ってたいと言うケースは多々あると思います。
そんな時は column sugar を使うと、カラムの詳細定義は一度だけ書いて、後は column sugar を呼ぶだけですみます。

# 定義する
column_sugar 'user.id'
    => int => {
        required => 1,
        unsigned => 1,
    };

# user テーブルでの定義
column 'user.id' => { # ここではカラム名が id になる
    auto_increment => 1, # auto_increment 属性だけ追加する
};

# bookmark テーブルでの定義
column 'user.id'; # ここではカラム名が user_id になる

CREATE TABLE 構文を出力する

他の ORM でもよくあるですが、 Data::Model 使って定義したスキーマを CREATE TABLE の SQL に出力します。
そして column sugar が強力にいかせるのは、スキーマ定義に変更が入ったら as_sqls してしまって、そのまま RDBMS 側の DDL も一緒に変えると言う事です。
DB 側のスキーマ情報を自動的に読み込んで ORM のスキーマとしてやるのもありますが、それだとスキーマを二ヶ所で変えなきゃいけなくて面倒なので ORM 側のスキーマのみ変更すれば良いように考えています。
rails のようはマイグレーションも自動的にやりたい所だがまだ未実装です。DB と ORM 側の差分を自動的に反映したいな。

DBI だけでなく kvs にも保存できる

Tokyo Tyrant や groonga や kai などの memcached protocol を使える kvs 等を DBI の代わりに利用する事が出来ます。決定的な制限として primary key でしかデータが引けません。がこれは別の driver と組み合わせる事で対応可能にする方向性です。

透過的なキャッシュ

Data::ObjectDriver インスパイアですが、 cache driver の failback driver を設定した driver object を使う時は、 cache にデータが無ければ、自動的に fallback driver にリクエストする用になります。

cache は Data::Model の Row object その物を渡す感じですが、 DBIC とは違って必要最低限の情報しか入ってないので、あまり問題にならない予定です。

また failback driver には Driver::Memcached を使う事も出来ますが、いわゆる memcached protocol しゃべる kvs は、それ単体での高速性を売りにしているためやる意味が分からんすね。

index に対する検索を簡素化に

Data::Model の get method では index を特別に扱います。
例えば index post (user_id, post_at) の用な index を張っていたら

my $iterator = $model->get( tweet => { index => { post => [ 1, 1281729102 ] } } );

Q4M 対応

Data::Model では標準で Q4M が扱えます。
以下の例は SELECT queue_wait('smtp', 'pop', 10); を発行して、 queue が帰ってきたらそれぞれのクロージャを呼び出します。
第一引数には dequeue された queue の row object が渡されますので、改めて query を発行せずに、 queue の処理が行えます。

my $retval = $model->queue_running(
    smtp => sub {
        my $row = shift;
        is($row->id, 'foo');
        is($row->data, 1);
    },
    pop => sub {
        my $row = shift;
    },
    timeout => 10,
);

column_aliase

カラムにエイリアスを張ります。
バイナリデータをデータベースに格納するカラムがあるとして、利用する時には文字列形式とバイナリ形式を使いたい場合に、カラムにエイリアスを張ると両方の形式で利用出来ます。

  columns qw( name nickname );
  alias_column name     => 'name_name';
  alias_column nickname => 'nickname_name'
      => {
          inflate => sub {
              my $value = shift;
              Name->new( name => $value );
# Name は name っていうメソッドを持ってるよ
          },
          deflate => sub {
              my $obj = shift;
              $obj->name;
          },
      };

$row->nickname;      # 普通に文字列が返る
$row->nickname_name; # Name オブジェクトが返る

$row->nickname('test');    # 文字列をセット
$row->nickname_name->name; # test が返る

$row->nickname_name(Name->new( name => 'おうっふ' ));    # オブジェクトをセット
$row->name; # おうっふ が返る

MySQL の master - slave

当然対応しています。 Driver::DBI::MasterSlave です。
今どきのモダンなウェブアプリは slave の mysql は lvs 噛ましてると思うので、 slave は一個しか指定出来ません。このあたり Data::ObjectDriver 弄った事ある人なら、いかようにも read dbh 分散する仕組み作れると思います。

add_method, mixin

row object に メソッドを生やせる為の add_method って DSL がついてます。
同じ method をいっぱいの table に生やしたい時は mixin 機構があるので、サクサクメソッド生やせます。
DBIx::Class::ResultSet 的な所にメソッド生やしたい場合は、普通に use base 'Data::Model' してるクラスにメソッド生やせばおkです。

transaction

最近実装しました、 DBIx::Class::Storage::TxnScopeGuard インスパイアで以下のように書けます。

  sub foo {
      my $is_die = shift;
 
      my $model = Your::Model->new;
      my $txn = $model->txn_scope; # トランザクション開始
 
      # トランザクション中は $txn からしか DB の操作出来なくなりますよっと
      my $row = $txn->lookup( user => 1 );
      $row->name('transaction name');
      $txn->update( $row ); # update
      return if $is_die; # スコープ抜けて commit されてないのでロールバックされる
      if ($is_die) {
          $txn->rollback; # 明示的にロールバック
          return;
      }

      $txn->commit; # commit する
  }

  foo(1); # rollback されてる
  foo(0); # commit できる

一つのスキーマクラスに複数のテーブル定義ができる

ORM だと、よく1テーブル/1クラスファイルみたいな感じになっちゃいますが(普通にそうならなく出来るけど)、 Data::Model だと、1クラス=1データベース みたいな感じにする方向性なので、1つのクラスファイルに沢山テーブルの定義をやっちゃいます。

リレーション未実装

なんとリレーション周りを標準でサポートしてません！
add_method 使えば has_a くらいは楽に書けるよ。
よい実装手法があれば作りたい所。

Driver::Pacific

kazuho ware の新作 Pacificに対応予定。
リゾルバとのやり取りを Data::Model 側でやるかどうするかは考えてないけども、結構簡単にラッピング出来るイメージ。

予定つながりだと FriendFeedのアレとかも入れたいですね。

まとめ

まだ特徴はあるですが、面倒なのでまとめる。

作り始めてから半年以上経ってようやくリリースできました。
現在自分がバリバリのユーザですが、使ってみた感じだと徐々に良い感じにもなってるし、テストも充実させている、ドキュメントもそこそこ使い方がわかる程度には書いてあるので是非ともお試しください。

あ、あと重要な事ですが、何でも自分で作りたい病だから作った訳ではないです。

Hash::Merge 活用術

「全裸は違法だということを言われた。ええええ、そんな法律があるのか？Debugはできるようになるかもしれない。」と思っておセンチなyappoです。

hashを簡単にmergeするCPAN moduleとしてHash::Mergeがあるのは有名ですが、デフォルトだと色々頑張ってマージしちゃうので、例えばHTTP::Engine::Middlewareの使いたいMiddlewareをARRAY refで書いちゃったりして、base.yamlとproduction.yamlでmergeした時に、以下のような混ざりかたでとんでも無い目にあいます。

use strict;
use warnings;
use YAML;
use Hash::Merge;

my $base = {
    Middlewares  => [
        { module => 'HTTPSession', config => { name => '開発やらステージング用の設定だよ' } },
        { module => 'MethodOverride' }, # 全部で共通して使いたいよ
    ],
    name => 'base',
    base => 1,
};

my $production = {
    Middlewares  => [
        { module => 'HTTPSession', config => { name => '本番用の設定だよ' } },
    ],
    name => 'production',
    production => 1,
};

my $config = Hash::Merge::merge($base, $production);
print Dump($config);

---
Middlewares:
  - config:
      name: 開発やらステージング用の設定だよ
    module: HTTPSession
  - module: MethodOverride
  - config:
      name: 本番用の設定だよ
    module: HTTPSession
base: 1
name: base
production: 1

これは、マズいですね、HTTPSessionの設定を開発と本番で別けたいのにARRAYだから全部混ざっちゃいます。

そんな時はspecify_behaviorでmergeのルールを弄れるのです。左のreftype => 右のreftypeみたいな形で、左の要素がSCALARで右の要素がARRAYだったどうこうするみたいな事が出来ます。
ぶっちゃけ左の要素がHASHで右の要素がARRAYとかだいぶあり得ないので、そういった組み合わせになったらdieするとかすると混乱無いと思います。

こんかいは左右でreftypeが違うと混乱するし、ARRAY同士でmergeしないで右要素だけを生かしたいと言う要望でbehaviorを作ったです。あと、behavior作っちゃうとデフォルトの振る舞いが上書きされるのでget_behaviorで今の振る舞いを取っておいて用が済んだらset_behaviorすると良いと思います。

use strict;
use warnings;
use YAML;

use Carp;
use Hash::Merge;

my $base = {
    Middlewares  => [
        { module => 'HTTPSession', config => { name => '開発やらステージング用の設定だよ' } },
        { module => 'MethodOverride' }, # 全部で共通して使いたいよ
    ],
    name => 'base',
    base => 1,
};

my $production = {
    Middlewares  => [
        { module => 'HTTPSession', config => { name => '本番用の設定だよ' } },
        { module => 'MethodOverride' }, # array は上書きされるので、こっちにもかく
    ],
    name => 'production',
    production => 1,
};

my $old_behavior =  Hash::Merge::get_behavior;
Hash::Merge::specify_behavior({
    SCALAR => {
        SCALAR => sub { $_[1] },
        ARRAY  => sub { Carp::croak 'SCALAR and ARRAY cannot merge in config file.' },
        HASH   => sub { Carp::croak 'SCALAR and HASH cannot merge in config file.' },
    },
    ARRAY  => {
        SCALAR => sub { Carp::croak 'ARRAY and SCALAR cannot merge in config file.' },
        ARRAY  => sub { $_[1] },
        HASH   => sub { Carp::croak 'ARRAY and HASH cannot merge in config file.' },
    },
    HASH   => {
        SCALAR => sub { Carp::croak 'HASH and SCALAR cannot merge in config file.' },
        ARRAY  => sub { Carp::croak 'HASH and ARRAY cannot merge in config file.' },
        HASH   => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) },
    },
}, 'MY_CONFIG_STRICT_MODE' );

my $config = Hash::Merge::merge($base, $production);
Hash::Merge::set_behavior( $old_behavior );

print Dump($config);

---
Middlewares:
  - config:
      name: 本番用の設定だよ
    module: HTTPSession
  - module: MethodOverride
base: 1
name: production
production: 1

HTTP::Engine is moved to GitHub

こんにちわ！gitがむづかしすぎてgitなんか滅んでしまえば良いのにと思ってる金曜日の天使ことyappoです。

表題の通り HTTP::Engine 関連のプロジェクトを github に引っ越しました。
http://github.com/http-engine
http://twitter.com/httpengine
http-engineアカウントを取ってそっちで管理する感じです。
必要な方にはコラボレータ追加したりとか良い感じで運用しようと思います。

なおHTTP::Engine 0.1.8 をshipitしました。
Any::Moose 0.08 での変更の追随や
http://example.com/?aco=tie でリクエストたときに $req->uri の中身が http://example.com?aco=tie になってしまうバグが解決されています。

次は、$req->uri->baseがInterfaceによって取れる値が違うのでこれを共通化する方向にしたりとか、良い感じでapplicationのroot pathを取れる仕組みを追加したい所ですが何校中です。

ちなみに移行にはperl製のsvn2gitをforkしてhttp://github.com/yappo/svn2git/tree/master使いました。

$ mkdir hoge
$ cd hoge
$ git init
$ svn2git --strip-tag-prefix 'release-' http://svn.example.com/some-project
$ # git remote ついか
$ git push origin master
$ git push --all
$ git push --tag

Iron Man Blogging Challengeに参加するよ、日本のPerlな人も参加しようよ

Perlをもっとブログの表舞台に - Iron ManコンテストとかPM 05:36 Iron Man Blogging Challengeとか見て僕も応募してみたよ！

エスペラント語だろうが地球語だろうが言語は何でも良いそうなので日本のPerl書きの皆も申し込めば良いよ！
ironman@shadowcat.co.ukにblogのurlとそのblogの詳細を送れば参加出来るみたいだよ！
僕はURLと日本の諺を添えて送っただけだけどちゃんと受理されるかな？

上手くすればmstの髪の毛の色を好きに変える権利も持てるみたいだし損する事は無いので日本のPerlの盛り上がりぶりを世界に知らしめるチャンスだから皆応募しようぜ！

Log::Dispatch::Screen::Color - ログに色付けるよ

Log::Dispatch::Screen::Color を shipit しました。(りぽじとりはこっち)
昨年末に空前のlog colorブームがあったのですが、最近僕もようやくLog::Dispatchをまともに使うようになったので、Log::Dispatch::Screenに色付けたくなって付けました。
うそです。hirose31さんが呟いてたので作りました。

こんなコードと

use strict;
use warnings;
use Log::Dispatch::Config;

Log::Dispatch::Config->configure('test.cfg');
my $log = Log::Dispatch::Config->instance();

$log->info('いんふぉー');
$log->error('えらーーーーーだよ');
$log->warning('warningwarningwarning');

dispatchers = screen

screen.class = Log::Dispatch::Screen::Color
screen.min_level = debug
screen.stderr = 1
screen.format = [%d] [%p] %m at %F line %L%n

もちろんLog::Dispatch::Colorfulは知っているのですが、これを使うとLog::Dispatchのメソッドを書き換えちゃうので、やや微妙という所もありすっきり仕上げてみたしだいです。
パッチ送れって話もあるですが、$foo->debug({ foo => 'bar' })みたいな事したらDumpしてくれるようにvalidateとか変えてあって、ちょっと僕の欲しい物の方向性じゃ無さそうだという所で新たに作ったのでした。

Log::Dispatch::Colorfulとの互換性はあるので安心です。

とか書いてるうちにcharsbarさんがWin32対応書いてくれたす charsbar++

良い子のMacなPerlユーザーに送る、あなたのPerlアプリをMacアプリにする方法 (Mac版的PAR)

こんにちは！近頃咳と痰と鼻水と鼻づまりがすごく多い、金曜日の天使ことYappoです。

ちょっとしたツールをPerlで書いて、お友達に使ってもらいたいときってありますよね?普通は常識的にgithubとかのurlを教えれば良いのですが、それも出来ない人とかもいた場合が非常に面倒です。
そんな時の便利ツールとしてPlatypusがあるのは有名ですね。
Platyputsを使えば簡単にXSを含めたアプリが配布出来ますんです。

XSとかはアーキテクチャ等によって違うバイナリが吐かれてる事が知られますが、今回はあなたと同じMacOSのバージョンが入ってる事を前提にしちゃって問題無いです。
Macユーザ同士なんだからCPUのアーキテクチャは、殆どの場合は一緒だろうしOSのバージョンもLeopard使ってる前提にしちゃいましょう。

準備するもの

• Platyputs
• local::lib
• あなたのアプリ

手順

まずは作業用ディレクトリでも、作りましょう。mkdir ~/yourappname-work/とかで良いでしょう。

cd ~/yourappname-work/ してから mkdir extlib します。
あなたのアプリで使ってるCPANモジュールを突っ込むのです。

mkdir -p lib/local して local::lib の lib.pm を lib/local ディレクトリの中に入れます。

以下のextlib install用のスクリプトを~/yourappname-work/の中において実行します。

use strict;
use warnings;
use lib 'lib';
use local::lib '--self-contained', 'extlib'; # miyagawaさんのアドバイスで書き換えました
use CPAN;
CPAN->shell;

あまり良くわかってないけど、/System/Library/Perl/5.8.8以下にMacOSが添付してるモジュールが入ってるようなので、@INCをいじって標準モジュール以外はキッチリインストール出来るようにしておきますね。
で、このスクリプトはCPAN Shellになってるので、頑張ってあなたのアプリを実行するのに必要なCPANモジュールをインストールしてください。XSでも大丈夫ですが、外部ライブラリに依存するような物(TokyoCabinetなど)はちょっとやり方解らないので誰か教えてください。

今度はPlatypusがkick startするscriptを用意します。#!/usr/bin/env perl とかshebangしとくと良いでしょう。ちなみにこのスクリプトの中では@ISAを弄る必要は特に無いですが

use FindBin;
use lib ("$FindBin::Bin/remedie-git/lib", "$FindBin::Bin/remedie-git/extlib", "$FindBin::Bin/extlib/lib/perl5");

もし、あなたのアプリが$ENV{HOME}を使うようなら

BEGIN {
    $ENV{HOME} = "$FindBin::Bin/home";
}
use Remedie::CLI::Server;

Remedie::CLI::Server->new_with_options(
    root => "$FindBin::Bin/remedie-git/root",
)->run();

.app作る

Platypusを起動して必要な項目とか埋めたり選択して下さい。ここでは詳しく書きません。
Script Pathは、上で書いた.app用のscriptでを選択して下さい。
重要なのは左下の「Show Advanced Options」をクリックして出てくる

でして、右側の+をクリックして頑張ってCPANインストールしたextlibのパスを指定して下さい。
配布アプリの中にそのままコピーされて含まれるのです。

extlib以外の物を配布アプリに含めたい時は任意に好きなだけ追加してください。僕はremedieをgit cloneしたディレクトリを丸っと入れたりしました。

あとは「Create」して、アプリが出来るのを待ちます。

僕の場合は YourApp.app/Contents/script に実行bitが立ってなかったので、 chmod ugo+x YourApp.app/Contents/script しました。
それをやればあっという間に普通のMacのアプリで実行出来る筈です。

まとめ

MacでPARみたいにする手順をずらずら書きました。

Platypus、 local::lib、scriptで使うファイルは$FindBin::Binの中に入れるとアプリケーションの外を汚さなくてすむ。という簡単な要素で作れます。

僕もこれでRemedia.app作ったら他の人のMacでも動きました(最近のmacはlibxml2はいってるっぽ)

さぁ皆さんもPerl使って素敵なMacアプリ開発ライフを過ごしてください。Enjoy!

TokyoCabinetがPerlのHASHより遅いわけがない！

こんにちわ！金曜日担当・Shibuya内フェアリーことYappoです。

mixi Engineers’ Blog » PerlとRubyで省メモリなハッシュを使おうにて

100万件のレコードを格納した場合のメモリ使用量と処理時間を測ってみましょう。Perl（5.8.8）でテストコードを動かしたところ、以下の改善が確認できました。標準のハッシュに比べて、メモリ使用量がTCのオンメモリハッシュだと約61%、TCのオンメモリツリーだと約37%になることがわかります。処理時間に関しては157%ほどになっていますが、まあ許容範囲ですよね。

でもまぁ腑に落ちない所もあり「mikio wareがperlのhashより遅いわけが無い！」と思いながらもshibuya.pmとかあって放置してたのですが、OpenFrepaカンファレンスも終わったのでTokyoCabinet.pmの実装を見てみたら、引数の値チェックをpure perlでやりつつXSのコードを呼んでいる実装でした。
引数の値チェックは置いといて、Perlと言うのは関数呼び出しのコストが馬鹿に出来ないので、試しにXSの関数を直接呼ぶように書き換えてベンチマークを取ってみました。

以下結果で、hashが元のテストコードで言う所のPerlのハッシュの実装で、tc_mikioがmikioさんのTCを使った実装で、tc_yappoが今回XSを直接呼ぶようにしてみた実装です。

$ perl ./benchmark.pl 
             Rate tc_mikio     hash tc_yappo
tc_mikio 333333/s       --     -29%     -52%
hash     469484/s      41%       --     -32%
tc_yappo 694444/s     108%      48%       --
=== ちゃんとkey/valueが入ってるか見るよ at ./benchmark.pl line 41.
hash : 00222791 => h00222791 at ./benchmark.pl line 43.
mikio: 00222791 => m00222791 at ./benchmark.pl line 44.
yappo: 00222791 => y00222791 at ./benchmark.pl line 45.

以下ベンチマークスクリプトです

#!/usr/bin/perl
use strict;
use warnings;
use blib;
use Benchmark 'cmpthese';

use TokyoCabinet;

my $runnum = 1000000;
my $tc_args = sprintf('*#bnum=%d#mode=wct#xmsiz=0', $runnum);

my %hash;

my $mikio_db = TokyoCabinet::ADB->new;
$mikio_db->open($tc_args) || die 'mikio open failed';

my $yappo_db = TokyoCabinet::adb_new();
TokyoCabinet::adb_open($yappo_db, $tc_args) or die 'yappo open failed';

my($hash_i, $mikio_i, $yappo_i) = (0, 0, 0);
cmpthese(
    $runnum, {
        hash => sub {
            my $buf = sprintf('%08d', $hash_i);
            $hash{$buf} = 'h'.$buf;
            $hash_i++;
        },
        tc_mikio => sub {
            my $buf = sprintf('%08d', $mikio_i);
            $mikio_db->put($buf, 'm'.$buf);
            $mikio_i++;
        },
        tc_yappo => sub {
            my $buf = sprintf('%08d', $yappo_i);
            TokyoCabinet::adb_put($yappo_db, $buf, 'y'.$buf);
            $yappo_i++;
        }
    }
);

warn "=== ちゃんとkey/valueが入ってるか見るよ";
my $key = sprintf('%08d', int(rand($runnum)));
warn "hash : $key => " . $hash{$key};
warn "mikio: $key => " . $mikio_db->get($key);
warn "yappo: $key => " . TokyoCabinet::adb_get($yappo_db, $key);

$mikio_db->close;
TokyoCabinet::adb_close($yappo_db);

結論としてはTokyoCabinet.xsにid:gfxパワーが加わると(xsの中で引数チェックとかするの意)とんでもない速度になりそうです。

Shibuya.pm #11で発表しました

こんにちは、本日のHOTEL担当、素敵なレディーことYappoです。3人の荷物が家族のオモチャにされないか心配だけどもう寝るぞ！話は変わるけど、acotieさんはアクメアクメ言っててどんだけアクメ好きなんだよ！と思ったのは内緒だぞ！

という訳でShibuya.pmで発表してきました。二本立てです。

一本目は、一般的なperl userの作法のBやらDevel::Peekの紹介に加えて、新しく作ったDevel::RunOpsAnalizeを使ってOPCODEの実行単位でPerlの動作を覗き見る方法の紹介をしました。

二本目はLTで、dan the eval botの作り方を説明する為のCentOSのインストールをするというのを口実にHatetterのアーキテクチャや、なぜこれらの要素を採用したかを紹介しました。
もちろんCentOSのインストールもCobblerとKoanのお陰で完了して、local::libでdan the eval botに必要なperlモジュールも楽々installできるとか嘘つきながら、3分クッキングメソッドで無事にirc botもirc serverにjoinする所までLTの限られた時間の中でデモできました。
LTの中で二つの題材を同時進行で発表するメソッドは案外使えるんだなと思いましたね。30秒オーバするポカやらかしたけど。

ちなみにnon-blockingとか言いましたが、実際にはmemcachedやらQ4Mの処理でblockは発生します。が、気にしなくても良い程度のblockです。maybe

資料は、http://svn.coderepos.org/share/docs/yappo/20090422-shibuyapm11から適当に辿って下さい。VMのサンプルスクリプトもありますよ。
Devel::RunOpsAnalizeはhttp://github.com/yappo/p5-devel-runopsanalyze/tree/masterから
LTのサイトのソースコード一式はhttp://github.com/yappo/website-hatetter/tree/masterからどうぞ。

関係無いけど、英語が出来ない,OCamlがわからない,etc etc etcなどと言ったくだらない理由で、そういう自分が苦手だとかいうのから遠ざかるのは馬鹿だなーと思ったなー。僕なんて相変わらず英語でコミュニケーション取るのがXS書くのより大変だけど、なぜか俺の横で海外組の二人が寝てるよ。起こしかたとか朝飯とかどうすりゃいいんだかわからんけど。

あーあとhidekさんのスター画像作んなきゃ

CPUの気持ちは大事だけど、VMの気持ちも考えようよ

CPUの気持ちになってプログラムを書くということ　Kansai.pm#11 参加記その１ - プログラマになりたい

　ちなみに、下記のコードはデータハザードを解消する為のコーディング例です。データハザードは、命令が利用するデータ間に依存関係がある場合に発生します。前の命令が終わらないと後ろの命令が実行できないとか。ですので、それを解きほぐしてやれば、並列で処理が出来るようになります。

loop unrolling は perl でもちゃんと効果がある

以下検証コード

use strict;
use warnings;
use Benchmark qw(:all);

cmpthese(5000000, {
    'pseudo loop unrolling' => sub {
        my $sum = 10;
        my $i   = 1;
        $sum = $sum + ($i + 0);
        $sum = $sum + ($i + 1);
        $sum = $sum + ($i + 2);
    },
    'scope 1' => sub {
        {
            my $sum = 10;
            my $i   = 1;
            $sum = $sum + ($i + 0);
            $sum = $sum + ($i + 1);
            $sum = $sum + ($i + 2);
        };
    },
});

$ perl ./loop.pl 
                           Rate               scope 1 pseudo loop unrolling
scope 1               1524390/s                    --                  -25%
pseudo loop unrolling 2040816/s                   34%                    --

まとめ

ブロックがあるという事は、スコープがあると同義なのは当たり前ですが、スコープが変わるという事はレキシカル変数の処理などをやらなきゃいけないわけで、{}があるだけでもPerlは処理をいっぱいするわけです。
別にブロック増やすなというわけではないですが、ベンチマークを取る時にはこういう所にも気をつけたい所ですね。

追記

!hyoshiokさんが、そもそもloop unrollingがperlで意味あるか?というのを気にしていたようなので、効果あるよって言うベンチマークしたす。

forしたコードと、for文だと3回scopeの出入りがあるので、それにあわせるコードも追記して、さらにmy $jのコストも加算するようにした。

use strict;
use warnings;
use Benchmark qw(:all);

cmpthese(5000000, {
    'pseudo loop unrolling' => sub {
        my $sum = 10;
        my $i   = 1;
        $sum = $sum + ($i + 0);
        $sum = $sum + ($i + 1);
        $sum = $sum + ($i + 2);
    },
    'scope 1' => sub {
        {
            my $sum = 10;
            my $i   = 1;
            $sum = $sum + ($i + 0);
            $sum = $sum + ($i + 1);
            $sum = $sum + ($i + 2);
        }
    },
    'scope 3' => sub {
        {
            my $sum = 10;
            my $i   = 1;
            {
                $sum = $sum + ($i + 0);
            }
            {
                $sum = $sum + ($i + 1);
            }
            {
                $sum = $sum + ($i + 2);
            }
        }
    },
    'scope 3 and my $j' => sub {
        {
            my $sum = 10;
            my $i   = 1;
            {
                my $j = 0;
                $sum = $sum + ($i + $j);
            }
            {
                my $j = 1;
                $sum = $sum + ($i + $j);
            }
            {
                my $j = 2;
                $sum = $sum + ($i + $j);
            }
        }
    },
    'loop' => sub {
        my $sum = 10;
        my $i   = 1;
        for my $j (0..2) {
            $sum = $sum + ($i + $j);
        }
    },
});

$ perl ./loop.pl 
                           Rate loop scope 3 and my $j scope 3 scope 1 pseudo loop unrolling
loop                   683995/s   --              -11%    -17%    -48%                  -63%
scope 3 and my $j      772798/s  13%                --     -6%    -42%                  -58%
scope 3                823723/s  20%                7%      --    -38%                  -55%
scope 1               1322751/s  93%               71%     61%      --                  -28%
pseudo loop unrolling 1824818/s 167%              136%    122%     38%                    --
dh004:t ko$ perl ~/bin/htmlescape.pl loop.pl 

HTTP::Engineの今とこれから

昨年末にHE con #1 が開催されてから久しいですが、あの前後で話題になっていた 「HTTP::Engineは依存が大杉メモリ食いまくり」な件に関しては、Shikaという回答を出し、その後Mouse版の0.1.1をリリースしました、 そして最近Stevanから「Any::Mooseはどうか? lang:en」と言った話も有り、現在Any::Mooseに依存した0.1.4を出すべく0.1.4_xをCPANにあげています。
クラスビルダーにMooseを使うか捨てるか論争は、0.1.4にて妥協出来る所に落ち着いたんじゃないかなと思います。
Any::MooseやMouseが細かい所で挙動が変わるかどうかは今のところわかりませんが、少なくともHTTP::Engineで採用した事により安定する方向になるんじゃないでしょうか?
もちろんより高い互換性の為の変更は入るでしょうが。

0.1.4によってデフォルトはMouseを使い必要とあればMooseで動くようになるので、CatalystのEngineとして使う時はMooseで、Mooseを使うコストが気になる時はMouseが使えるようになりました。
MooseとMouseは細かい所では互換性ありませんが、HTTP::Engineで使ってる内容ではAny::Mooseを噛ますだけで、この差異はほぼ吸収出来ています。
MooseX, MouseXだと互換性が今イチわからない(というか基本的にMouseXはMooseXのが使えるように進める方向性みたい)、これも互換性の高いMo[ou]seX::Typesしか使っていないため問題無いです。

最新のHTTP::EngineではMooseがインストールされた環境でperl ./Makefile.PLするとデフォルトのテストとは別にMoose用のテストを生成して両方テストするようにしています。
cpantestersなどでテスト結果を見るとt/mooseをテストしてるのやテストしてない人が居るとおもいます。(0.1.4_01ではバグってておかしいけど)

Any::Moose

Any::Mooseとは、端的に言ってしまえば「use Any::Mooseほげほげ」した時に、Mooseがloadされていれば「use Any::Mooseほげほげ」が「use Mooseほげほげ」と同等の処理になり、Mooseがloadされていなければ「use Mouseほげほげ」になる感じです。
一度そのクラスでuse Any::Mooseされてれば、次回以降そのクラスの中でuse Any::Moose呼ばれた時には最初に選んだほう(Moose/Mouse)が使われます。
any_mooseに関しても同じ

特に何もしなければ、一番最初にuse Any::Mooseした時に選んだ方が他の時にも使われる。

HTTP::Engine::Middleware

HTTP::EngineはWSGIやRackインスパイアである事は周知の事実ですが、HTTP::Engineが始まった当初からHTTP::Engine::Middlewareという物を作る予定になっていました。
これは a( b( c( handler() ) ) ) のような形で、実際のハンドラ処理にmiddlewareの処理がラッピングされるイメージに近しいイメージで処理をラッピングします。

現在は、様々な方の成果をまとめてDebugScreen/DebugRequest/Encode/Static/HTTPSession/FillInForm/Profil/ReverseProxyなどなど、このレイヤで利用度の高そうな処理を行ってくれるmiddlewareが標準でついてきます。
認証周りを誰か作ってくれないかなぁという所です。OpenIDはzigorouさんだけど。

middlewareは、あくまでもHTTP::Engineとアプリケーションの中間層なのでHTTP::Engineのプラグインでない事に注意が必要です。
plugin的な物が欲しければ、アプリ側にあるべきです。
アプリのプラグインとして、アプリ固有のmiddlewareなんかでもいいです。

ものすっごくベーシックなアプリならHTTP::Engine + HTTP::Engine::MiddlewareだけでもWAFを使わずにかけるかなと言う感じです。
もちろんWAFとかのレイヤがないとMVCやらMVACやら出来ないので大変だけど。

今後の予定

HTTP::Engineは非同期処理とか出来るInterfaceを付けたいなと思ってます。もちろんドキュメントやチュートリアルも。
0.1.x系統で、APIやら基盤はかなり安定してきているためドキュメントを日本語でも良いから増やしたいですね。

HTTP::Engine::Middlewareはパッケージングをどうするか等を詰める感じでしょうか。

0.1.4が出てからは、Mooseな人もMouseな人も使えるようになりますので、是非使ってみて下さい。
参考書籍は無いですが

• Remedie
• Angelos
• Railish
• Ark
• mobirc
• Catalyst::Engine::HTTPEngine

また、良質の日本語記事としてcharsbarさんのgihyoの記事もあるよ！

MooseX::Typesのしくみ

MouseX::Typesを作るにあたり、あまり使った事のないMooseX::Typesを試していてドはまりした。

普段Mooseのsubtypeとか指定するときは

subtype 'Natural' => where {};

subtype Natural => where {};

MooseX::Typeで

use MooseX::Types -declare => [qw/ Natural /]

use MyTypes 'Natural'

has foo => ( is => 'rw', isa => Natular );

で、MooseX::Typesをきちんと使うためには、subtype/coerce/class_type/role_type/hasのisa/doesなどに、このexportされた関数を渡さなくてはならない。
文字列を渡してはならないのだ。
この関数はMooseX::Types::TypeDecoratorのオブジェクトを返す。このオブジェクトはoverloadされており文字列で評価された時には、typeの名前が返ってくる。
標準で、定義したクラス名+定義名になるので、今回の場合は「MyTypes::Natural」という文字列が変える。
ようするに

subtype 'MyTypes::Natural' => where {};

has foo => ( is => 'rw', isa => 'MyTypes::Natular' );

さて、冒頭のうかつな

subtype Natural => where {};

まとめとしてはMooseX::Typesを使う時には

subtype Natural, where {};

JPerl Advent Calendar 2008

JPerl Advent Calendar 2008が始まりました。Perl に関するちょっとした Tips を、毎日一個とか書いてくのです。
codereposのアカウントがあれば誰でもかけます。

はてなアイデアでadvent calendar ( http://perl-users.jp/articles/advent-calendar/2008/ ) が一ヶ月続いたら、id:precuredaisukiが執筆者全員に雛寿司を奢るというアイデア。codereposのアカウント持ってれば誰でも書けるよ！というアイデアも出されているので、寿司食べたい人は参加するといいよ。

Yakohama.PM で発表した Shika と HTTP::Engine と Data::Model と

流石に3日連ちゃんで発表するのは、どこのYAPC::Asia状態だよ！？と思っていて当初は控えていたのですが、案外体力的にも行けそうだったので当日になって飛び入りで発表させて頂きました。
Yokohama.pm++

本日の発表は、既にtokuhiromが書いてるけど、Shikaについてです。
http://svn.coderepos.org/share/docs/yappo/20081128-yokohamapm3/shika.pl
軽量化MooseなんだったらなぜMouseじゃないのか?Shikaを使う利点は何か?今のステータスはどういう物か?等を話してきました。
前日の昼にスタートしたプロジェクトの事を勉強会で発表するなんて早漏すぎだと思われるかもしれないけれども、Shikaのようなものの需要はだいぶ前から構想されてたのでちょうどいいのです。
必然的にHTTP::EngineをCGIでそこそこ使える時代になってきそう。

ちゃんとフォーローしときますがMooseが駄目だとかそういう話ではないです。あくまでも用途とMooseで出来る事にちょっとしたギャップがあっただけ。

本当はShikaの話は5分で終わってData::Modelのプレゼンしようと思ってたけどShikaだけで時間つかっちゃいましたw
id:nekokakによるDBIx::SkinnyのプレゼンがそのままData::Modelの資料として転用出来そうなので、それをコピペして改変してどっかで発表出来ればなと思っています。
たぶんORMconあたり。
ちなみにDBIx::SkinnyよりData::Modelの方が速いとかとか。

「僕たちはMOPを使いたいんじゃなくて気持ちよくコードを書きたいだけ」という事を再認識しました。

HECon#1 と Shibuya.pm で発表してきたの資料

perl weekという事でHTTP::EngineカンファレンスとShibuya.pmで発表してきました。

http://svn.coderepos.org/share/docs/yappo/20081126-hecon1/hecon1.pl
http://www.nicovideo.jp/mylist/8698529
HEConはhidekさんの絶大な協力によりつつがなく終わる事ができました。Yacafi::Engineに感動しっぱなしでした。
dannさんも切望してるのでHECon#2なんかもあったりするかもしれません。

http://svn.coderepos.org/share/docs/yappo/20081127-shibuyapm10/shibuyapm10.pl
http://www.nicovideo.jp/mylist/9691133
shibuya.pmでは、主に今やってる事の紹介などをしてきました。

なんかしらの勉強会をやると世の中が動くとは孔子もいってましたが、良い感じのプロジェクトも始まりましたが、そのお話は後日ということで。

週末にはSUTEKI hackathonが開催されるので、今回発表したもの周りのコードをぐいっと進めたい所ですね。

HTTP::Engine で進捗表示しつつアップロード

HECon前の前菜に最適だったので。
404 Blog Not Found:perl - LWP::UserAgentで進捗表示しつつダウンロード
というかHECon1は参加条件緩めたしまだあと10名程来れるので是非是非きて下さい。発表枠も1-2枠くらい余ってます。Shibuya.pmの前夜祭的な参加もおkす。

で、何をやったかというとファイルアップロードされるとプログレスバーを表示する。
ServerSimpleやPOE向きの実装。
これを使う事によりアップロードされまくってる感が増大します。しかも簡単なhackで済んでるところも素敵ですね。

こんな感じにコンソール出力されます。

$ perl ./http-engine-progressbar.pl
HTTP::Server::Simple: You can connect to your server at http://localhost:1978/
Upload[15774168]: 100% [=========================================================================================================]D 0h00m04s

use strict;
use warnings;
use HTTP::Engine;
use Term::ProgressBar;

my $engine = HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => { port => 1978 },
        request_handler => sub {
            my $req = shift;

            return HTTP::Engine::Response->new(
                body => q|<form method="post" enctype="multipart/form-data">
                          <input type="file" name="upload_file" />
                          <input type="submit" />
                          </form>|
            ) unless $req->param('file');
        },
    }
);

{
    my $progress;
    my $content_length = 0;
    my $read_size      = 0;
    $engine->interface->request_builder->meta->make_mutable;
    $engine->interface->request_builder->meta->add_before_method_modifier(
        _read_init => sub {
            my($self, $args) = @_;
            return unless $content_length = $args->{content_length};
            $read_size = 0;
            $progress = Term::ProgressBar->new({
                count => $content_length,
                name  => "Upload[$content_length]",
                ETA   => 'linear',
            });
        },
    );
    if (1) {
        $engine->interface->request_builder->meta->add_around_method_modifier(
            _read_chunk => sub {
                my $next = shift;
                my $size = $next->(@_);
                $read_size += $size;
                $progress->update($read_size);
                return $size;
            },
        );
    }
    $engine->interface->request_builder->meta->add_after_method_modifier(
        _read_to_end => sub {
            return unless $content_length;
            $content_length = 0;
            $read_size      = 0;
        },
    );
    $engine->interface->request_builder->meta->make_immutable;
}

$engine->run;

Shibuya Perl Mongersテクニカルトーク#10

来る11月27日(水)にShibuya Perl Mongersテクニカルトーク#10が行われます。
具体的に話す内容は決まってませんが大筋のテーマに沿ったものになるます。
Perlを第二言語にしてもらえる予備軍の人向けの話は他の人にゆづるかんじで。

Math::Pari を Mac 環境で入れる方法

Crypt::RSA を Mac で使いたくて Crypt::RSA を install 仕様としたら Math::Pari でこけた。
なにやっても入らない macports しても無駄。fuckfuckfuckfuckだったのですが、ようやく入れる事が出来た。
GCC の インライン最適化を仕様として全オブジェクトファイルに_overfllowというシンボルを作ってリンクできなかったかんじ?

cd /tmp
wget ftp://megrez.math.u-bordeaux.fr/pub/pari/unix/OLD/pari-2.1.7.tgz
pari-2.1.7が必要
tar zxvf pari-2.1.7.tgz
sudo cpan> look Math::Pari
で 2.010800 を入れようとして shell に。
おもむろに vim Makefile.PL して GCC_IN がついてる行をコメントアウト。
vim libPARI/Makefile.PL もして同上。
perl ./Makefile.PL paridir=/tmp/pari-2.1.7 machine=none
make
make test
make install

Crypt::RSAもちゃんとはいった。。。あーつかれた。もう疲れてRT送る気力無い。いつか送る。

HTTP::Engine 0.0.18

色々とbug fixやらがたまってきたので 0.0.18 として shipit しました。
仕様はほぼほぼ固まっているのでドキュメントを充実させて1.0.0を出すために0.9.1_xx系統をやって行きたいとは思ってます。

川崎さんにmod_fastcgi + apach2な環境のテスト作ってもらえたら嬉しいなぁ。なんて。

update of Yacafi #1

Yacafiが色々と拡張されました。

• Templateが内蔵された
• ナウでおしゃれなデバッグ画面ついた
• アクションのディスパッチをaction=fooやめてPATH_INFOからとるようにした

TemplateはMojo::Templateを改造したMENTA::Templateを移植して使っています。MENTA::Template について - TokuLog 改めB日記も参考にしてください。
Template機能を使わない状態で--packした場合には不要なコードが消えるようになってたりします。

アクションは、今まで./yacafi.cgi?action=fooだったらdo_fooを呼ぶようにしてたんですが、./yacafi.cgi/fooという形をとるようにしました。./yacafi.cgi/foo/bar/bazでdo_foo_bar_bazが呼ばれます。./yacafi.cgi/foo_bar_bazも同様です。

その他実際に動いている様子をhttp://tech.yappo.jp/demo/yacafi/yacafi.cgi/やhttp://tech.yappo.jp/demo/yacafi/yacafi-template.cgi/で確認出来ます。

ファイルアップロードCGIつくるための方法は無いですがおいおい考える事にする。

HE conference#1開催します

株式会社KDDIウェブコミュニケーションズさんの御好意のお陰でHEconが開催される事となりました。
http://soozy.org/index.cgi?HEcon1
主にHTTP::Engineや、それに類する技術についての勉強会です。(場合によってはHyperEstraierも可)
11月まつのPerlMongers3連日の初日にあたる2008年11月26日(水)20時から麹町で行われます。
定員は30名までなので席のあるうちにお早めにどうぞ。

基本的にHTTP::EngineのAUTHORの方は全員参加という事でひとつ。

Yacafi という軽量CGIフレームワーク書いたよ

MENTA というウェブアプリケーションフレームワークをかいてみた - TokuLog 改めB日記やらNanoA というウェブアプリケーションフレームワークをかいてみた - id:kazuhookuのメモ置き場やらと軽量CGIフレームワーク作りが流行ってるようなので昼飯食った後に20分くらいで書いたよ。

Yacafi(Yet another CGI application framework interface)と言います。
http://svn.coderepos.org/share/lang/perl/Yacafi/trunkからsvn coできるけど、Yacafiはモジュール一個だけあれば動くようにしてあるのでhttp://svn.coderepos.org/share/lang/perl/Yacafi/trunk/lib/Yacafi.pmからwgetとかしてきても使えるよ！

特徴

Yacafi は使い捨て等の軽めのCGIを、いわゆる MVC 的なノリで開発する事が出来ます。
Yacafi.pm と index.cgi 以外のファイルを編集する必要もありません。
いわゆる MVC のノリで開発すると、ディレクトリ掘ったりとかファイルが増えてしまい使い捨てCGIなのに、ちょっと面倒くさくなっちゃうというデメリット(?)が回避できます。
配布する時は 、Yacafi.pm と index.cgi をサーバにアップロードする等することも出来ますし、perl index.cgi --pack というコマンドラインを実行する事によって、 Yacafi.pm と index.cgi を合成したMENTAインスパイアの1つのファイルにまとめて配布する事も可能です。

Yacafi.pm を見れば判りますがblessすら使ってません。全部クラスデータ的なとこに突っ込んでます。

MENTA や NanoA は、いわゆる普通の Web Application Framework を使うかの如く CGI の開発をしつつ軽量性に重点を置いているのに対して、 Yacafi は軽量な使い捨て CGI の開発を行い易くなるような所を重点に置いている違いがあります。

how to

使い方はhttp://svn.coderepos.org/share/lang/perl/Yacafi/trunk/example/index.cgiを参考にして下さい。
といってもとても簡単で

use strict;
use warnings;
use Yacafi;
dispatch;

sub do_index {
    view 'index';
}

sub view_index {
    'hello yacafi!';
}

ディスパッチする方法としては今の所、index.cgi?action=foo といった形でactionの値を使って、その値に対応するコントローラ関数のdo_*関数を呼び出します。
action=fooならdo_fooとといった感じです。
do_*関数の戻り値は view 'view_name'; と行った感じでViewを呼び出す事を推奨します。
別途

sub do_foo {
    return {
        headers => { 'Content-Type' => 'text/plain' },
        body    => 'hello raw view',
    };
}

viewの定義としてはview_を頭に付けた関数名を書いて下さい。
barというviewを作りたければ sub view_bar { 'hoo' } です。
コントローラ関数等からは view 'bar'; として呼び出せます。
view 'bar', %options といったように引数も渡せ、sub view_bar { my %args = @_; 'aaa' } といった感じで受け取れます。
view関数の戻り値は、ブラウザに返したいコンテンツをそのまま返して下さい。
テンプレート周りが欲しければ別途用意してください。
上記 do_foo のような形式の HASH リファレンスを直接返す事もできます。

modelの定義も出来ますが今の所ノープランでviewと同じ挙動です。

export関数

query('param_name') といった感じでクエリパラメータの取得ができます。MENTAから主にコードをパクっています。

redirect $uri; といった関数を使ってリダイレクト可能です。status codeを変更したければ redirect $uri => 301; のようにして下さい。

サニタイズ目的で filter 関数が使えます。 filter "<script>alert('hello');</script>", => 'html'; の用にお使い下さい。
複数のフィルタを同時に使う事が出来ますが今の所 html しか用意していません。
必要なら

    filter->{uri} = sub {
        my $uri = shift;
        # 処理
        return $uri;
    };

TODO

TODOは、せめてファイルアップロード機能くらいはつけたいです。あと、pre_request, post_request的なフックも。

HTTP::Engine And Mojo Benchmarking

Update: Mojo作者のSebastianもベンチマークとってくれたよ！ (new benchmark by Sebastian)
Mojo vs. HTTP::Engine - Sebastian Riedel - Perl and the Web
sri++
And if there is time, i make benchmark of FCGI.

本気bar効果でMojoが注目されてるのでHTTP::Engineとの速度差を簡単にとった。
そもそもMojo単体のWeb Serverの使い方が良くわからないので Mojolicious の CLI を見てそれっぽい Mojo::Server::Daemon を使った。

on New MacBook 2.4G

Mojo's source code

use strict;
use warnings;
use Mojo::Server::Daemon;

my $daemon = Mojo::Server::Daemon->new;
$daemon->port(8082);
$daemon->run;

HTTP::Engine's source code

use strict;
use warnings;
use HTTP::Engine;
use HTTP::Engine::Response;

HTTP::Engine->new(
    interface => {
        module          => 'ServerSimple',
        args => { port => 8081 },
        request_handler => sub {
            my $req = shift;
            HTTP::Engine::Response->new(
                body => 'Congratulations, your Mojo is working!',
            );
        },
    }
)->run;

Mojo's Apache Bench Result

bash-3.2$ ab -n 2000 -c 2 http://127.0.0.1:8082/
This is ApacheBench, Version 2.3 <$Revision: 655654 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking 127.0.0.1 (be patient)
Completed 200 requests
Completed 400 requests
Completed 600 requests
Completed 800 requests
Completed 1000 requests
Completed 1200 requests
Completed 1400 requests
Completed 1600 requests
Completed 1800 requests
Completed 2000 requests
Finished 2000 requests


Server Software:
Server Hostname:        127.0.0.1
Server Port:            8082

Document Path:          /
Document Length:        38 bytes

Concurrency Level:      2
Time taken for tests:   4.229 seconds
Complete requests:      2000
Failed requests:        0
Write errors:           0
Total transferred:      318000 bytes
HTML transferred:       76000 bytes
Requests per second:    472.91 [#/sec] (mean)
Time per request:       4.229 [ms] (mean)
Time per request:       2.115 [ms] (mean, across all concurrent requests)
Transfer rate:          73.43 [Kbytes/sec] received

Connection Times (ms)
              min  mean[+/-sd] median   max
Connect:        0    0   0.2      0       3
Processing:     2    4   0.7      4      11
Waiting:        1    3   0.6      3       9
Total:          2    4   0.8      4      11

Percentage of the requests served within a certain time (ms)
  50%      4
  66%      4
  75%      4
  80%      5
  90%      5
  95%      5
  98%      6
  99%      7
 100%     11 (longest request)

HTTP::Engine's Apache Bench Result

$ ab -n 2000 -c 2 http://127.0.0.1:8081/
This is ApacheBench, Version 2.3 <$Revision: 655654 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking 127.0.0.1 (be patient)
Completed 200 requests
Completed 400 requests
Completed 600 requests
Completed 800 requests
Completed 1000 requests
Completed 1200 requests
Completed 1400 requests
Completed 1600 requests
Completed 1800 requests
Completed 2000 requests
Finished 2000 requests


Server Software:
Server Hostname:        127.0.0.1
Server Port:            8081

Document Path:          /
Document Length:        38 bytes

Concurrency Level:      2
Time taken for tests:   1.912 seconds
Complete requests:      2000
Failed requests:        0
Write errors:           0
Total transferred:      230000 bytes
HTML transferred:       76000 bytes
Requests per second:    1045.86 [#/sec] (mean
Time per request:       1.912 [ms] (mean)
Time per request:       0.956 [ms] (mean, across all concurrent requests)
Transfer rate:          117.45 [Kbytes/sec] received

Connection Times (ms)
              min  mean[+/-sd] median   max
Connect:        0    0   0.2      0      10
Processing:     1    2   0.6      2      12
Waiting:        0    2   0.5      2       7
Total:          1    2   0.7      2      14

Percentage of the requests served within a certain time (ms)
  50%      2
  66%      2
  75%      2
  80%      2
  90%      2
  95%      3
  98%      4
  99%      4
 100%     14 (longest request)     

H::Eはlazy_requestがきいているお陰か、速度が倍くらい違う。
YappoはMojoでのベンチマークの仕方も判ってないから不公平感があるかもしれない。
sriが計測したベンチマークのコードとかどこかに無いかしら?

Term::QRCodeっての作ってみた

QRCode大好きclouderさんがText::QRcodeを作ったのをみたnipotanさんが早速terminal化した物をgyazoにうpしてたので、gazoのコードを見ながら脳内コピペして10分くらいでTerm::QRCodeを作りました。
http://svn.coderepos.org/share/lang/perl/Term-QRCode/

ターミナルで作業してる時に、不意にQRCodeが必要になっても落ち着いてQRCodeを参照できるようになりましたね！

Text::QRCodeはCPANに上がってないけど、ネタでCPANに上げるかな

Module::Collect と List::Rubyish を version++

lopnorさんからpluginファイル中に複数のpackageがあった時に、複数分取り扱えるmultipleサポートをコミットして頂いたのでModule::Collectをversion++してshipitしました。

List::Rubyishはid:hibomaにdelete_ifの挙動が逆！って突っ込みを貰って、どーしよっかと思ってたらid:naoyaにバグッてるからコード差し替えといて！と正しいコードを教えてもらってるうちにid:secondlifeが直してコミットしてくれた！一緒にrejectメソッドも追加してもらったよ！
あとid:walf443からsort_byメソッドも追加してもらって、切りがいいのでshipit!

僕は殆ど何もしてないよ！CodeReposって素晴らしいね！

List::Rubyish をリリースしました

ブクマコメントでnaoyaさんからhttp://github.com/naoya/list-rubylike/tree/master/lib/List/RubyLike.pmがバグも無くていい奴だから、そっちとdiffとって適用したほうがいいよ！とアドバイスいただいて、その差分をmergeしつつList::RubyListのテストコードをコピペするだけの簡単なお仕事をしてテストカバレッジ率も100%になったのでshipitしました。
というかnaoyaさん & secondlife 組の元コードのテストカバレッジ率が90%くらいだったので物凄く楽出来ました＾＾

http://search.cpan.org/dist/List-Rubyish/にそのうち反映されるはず。

List::RubyLike は use すると list 関数を export してくれるのですが、List:Rubyish では list 関数は export せずに new した時にリストを渡せるようにしました。

my $list = List::Rubyish->new(qw/ foo bar baz /);

my $list = List::Rubyish->new(qw/ foo bar baz/);
$list->delete(sub { $_ eq 'bar' }); # bar を削除

List::RubyLike では + と >> を overload してるのですが、これを少し拡張して << を unshift に割り当てました。

他にもちょろちょろ本家から変えたりしてますが、基本的な挙動は互換性保ててるとおもいます。

List::Rubyish - hatena の DBIx::MoCo から fork した

DBIx::MoCoというhatena謹製のO/Rマッパは有名ですが、DBIx::MoCo::ListというRubyっぽいリスト操作を行ってくれるモジュールがあります。
概要はPerl のリスト操作を Ruby 風に - naoyaのはてなダイアリーが詳しいです。

DBIx::MoCo::ListはautoboxじゃないのにList::UtilやList::MoreUtilsを活用して実装してあります。
ちょっとしたリスト操作には使い勝手が良さそうなのですが、最大の欠点があります。
それはDBIx::MoCoに含まれるモジュールだという事です。DBIx::MoCoごと入れろと言われたらおしまいですが＞＜

実はDBIx::MoCo::ListはDBIx::MoCoの他のモジュールに依存する箇所がどこにも無く簡単に切り離せるという事実があり、とあるIRCチャンネルでも単独で使いたいケースあるよね的な話が出たので、このたびList::Rubyish(命名 by lopnor++)としてforkさせました。
http://svn.coderepos.org/share/lang/perl/List-Rubyish/trunkにあります。
http://svn.coderepos.org/share/lang/perl/List-Rubyish/trunk/lib/List/Rubyish.pm と http://search.cpan.org/src/JKONDO/DBIx-MoCo-0.18/lib/DBIx/MoCo/List.pmを見比べても驚く程同じ。
コピーしてs/DBIx::MoCo::List/List::Rubyish/gするだけの簡単なお仕事でした。
原作と違う所は map_* 系のメソッドを抜いたのとgrepメソッドでHASHリファレンスの時は$hash->{$code}するという挙動を追加したくらいです。
test codeもそのままです。

jkondさんかnaoyaさんに怒られなければこのままshipitする予定でございます。

Method::Signatures's benchmark

Method::SignaturesというPerlのメソッド定義や関数定義を直感的でかつ書き易く行う事が出来るcool moduleがあります。
たとえば

sub lopnor { # DBIx::Class test code style
    my($self, %args) = @_;
    $self->{danjou} = $args{danjou};
}

method lopnor (:$danjou) {
    $self->{danjou} = $danjou;
}

このほどschwernによるプレゼン資料の中にM::S is 1% slowerとか書いてあったのでベンチ取ってみた。

use strict;
use warnings;

package My::Faster;

sub new {
    my($class, %args) = @_;
    bless {%args}, $class;
}
sub get { $_[0]->{$_[1]} }
sub set { $_[0]->{$_[1]} = $_[2] }

package My::Normal;

sub new {
    my($class, %args) = @_;
    bless {%args}, $class;
}
sub get {
    my($self, $key) = @_;
    $self->{$key};
}
sub set {
    my($self, $key, $val) = @_;
    return $self->{$key} = $val;
}

package My::MethodSignatures;
use Method::Signatures;

method new (%args) {
    return bless {%args}, $self;
}
method get ($key) {
    return $self->{$key};
}
method set ($key, $val) {
    return $self->{$key} = $val;
}

package main;
use Benchmark ':all';

cmpthese(
    timethese(
        50000,
        {   
            faster => sub {
                my $obj = My::Faster->new( bar => 'baz' );
                $obj->get( 'bar' );
                $obj->set( foo => 'bar' );
                $obj->get( 'foo' );
            },
            normal => sub {
                my $obj = My::Normal->new( bar => 'baz' );
                $obj->get( 'bar' );
                $obj->set( foo => 'bar' );
                $obj->get( 'foo' );
            },
            MethodSignatures => sub {
                my $obj = My::MethodSignatures->new( bar => 'baz' );
                $obj->get( 'bar' );
                $obj->set( foo => 'bar' );
                $obj->get( 'foo' );
            },
        }
    )
);

平均値っぽい値の結果は下記の通り。

$ perl ./benchmark.pl 
Benchmark: timing 50000 iterations of MethodSignatures, faster, normal...
MethodSignatures:  0 wallclock secs ( 0.49 usr +  0.00 sys =  0.49 CPU) @ 102040.82/s (n=50000)
    faster:  1 wallclock secs ( 0.32 usr +  0.01 sys =  0.33 CPU) @ 151515.15/s (n=50000)
            (warning: too few iterations for a reliable count)
    normal:  0 wallclock secs ( 0.37 usr +  0.00 sys =  0.37 CPU) @ 135135.14/s (n=50000)
            (warning: too few iterations for a reliable count)
                     Rate MethodSignatures           normal           faster
MethodSignatures 102041/s               --             -24%             -33%
normal           135135/s              32%               --             -11%
faster           151515/s              48%              12%               --

This is ALPHA SOFTWARE which relies on YET MORE ALPHA SOFTWARE. Use at your own risk. Features may change.

Module::Setup 0.02

Module::Collect 0.03のリリース大失敗してModle::Setup0.01が全く動かないのでversion++した。

Module::Setup - pmsetupをモジュール化した

Perlのモジュールをまず最初に作る時はpmsetupやModule::Starterなどを使うのが一般的です。
かく言う余もpmsetupでガリガリ書いてたんですが、はこべさんやらdannさんやらの最近の記事を見て思う所もあってpmsetupをモジュール化してみました。
http://svn.coderepos.org/share/lang/perl/Module-Setup/trunk/

使い方は簡単！cpan Module::Setupでinstallして(まだCPANにあげてないよ！)

 $ module-setup Foo:Bar

これだけじゃまったく意味が無いのでModule::Setupらしい所を。。。

flavor

Module::Setup には flavor という概念があり(Module::Startっぽい)module-setupコマンドを叩く時にflavorを切り替える事で、様々なモジュールのひな形を利用出来ます。
現在はDefaultとCodeReposのflavorがあり

 $ module-setup --init --flavor-class=CodeRepos coderepos
 $ module-setup CodeRepos::Module coderepos

flavorの編集

flavorは~/.module-setup/flavorの中にflavor別のディレクトリに入っています。
codereposなら ~/.module-setup/flavor/coderepos/template の中身がひな形として使われています。
flavorを使ってひな形を作る時には、このtemplateディレクトリの構成そのまま使われますので、自分の趣味に合うように編集したり必要なファイルとかを追加すると良いでしょう。

このflavor用の設定ファイルは ~/.module-setup/flavor/coderepos/config.yaml にあります。pluginsディレクトリがありますが、この中に適当なファイル名でModule::Setup::Pluginを継承したモジュールを書いてconfig.yamlのpluginsにmodule nameを追加しておくと、このflavorのひな形を作るときにプラグインが読み込まれます。
今の所template処理や新規作成するモジュールの情報を変更するフェーズにフック出来るけど、細かいのはModule::Setup:Plugim::*などのソースを読んで下さい。

subversion用のディレクトリやひな形作成後のperl Makefile.PL make make test などは全部Pluginで行っています。
ちなみに =/.module-setup/plugins には、全flavorでloadされる独自pluginを置いておけます。

flavor を packする

flavorを自分好みに編集したらsvnで管理するにしろtar.gzにするにしろ自由ですが--packオプションでflavorの中身全てを一つのpmファイルにしてくれます。

 $ module-setup --pack MyCodeRepos coderepos > MyCodeRepos.pm

 $ module-setup --init --flavor-class=+MyCodeRepos myrepos

packされたflavorを直接使ってひな形つくる

いま作った MyCodeRepos.pm を module-setup --init しないでも直接使う事が出来ます。

 $ module-setup --direct --flavor-class=+MyCodeRepos myrepos

おわりに

--pack やら --direct を上手く活用すると catalyst.pl でやってくれるようなヘルパーアプリを作れます。
Module::Setup->run の $options と $argv に適切な値を渡せば、他のモジュールから叩けるはず。
例えばflavor template の lib/____var-module_path-var____.pm の ____var-module_path-var____ は 実際の module　の path に書き換えられるので、フレームワークのモジュール追加のヘルパーアプリとかに応用できる。

既存の物とは違ってひな形の元ファイルを、普通のファイル操作で編集出来るって所が便利なんじゃないのかなぁと思ってる所。(Module::Starter::Plugin::CGIApp も似たアプローチだけどキモイというか、Module::Sterter::PBP的だ)
ひとしきり固まれば pack して、自作アプリに組み込んだりも出来るから便利そうだなぁと。

以前からpmsetupをモジュール化するという話は出ていたのですが、「そこまでやるならModule::Sterter使うだろJK」やら「一枚岩のスクリプトで気が変わったらスクリプトを書き換えればひな形が変えられるのがpmsetupの良い所！」という感じで誰も手を付けませんでした。
もちろん僕もそう思っていたのですが、若干必要に迫られた感もあってModuler::Sterterに手を出してみようと思ったら、すこぶるめんどくさくなったのでModule::Setupを作ったのでした。

たぶん他の人のpmsetupも全部カバーできそうかも？

HaikuPodというMacからはてなハイクを快適に使うツールを作ったよ

空前のwassrブームの中皆様いかがおすごしでしょうか。
ついにあのcho45の*ig.rbがまだハイクに対応していなくて面白い感じですが、Mac用のいいツールが無さげです。というかAPIさっき公開したばかりだけど。
来週の、MicroblogConにはてなハイクの中の人に参加してもらいたいのですが、「Wassrを末永くお願いします」と言われたので、僕が勝手にTwitterPodをはてなハイク対応しちゃいました。
かいつまむと「はてなハイクをtwitter APIを使うクライアントからアクセスできるコンバータ付きproxy」です。

Macのターミナルとperlが使える環境の人前程ですが、物凄く簡単にエコー対応が出来ます。
TwitterPodをアプリケーションディレクトリに入れておいて下さい。
そして、ここからターミナル操作です。

まずは

svn co http://svn.coderepos.org/share/lang/perl/misc/HaikuPod ~/HaikuPod

 $ cd /Applications
 $ ~/HaikuPod/install.pl

次に肝心のproxyですが、~/HaikuPod/haikupod.plがそうです。
これを使うには各種CPANモジュールが必要なので

 $ sudo cpan
> install MooseX::Getopt
> install HTTP::Server::Simple
> install HTTP::Engine
> install JSON
> install DateTime
> install DateTime::Format::W3CDTF;
> install XML::Simple
> install MooseX::Types

 $ ~/HaikuPod/mixiechopod.pl --port 8107

ここまできたらあとはアプリケーションディレクトリのHaikuPodを起動して、設定画面のアカウントは適当なのを入れて、最後が肝心だけど「Enable Proxy」にチェックをいれて「Server」に「127.0.0.1」を入れ「Port」に「8107」を入れればokです。
結構無理栗なhackなのでHaikuPodのアプリケーションが落ちちゃったりする可能性もありますが僕は結構快適に使えてます。

今後の予定ははてなならではの機能をHaikuPodから使えるようにhaikupod.plを拡張してくネタをmixiが実装してくれたらいいですね。
なんでも一から作るのは大変ですが、この程度なら大変じゃなくて良い感じですね。

どうぞご利用下さい。

HTTP::Engine 0.0.13 リリースのお知らせ

昨日HTTP::Engine0.0.13をリリースしました。
今回は大きな変更になっています。

0.0.12までだと

use HTTP::Engine;
HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => { port => 9999 },
        request_handler => sub {
            my $c = shift;
            $c->res->body($c->req->uri);
        },
    }
)->run;

use HTTP::Engine;
HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => { port => 9999 },
        request_handler => sub {
            my $req = shift;
            return HTTP::Engine::Response->new( body => $req->uri);
        },
    }
)->run;

当初はcontext objectを使ってmiddleware等からcontext objectにメソッド生やして便利に仕様という意図があったのですが、mstやnothingmuchからは「contextなんてCatalystで大変になってるからやめようぜ」と提案されたり、実装を進めて行く上でcontextの必要性が少なくなってたり、有用な使い方を思いつかなかったのでcontextを削除しました。
ついでに、折角よりシンプルになるので未だに使い道がはっきりしないmiddlewareサポートも削除しました。

とはいえ、APIの互換性が急に無くなって慌てる人が居たら悪いのでanotherさんに足りないとDISられた公共心をフルに発揮してHTTP::Engine::Compatというのも同時にリリースしました。

use HTTP::Engine::Compat;
HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => { port => 9999 },
        request_handler => sub {
            my $c = shift;
            $c->res->body($c->req->uri);
        },
    }
)->run;

最後にHTTP::Engineをちっちゃいスクリプトで使いたい時にHTTPEx::Declareもversion upしました(FAIL (4)とか言われてるのであとで直す)。
新たに-Compatモードサポートとresが追加です。

use HTTPEx::Declare;
interface ServerSimple => { port => 9999 };
run {
    my $req = shift;
    res( body => $req->uri );
};

use HTTPEx::Declare -Compat;
interface ServerSimple => { port => 9999 };
run {
    my $c = shift;
    $c->res->body( $req->uri );
};

あともう一つHTTP::Engineには新たな要素があります。
0.0.12までは、request_handlerの中で使わないrequest objectの値(cookieとかrequest bodyとかheaderとか)までも全部作っていたのですが、0.0.13からは必要な時にlazyに作成するようになりました。
使うrequest dataを必要な時にENVやらSTDINから作成するのでアプリケーションによっては効率が良くなるはずです。

もうそろそろHTTP::Engineも要件が固まり来てコンセプト段階を終了しようと思う所ですがどうでしょうね?
仕様をフリーズさせてリファクタリングやらドキュメント作成やらCookbookやらを整備して0.1.0もしくは1.0.0のリリースする感じですかね。

ちなみにあたかも自分が全部やったように書いてるけどcontext削除の作業とHTTP::Engine::Compat作りはtokuhiromがやり、lazyなrequestの作業の大部分はnothingmuchがやりました。
僕はHTTPEx::Declareと全部のテストカバレッジ率を100%にしたのとリリース作業くらいしかしていません。

HTTP::Engine の今後について

trunkのHTTP::Engineのsubカバレッジが100%になった今日この頃皆様いかがおすごしでしょうか。

今現在はtrunkのテストカバレッジを高めた上で、lazy_requestブランチを本格的に採用すべく動いている所です。
nothingmuchによるブランチで、request関連の情報を必要になった時に作り出すような物になっています。
今までは(Catalystもそうだけど)clientからrequestが有るたびに使いもしないデータを最初に作ってたんだけど、そういった事が解消されます。
ただ、今の状態だとPOSTでfile uploadした時が上手く動かない。

lazy_request自体は外部インターフェィスは変わらない予定なので、別に互換性とかの問題は出ないはずなんですが、このブランチが落ち着き次第 HTTP::Engine::Context を無くすブランチを作る予定す。
今までは request や response の情報は $c に生えているメソッド $c->req や $c->res 経由でアクセスする感じでしたが、mstやnothingmuch曰く「context使うなんてCatalystの二の舞になっちゃうyp！(意訳)」といった提案を受けて、「結局 $c ある利点てそんなにないよね」って考えに至ったのでcontextを無くす方向で動こうと思います。
ぶっちゃけWAF側にcontextあったら、どのコンテキストがWAFのなのかHTTP::Engineのなのかわかんなくなって混乱しそうだしね。

sub handle_request {
    my $c = shift;
    $c->res->body($c->req->uri);
}

sub handle_request {
    my $req = shift;
    return HTTP::Engine::Response->new( body => $req->uri);
}

冗長になっちゃうんじゃ無いか?みたいな意見もありそうですが昔のnothingmuchのプランによると

sub handle_request {
    my $req = shift;
    return HTTP::Engine::Response::Redirect->new('http://example.com/');
}

sub handle_request {
    my $req = shift;
    return HTTP::Engine::Response::JSON->new({ foo => 'bar' });
    # 18:39 < t*kihirom>     return HTTP::Engine::Response::JSON->new({ foo => 'bar' });
    # 18:39 < tokihir*m> HATE HATE HATE
}

HTTPEx::Declareつかえば

use HTTPEx::Declare qw( res redirect );
interface {
    module => 'ServerSimple',
    args   => {
        host => 'localhost',
        port =>  1978,
    }
};

run {
    my $req = shift;
    return redirect('http://example.com/') if $req->uri =~ /redirect/;
    return res( body => 'hello' );
};

HTTP::Engine::Compat的なモジュールを使って、過去のHTTP::Engineアプリと互換性をなるべく保つようにする事も一応考えています。
HTTP::Engine->newするかわりにHTTP::Engine::Compat->newする感じで。

HTTP::Engineはなるべくシンプルであれというのが我々の共通認識であるのでcontextを無くす変更により、よりスマートになるんではないかと思っている次第です。
今まで時間があいた分を取り戻すかのように怒濤に進める予定。

ひどいプラグマ

miyagawaさんに教えてもらったhttp://juerd.nl/files/slides/2006yapceu/undef.htmlこれを見て驚愕したので。

package undef;
use strict;
use warnings;

my $undef = undef;

sub import {
    Internals::SvREADONLY(${\undef}, 0);
}

sub reset {
    Internals::SvREADONLY(${\undef}, 0);
    undef = $undef;
    Internals::SvREADONLY(${\undef}, 1);
}
1;

use strict;
use warnings;

warn "not" unless undef;

use undef;
warn "not" unless undef;
undef = 1;
warn "not" unless undef;
warn undef;

undef::reset;
warn "not" unless undef;
warn undef;

内部のPL_sv_undefを書き換えちゃうので、色々な物が動かなくなる事間違い無し。
open() or die;も動かなくなる！

Internals::SvREADONLY

404 Blog Not Found:perl - Const released -- True Readonly

実は、Perl 5.8以降では、Internals::SvREADONLY()という関数がuseなしで使えるようになっていて、Internals::SvREADONLY($scalar, 1)で$scalarをREADONLY flagをonに、Internals::SvREADONLY($scalar, 0)でoffにできます。

これは universal.c にて実装されていて、使い方は lib/Internals.t を見るべし。
Hash::Utilでも使われてるよ。

danさんの

ただし、これではscalarしかflagをいじれません。というわけで、同様のことをXSでやるようにするモジュールを書いたというわけです。

use strict;
use warnings;
my @values;
Internals::SvREADONLY(@values, 1);
push @values, 1;

Modification of a read-only value attempted at ./ro.pl line 5.

Internals::SvREADONLY($values[0], 1);

Internals::SvREADONLY(¥@values, 1);

なにが言いたいかというとConstがUNAUTHORIZEDだという事

Shibuya.pm tech talk #9 (XS nite)で発表してきました

Perl本体にパッチをあてる事無く動的に動いてるPerlのコアを書き換えちゃう事が出来るPL_checkやo->op_ppaddrなどについて発表してきました。
資料はそれなりなポインターとして使える風味なので、よろしければご覧下さい。
http://svn.coderepos.org/share/docs/yappo/20080625-shibuyapm9/shibuyapm9-pl_check-hacks.pl

Acme::NabeAtzz - VM崩壊!?　ナベアツ人気でPerlプログラマが悲鳴

小学校の算数の授業が崩壊しているというニュースがありますが、昨今のナベアツ人気とPerl VM hackのブームが融合して迷惑なCPANモジュールが誕生しました。

Acme::NabeAtzzをインストールして use Acme::NabeAtzz すると、PerlのVMオペコードの数値が3の倍数になるオペコードを実行する時にPerl VMがアホになってしまう迷惑なモジュールなんです。
例外無く全部の3の倍数のオペコードがアホになるので大変です。
もちろんPerl本体へのパッチは不要です。モジュールインストールするだけです。

興味が有る人はソースでも読んでみて下さい。
このネタは特に明日のShibuya.pmでは言及しません。

Acme::NabeAtzz - VM崩壊!?　ナベアツ人気でPerlプログラマが悲鳴

小学校の算数の授業が崩壊しているというニュースがありますが、昨今のナベアツ人気とPerl VM hackのブームが融合して迷惑なCPANモジュールが誕生しました。

Acme::NabeAtzzをインストールして use Acme::NabeAtzz すると、PerlのVMオペコードの数値が3の倍数になるオペコードを実行する時にPerl VMがアホになってしまう迷惑なモジュールなんです。
例外無く全部の3の倍数のオペコードがアホになるので大変です。
もちろんPerl本体へのパッチは不要です。モジュールインストールするだけです。

興味が有る人はソースでも読んでみて下さい。
このネタは特に明日のShibuya.pmでは言及しません。

perl-users.jp というサイトを立ち上げました

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

YAPC::Asia 2008 で Michael Schwern は「SEOに有効な独自ドメインを取って、もっとPerl初心者が集まりやすいniceなPerlの情報を集めたサイトを作れ！」といったのでperl- users.jpドメインを取って、ここにperl-users.jpを開始します。 以前よりShibuya.pm界隈では、初心者や複雑なPerlの話題をキャッチアップ出来ないPerl利用者をどうすくい上げるか、という議論を盛んに行って降りました。 Schwern の言う通り perl で検索してもなかなかいい情報にたどり着けなかったりと、それは酷い現状をどうにかしたい思いはYAPC::Asia 2008 のスピーカー陣共通の思いだと思っています。

index.html作ってサーバセットアップしただけで中意味は無いですが、SchwernのPerl IS unDeadみて感銘を受けた人は参加してみませんか?
議論は #shibuya.pm #yapc.asia-ja 辺りでやればいいのかなとも思ってます。

あーあとSEOよろしくお願いしますw

YAPC::Asia 2008 and SoozyCon #5 の資料だよ

まずは前夜祭のSoozyCon#5の資料
http://svn.coderepos.org/share/docs/yappo/20080514-soozycon5-yapcasia2008/yapcasia2008-http-engine.pl
HTTP::Engineの概要を話してきたよ。

そして昨日はPerlの%^Hの話だよ。
http://svn.coderepos.org/share/docs/yappo/20080515-yapcasia2008/
danさんの素晴らしさ、danさんを大切にしよう！と説いてきました。
ATの部屋が立ち見が出る程の満員でした、マニアっくすぎる話題なのに驚きです！

そしてさっき終わったのですが、デバイス気持ちいい話。
http://svn.coderepos.org/share/docs/yappo/20080516-yapcasia2008/yapcasia2008-device.pl
楽してデバイスで遊ぼうというお話でした。
X Japanのライブのインスパイアです。

Moose のコードを探索して理解を深めた

本日は Roppongi.PM の第一回 Moose コードリーディングがありました。

Mooseは、単純に使ってる分には分り易いのですが、その実装を見ようとすると途端に複雑さが増します。
とにかくメソッドの呼び出しのスタックが深い。MySQL程では無いにしろ曲者です。
今回はそんなMooseの挙動を把握する手がかりを掴もうという回です。

Moose.pm

Moose.pmは、主にuse Mooseされた時にexportするメソッドの定義をしています。
use Mooseすると、extends,with,has,before,after,around,override,inner,augment,make_immutable($c->meta->make_immutableすべき),confess,blessedがexportされます。
そしてMooseを実用的なパフォーマンスにするmake_immutableを、Moose::*のクラスに対して行ないます。
Mooseのコアクラス自信はimmutableなのです。

importメソッドの中で呼ばれるinit_metaが重要っぽくて、うまくまとめられないからリストだけする。
Moose->import;
- Moose::init_meta;
- $callerのpkgが登録されてるか調べる
-- find_type_constraint($caller_pkg) (実体は Moose::Util::TypeConstraints::find_type_constraint)
-- $caller_pkg が isa("Moose::Meta::TypeConstraint") だったら、$caller_pkgを戻す
-- じゃ無ければ
--- Moose::Meta::TypeConstraint::Registry->newしたインスタンスを Moose::Util::TypeConstraints が保持していて、そのインスタンスの->get_type_constraint($caller_pkg)
--- Moose::Meta::TypeConstraint::Registry のインスタンスの type_constraints が保持してるHASH refに$caller_pkgに対応する値を返す
- 登録なさげだったら登録する
-- Moose::Util::TypeConstraints::class_type($caller_pkg)
--- Moose::Util::TypeConstraints::create_class_type_constraint($caller_pkg)
--- class と name を $caller_pkg にしたhashを作って
---- Moose::Meta::TypeConstraint::Class->new(%hash)
---- ここで use Moose をしたクラスのクラスオブジェクトが作られるのです
---- _create_hand_optimized_type_constraint とか compile_type_constraint とかで、上で作ったオブジェクトの正統性をチェックする為のメソッドを作る。親クラスが居れば、それらの継承順位とかチェックしてるっぽ
--- 上で作ったオブジェクトを Moose::Util::TypeConstraints::register_type_constraint で登録
- Moose::init_metaに戻ってきた
- $caller_pkg->metaの正当性チェックするけど、そもそも meta method が無ければ $metaclass から meta class 作って $caller_pkg に meta method 生やすよ。詳細は下から
-- $metaclass は基本的に Moose::Meta::Class で Moose::Meta::Class->initialize($caller_pkg) で meta object 作る
-- Moose::Meta::Class の実体は Class::MOP::Class で Class::MOP::Class->initialize($caller_pkg, 'attribute_metaclass' => 'Moose::Meta::Attribute', 'method_metaclass' => 'Moose::Meta::Method', 'instance_metaclass' => 'Moose::Meta::Instance', @_) を実際呼んでる。
--- 一度作ったメタクラスは Class::MOP::get_metaclass_by_name($package_name) で取りだせる。 Class::MOP の %METAS に入ってる。
--- 1回も作ってなければ Class::MOP::Class->construct_class_instance して instance 作るよ
--- ちなみに Class::MOP::Class には make_immutable したときに作った anon class の後処理するための DESTROY method もあるよ!
- Moose::init_metaに戻ってきた
-- $meta->add_method で $caller_pkg に meta method を割り当てる
-- 実体は Class::MOP::Class->add_method( method_name, code ) になってるよ
-- code の部分は Class::MOP::Method の派生クラス(Moose::Meta::Method)や CODE リファレンスが指定できるよ。
-- CODE リファレンスの時は Moose::Meta::Method->wrap(code) で Moos::Meta::Method (Class::MOP::Method) オブジェクトを作るけどね
--- で add_package_symbol をするわけだが、これは Class::MOP::Method の親クラスの Class::MOP::Module の親クラスである Class::MOP::Package 樣に実装されている --- Class::MOP::Package->add_package_symbol( '&methodname' => code ) みたいにして登録する。&methodnameのぶぶんのsigilのチェックをしてるので&は必須だ
--- で、あとは一般的な手法の glob で method 生やす事をやっている。生やす対象は meta object が管理している class name (今の場合は $caller_pkg)だ
--- 最期に update_package_cache_flag を呼ぶのだ。add_method したときのおまじないか? Perl 5.10 世代じゃなきゃ Class::MOP の数少ない XS コードを使って PL_sub_generation という値をとって来てる。
--- 良く分らないけど get_method_map の中で使っていて(これはadd_methodするときに meta object に method を登録する部分で利用)を見て perldoc Class::MOP すると module の symbol table が更新されたかどうかが分るものっぽい
- Moose::init_metaに戻ってきた
- そんなこんなで、最期に superclasses がなければ superclasses を設定 (Moose::Object) して init_metaは終る
- superclasses の設定の中味は Class::MOP::Package->get_package_symbol('@ISA') とか使ってるのだ、簡単にいうと push @CLASSNAME::ISA, 'Moose::Object' と変わらないしょりだ

use Moose をするとこんな事になるわけだ。

meta method はどっからくるんだ?

use Mooseした側の meta method が生える仕組みは理解できましたが、その他の Moose::Meta::TypeConstraint::Registry とかにも、いつの間にか meta が生えてますね。
これは一体どこからくるのでしょうか?

答えは Class::MOP::Object にあります。
Moose::Meta::TypeConstraint::Registry の親クラスは Class::MOP::Object です。
Moose::Meta::TypeConstraint::Registry->meta を呼ぶと Class::MOP::Class された Moose::Meta::TypeConstraint::Registry のオブジェクトが帰るのです。

Moose の三賢者

Moose::Meta::Classの

sub initialize {
    my $class = shift;
    my $pkg   = shift;
    $class->SUPER::initialize($pkg,
        'attribute_metaclass' => 'Moose::Meta::Attribute',
        'method_metaclass'    => 'Moose::Meta::Method',
        'instance_metaclass'  => 'Moose::Meta::Instance',
        @_);
}

いわゆる not Moose な時の ClassName->new を Class::MOP->construct_instance が行なっている。
実体は Class::MOP::Instance->new->create_instance あたり。
construct_instance で作った instance に attribute を設定している。

attribute とは、何か? それは Moose::Meta::Attribute まわりの事であり、ざっくり言うと accessor もうちょっと具体的に言うと has の実装にかかわっているもの。

Moose::Meta::Attribute

__PACKAGE__->meta->add_attribute したら引数が Class::MOP::Attribute を継承するオブジェクトだったら Class::MOP::Class->add_attribute に飛ぶ
そうじゃなければ Moose::Meta::Class->_process_attribute に go
attribute name の先頭に + が付いてるときは、親クラスの attribute を継承して部分的に上書き出来て、そうじゃなきゃ全部上書きだよ
そうこうして Moose::Meta::Attribute->new されるんだよ。
実際は Class::MOP::Attribute に処理飛ぶんだけど、 has と Class::MOP::Attribute のオプションって互換性無いから _process_options でオプションを変換してるんだ。

is => 'ro' を reader にして trigger が指定されてないか見たり。

is => 'rw' を accessor にして trigger が指定されていたら CODE リファレンスか確認したり。

とにかく has のオプションの値チェックは _process_options に詰まってるんだ。

それが終ったら Class::MOP::Attribute->new される。
といっても bless するだけで終っちゃうけどね。

で、その new された Moose::Meta::Attribute のオブジェクトが Class::MOP::Class->add_attribute に引数として渡される。
attach_to_class で、 attribute object に attribute を保持してる側の context を渡す。
has_attribute して、既に登録されてる attribute name だったら remove_attribute しちゃう

そして install_accessors Class::MOP::Attribute->install_accessors してから Moose::Meta::Attribute->install_accessors が実行される。
Class::MOP の方は、さらに accessor の種類ごとに process_accessors が呼ばれて、普通の時だと Moose::Meta::Method::Accessor (Class::MOP::Method::Accessor) のオブジェクトが new される。
accessor 用の Moose::Meta::Method だと思えばおk
Moose::Meta::Method::Accessor はすっごい文字列 eval がんばってるけど、あんま気にしないで。普通に使ってる分にはあんまし使われない気がしてる。

Moose::Meta::Attribute の install_accessors は、 handles の処理を行なってる。

has 'name' => ( ... handles => ... )

たとえばこんな感じでつかえる。

use strict;
use warnings;
use Base;
use Class;
my $b = Base->new;
$b->foo(Class->new);
warn $b->foo;
warn $b->yappo;

package Base;
use Moose;
use Class;
has 'foo' => (
    is      => 'rw',
    does    => 'Role',
    handles => 'Role',
);
1;

package Role;
use Moose::Role;
requires 'yappo';
1;

package Class;
use Moose;
with 'Role';
sub yappo {
    warn "hoge";
}
1;

handles に Regexp リファレンス と CODE リファレンスを渡すことにより、delegation したいメソッドを指定する自由度が格段にあがる。
そして Role 使えば、 delegation したいメソッドのセットを使いまわせる。便利! でも Role の attributes は delegation できないっぽいす。
っぽいっていうか

        return map { $_ => $_ } (
            $role_meta->get_method_list,
            $role_meta->get_required_method_list
        );

最期に get_attribute_map に attribute を登録して add_attribute は終了。

Role

Moose を使うなら Role しなきゃモグリってぐらい重要な要素。これは Class::MOP には無く Moose での実装のみです。

Role ってのは、クラスの定義を決めたり前述の handles に指定して delegation をまとめてやっちゃえる実装定義のセットみたいなもんす。

Role する時は use Moose::Role だけでおk、 use Moose したときと同等 (Roleに特化してるけど)なメソッドが提供されます。
Role なクラスの meta object は Moose::Meta::Role が担当してくれます。
Moose::Meta::Role の親クラスは Class::MOP::Module です。
Role は実装本体ではなく実装の定義をあつかうので add_method や add_attribute を呼び出しても glob 操作でメソッド生やすとかはしません。
メソッドの定義とかを追加するだけです。
requires の実装も Moose::Meta::Role の add_required_methods して accessor に情報ため込んでるだけです。

ため込んだ情報はいつ使うのでしょう?
そう Moose.pm で実装されてる with を使ったときだ(あとは has の does や handles でも見られるけど。。。)
with の実体は Moose::Util の apply_all_roles メソッドである。
その後どう処理するかは、 with の引数の内容によりけりだが、単純な with 'Role' の場合だと Moose::Meta::Role->apply が呼ばれる。
さらに with を呼び出した側のクラスが Role なのか何なのかにもよって変わってくる。
要するに Role を何処に適用するかで Moose::Meta::Role::Application::x の x の部分が変わる。

今回は簡単に、Moose なクラスに普通に Role を適用する場合をみる。
実装定義を充たしているかのチェックは Moose::Meta::Role::Application::ToClass と Moose::Meta::Role::Application を読むと良い。
処理内容は

sub apply {
    my $self = shift;

    $self->check_role_exclusions(@_); # role check
    $self->check_required_methods(@_); # method が定義されてるか
    $self->check_required_attributes(@_); # nop

    $self->apply_attributes(@_); # Role で定義されてる attribute を class に install
    $self->apply_methods(@_); # Role で定義されてる method を class に install

    $self->apply_override_method_modifiers(@_); # 以下略

    $self->apply_before_method_modifiers(@_);
    $self->apply_around_method_modifiers(@_);
    $self->apply_after_method_modifiers(@_);
}

Role の中で has されたり sub foo {} されたり before, after, around, override されたものが全て適用されます。
もちろん with を使ってる側の meta object に、想像どうりのメソッドで追加されてきます。
Moose::Meta::Role::Application::ToRole なんてのもあるですが、それは Role の継承とほぼ等しいです。
ただし with は、 with した瞬間の Role をコピーするというイメージなので注意がいるかも。

before, after, around, override

最期に Moose を method hook する便利メソッドたち。(え? extends そんなの自分で読んで)

実体は Class::MOP::Class->add_(?:before|after|around)_method_modifierなんだ!
$fetch_and_prepare_method に入れられた CODE リファレンス (たぶん外部からどうあがいても弄れない実装にしたかったんだろう)を使って、hook したいメソッドを取りだす。
厳密には Class::MOP::Method::Wrapped のオブジェクトにして返す事をしている。
can を使わずに C3 な継承リストからメソッドを探すのがポイントかな。(これは Class::Component::Component::Moosenize でもやろう)
あとは、hook したいメソッドは Class::MOP::Method::Wrapped のオブジェクトにつつまれてるので、 hook point に対応したメソッドで hook すれば簡単に hook できちゃう。

よしOK、 Class::MOP::Method::Wrapped の中身を見てみよう。
Class::MOP::Method::Wrapped->wrap に、 wrap したいメソッドを入れて使うんだよね。
で、 wrap が呼ばれる度にメソッドの before, after, around のテーブルが書き換わって、 hook されたメソッドがちゃんと動くような anon method を作ってくれるんだ。
add_before_modifier, add_after_modifier なんかはスタック溜めるだけ、 add_around_modifier はちょっと複雑だけど、ちょっとしたくふうで a( b( c( orig() ) ) ) の構造でメソッドをつつんでくれるんだ。
元もとメソッドが定義されていたとしても glob 操作で Class::MOP::Method::Wrapped なメソッドで上書きしてくれるから安心設計だよ。
あと、1回 Class::MOP::Method::Wrapped->wrap されれば add_method されるので、 before, after, around なんかのスタックはちゃんと保持されてる。

ああ、そうだ override を忘れていた。
こいつは Moose::Meta::Class->add_override_method_modifier を使ってる。
そこから Moose::Meta::Method::Overriden を使ってるんだけど
これって使い道よくわからん、 extends したクラスのメソッドを上書きするのに使うみたいだ。
素のメソッド上書きやるよりは Moose 使ってるときは override して上書きしとけだと思うけど。
利点は @Moose::SUPER_ARGS に引数が入っていて $Moose::SUPER_BODY に親クラスのメソッドの CODE リファレンスが入ってる事かな。
と思ったら、 override で上書きしたメソッドの中で super() すると my $self = shift; $self->next::method(@_); と同等になるのか。

augment, inner は、 override, super の逆バージョンって事でおk

そのほか

has の時の値の set/get は Moose::Meta::Attribute の set_value/get_value を見よ。

Immutable

マジックみたいなもんだし、そもそも make_immutable しなくても良いのは小学生までだよねーと mst が言っていたので、ここは書かなくておk

さいごに

いつものように Moose まともに使ってないから、そこんとこよろしく。

HTTP::Engine - Perl版 WSGI のような物、 Catalyst::Engine を抜き出したような物

先週のCatalystConでHTTP::Server::Wrapperというのを発表したのですが、やっぱり名前長いしわかりにくいよねということで、HTTP::Engineという名前でやり直して CPAN に上げました。
http://search.cpan.org/dist/HTTP-Engine/
実は Catalyst の svn repos に HTTP-Engine のディレクトリ掘ってある事は知っていたんだけども、4ヶ月くらい前に作ってからそれっきりっぽいので、DISられ覚悟でうpたわけです。

簡単に説明すると、mod_perlやfastcgiやHTTP::Server::SimpleやPOEやCGIなど様々なWebエンジンを透過的に扱って簡単にフレームワークとか、ちょっとしたオレオレWeb Serverが楽に作れるモジュールです。
PythonでいうとWSGI、RubyでいうとRackのPerlバージョンと考えて下さい。
昔から Catalyst::Engine と Catalyst::Request と Catalyst::Response だけ分離して使いたいよねという話が持ち上がってて、話すだけで実装する所まで行かなかったんですが、CatalystConがあったので Class::Component ベースで作ってみたくなって作りました。

最初のうちは CodeRepos の中でちまちまコンセプト作り上げて YAPC::Asia あたりで外に出して Catalyst::Engine 置き換えようよ！とか Jifty で HTTP::Engine 使おうぜ！とか無茶言おうと思ってたのですが、よく考えたら CodeRepos には Jesse が居たわけで
斜め翻訳すると HTTP::Engine よさげなら Jifty で使ってみたい的な事を言ってた様子。

で、いつの間にか mst の耳にも入っていて、 mst から　mail が来たので #catalyst-dev に行ってみたら HTTP::Engine ktkr!状態になってました(かなり意訳)
あちらさんも、まえまえからやろうやろう行ってたけど実行出来なかったよんという感じみたいでした。

なんだか、昨夜から怒濤の展開でようやく今追いついたのでエントリ書いた次第。

とりあえず今は HTTP::Engine というのは、どういった形にすればいいというコンセプトを決めるフェーズなので、安定とかそういうのはほど遠いですが興味有る人は開発参加して下さい。今がチャンス！
irc.perl.org の #http-engine に専用チャンネル作ってますです。
とりあえず今は tokuhirom が　Moose 版 の HTTP::Engine を作って盛り上がってる所。

HTTP::Server::Wrapper と CatalystConの発表資料

Cisco Catalystシリーズの勉強会という事で参加したのに、全然違うPerlとか良くわからないやつの勉強会でした。
とりあえずCatalystにログインした所からスタートしたんだけど反応がなくて、enした辺りでようやくhiroseさんが笑ってくれました。
とりあえずshow confしたけど無反応で酷い温度差でしたね。

なんだかサンフランCiscoとかPlugin使わないよJKとかいう言葉が飛び交ったり、発表者全てがCatalystをDISっていましね。
nothingmuchがスペシャルゲストとして来てくれたお陰でプチYAPCというか前々前夜祭くらいのノリになっていました。

しょうがないのでCatalyst::Engineを抜き出して再利用できるようにしたHTTP::Server::Wrapperというのを作ったので、それのプレゼンを行いました。
超簡単に説明するとWSGIのPerlバージョン
ただCatalyst::Engineを抜き出しても拡張性がなさ過ぎでいけてないので、Class::Componentを使ってプラガブルに風味にしてあります。
Session処理とか認証処理なんかは基本的にWAF側じゃなくてエンジン側の仕事じゃないかと思っているので、そのあたりもサクッと作れるようにしたい所です。

資料はhttp://svn.coderepos.org/share/docs/yappo/20080422-catalystcon1/catalystcon.pl
一応Partty.orgで録画してあります。
コードはhttp://svn.coderepos.org/share/lang/perl/HTTP-Server-Wrapper/trunk/から。
もうちょっと形を整えたらCPANします。
ついでにhidekさんが開発してるOkinaというWAFにもHTTP::Server::Wrapper対応しときました。

HTTP::Server::Wrapperを使うと本当に簡単にHTTPサーバを内蔵したアプリが書けます。
もちろんWAFとかをこれベースで作るとEngine処理にからむPluginを使い回せるのでとても良いです。
設定

using_frontend_proxy: 1
plugins:
    - module: Engine::Standalone
      conf:
        host: 0.0.0.0
        port: 14000

use strict;
use warnings;
use lib 'lib';
use HTTP::Server::Wrapper;
use Data::Dumper;
HTTP::Server::Wrapper->new('config.yaml', handle_request => sub {my $e = shift; $e->env('DUMY'); $e->res->body(Dumper($e)) } )->run;

HTTP::Server::Wrapperを使ったサーバを書くのは非常に簡単で、newする時に handle_request メソッドを定義すると、ブラウザからアクセスがあるたびに定義したメソッドが呼ばれます。
引数は今の所Engineのコンテキストです。
$engine->req で Catalyst::Request 相当。
$engine->res で Catalyst::Response 相当。
のオブジェクトにアクセスします。

いまコミットしてあるのはコンセプト的な実装で、とりあえず動かすためにSoozy::(?:Engine::HTTP|Request|Response)からのコピペです。
実際これらの大部分はCatalystからのコピペなので、Catalyst::Engineを切り離した感じ。
というコンセプト実装なので、これからより実用的に使えるように皆で変更していったらいいと思います。
名前もそれっぽいのになるといいよね。

ある程度実用的になったらCatalyst::Engine::Wrapperとか書こうと思う。
どうぞご利用下さい。

CodeReposのコミット時のrule撤廃とか

今までCodeReposにコミットする時はプロジェクトパスを入れろてきなルールが合ったのですが、hanekomuや自分を始めとする皆の不満がつのったし、そもそもそんなの機械的にやればよくね?という話も前からあったのでJesseがCodeReposに来たのを記念してルール撤廃しました。

そもそも何であんな変なのがあったかというと、ircbotやfeedで見た時にプロジェクト名がわかり易い方がいいって理由だけだったはず。
それなので、Commit Pingを受け取ってFeedを吐くサーバを書きました。
サーバのコードはhttp://svn.coderepos.org/share/websites/coderepos.org/feedmaker/
Feedはhttp://coderepos.org/feeds/share.xml

でCodeReposのCommit Pingを便利に扱うためだけにCPANモジュールもこしらえました。
Data::CodeRepos::CommitPingです。
Commit Pingのページの下部に書かれたURLのリストにたいして順番にcommitデータのPOSTをするだけなので。
サーバ側で

my $coderepos = Data::CodeRepos::CommitPing->new(CGI-new);

どうぞご利用ください。

HTML::StickyQuery::DoCoMoGUID - iモードIDを使いたい人に朗報

ふと思い立って、DoCoMoが新しく始めたiモードIDを取得するためのリンクを既存のHTMLにたいして簡単に付与出来るモジュールを書いた。
HTML::StickyQuery::DoCoMoGUIDといいます。
使い方はPOD見てね。

iモードは昔からセッションを維持するにはURLのクエリパラメータやPOSTの値にセッションIDを入れないと駄目だったのですが、先月末からクエリパラメータの中にguid=ONが入っていればRequest HEADにiモードIDを入れてくれるようになったんですね。
HTML::StickyQuery::DoCoMoGUIDは渡されたHTMLの中にAタグがあればクエリパラメータにguid=ONを追加してくれるというフィルタモジュールです。
もちろんAタグだけじゃなくてFORMにたいしてもうまく動きます。
FORMの場合はmethodがget/postでguidを入れる方法が違ってくるのですが、これも考慮してくれます。

名前空間が物語っているように、HTML::StickyQueryのラッパー的な実装なのです。
HTML::StickyQueryだとFORM周りの処理をしてくれないのですが、HTML::StickyQuery::DoCoMoGUID側で処理出来るようにちょっと拡張してたりします。
何故かguidの処理をしないモードが搭載されているのでSledgeの

# XXX we need HTML::StickAny or something ...

なんでそうやってるかって言うと、iモードIDはhttpsの時に動かないのでECサイトとか作る時には結局HTML::StickyQueryとかでセッションIDを埋め込む必要が出てくるので、iモードIDを取りつつセッションIDを埋めときたいといった需要が満たせるのですね。
一見いままでと変わらなさそうですけどもiモードIDは契約者に対してユニークな物が割り当てられてるので、どんなURLからサイトに訪問されてもセッションIDが使い回せる利点があるのですね。
セッションID入りのURLをブックマークしてもらう必要とかが無くなる。

正直、今までHTML::StickyQueryとか使ってなかったので、現在は別のべすとぷらくてすがあるかもですが、もし無いようでしたらどうぞご利用下さい。

Class::Component 0.14 でてました

HTTP::MobileAttributeと共に成長期に入っているClass::Componentですが、先週末にバージョンアップしちゃってて今回は二つの機能追加を行ってました。

一つめはregister_methodで、登録するmethodとしてpluginで実際に定義されていないメソッド名を利用出来るようになりました。

package Foo::Plugin::Hoge;
use base 'Foo::Plugin';
sub bar : AliasMethod('baz') {}

$self->call('baz');

もう一つは、Attributeと実際のpackage名との対応付けを変更出来るためのhook point追加です。
普通は

package Mixi;sub foo: Boofy {}

package Mixi::Plugin;
use strict;
use warnings;
use base 'Class::Component::Plugin';

sub class_component_load_attribute_resolver {
    my($self, $attr_name) = @_;
    my $new_name = ($attr_name eq 'Boofy') ? 'Bonnu' : $attr_name;
    "Mixi::Attribute::$new_name";
}
1;

どうぞご利用下さい。

WebService::Simple::Cabinet をリリースしました。

erogeekの処女作のWebService::Simpleが普通過ぎてドン引きしていた所、これを使ったモジュールの実装アイデアを夢の中で思いついたので、起きて速攻で実装しました。

WebService::Simple::Cabinetって言います。
昨日ちょろっと作ってみた所、面白そうとブクマされたのでCPANにうpしたけどindexはまだみたい。
リポジトリはhttp://svn.coderepos.org/share/lang/perl/WebService-Simple-Cabinet/trunk/からどうぞ。

何をする物かというと、miyagawaさんがWSDL/WADLっぽいって言ってたけどWSDLとかの説明が一番しっくりきました。
WebService::Simpleを使って簡単にアクセス出来るようなAPIを更に簡単に使えるような仕組みです。
base_urlや各種パラメータ等を定義しておいて、APIを使う時に定義を読み込んで動的に必要なメソッドを作ってくれるのです。
WebService::Simple自体が非常に単純なんですが、Cabinet使えば更に簡単なメソッドでAPI叩けるようになってグーです。

書き方はmattnさんが書いてくれたlinger.plを見るとわかり易いです。
しかしこれ、一々定義YAMLをscriptに書いてあって無駄っぽいかもしれません。
本来はPlaggerのassets以下に入れられるEFTの設定ファイルみたいなとことに各種APIの定義をおいておいて、newする時に定義名を呼べば済むようにしたかったのですが、具体的に何処におけばいいかのアイデアが出てこなかったので、まだ未実装です。
WebService::Simple::Cabinet::Declare:: 以下にDSLっぽい文法で書いて置いておくアイデアもあったりします。

もともと夢の中で閃いたアイデアなので、どんな所で実用的か説明しろと問いつめられても答えに困りますが、wrapper簡単に書けたり、「なんでPerlにはLDRの購読数をwatcheするためのモジュールが無いんだよ！オレあんましそういうモジュール書けないけど欲しいんだよ！」みたいな人でもYAML書くだけでもオレオレwrapperが作れるのでいいんじゃないかなと思い始めました。

どうか皆さんでコードいじって夢の有るモジュールにしてください。

ちなみに名前の由来はmixiのmikioさんに聞いて下さい。

Class::Component 0.13 リリースのお知らせ

昨日リリースしたばっかりですが、今回はHTTP::MobileAttributeが遅いので何とかしようと色々と最適化していきました。
たとえば前回はattributeの引数を使い易くしたんですが、その解釈に文字列eval使ってて遅いので、なるべくキャッシュするようにしました。
単純にキャッシュしちゃうと不具合がある場合もあって(code ref使うときとか)その場合は、キャッシュさせないようにPlugin単位で制御出来ます。
attributeのキャッシュしないPluginには

sub class_component_plugin_attribute_detect_cache_enable { 0 }

ボトルネックになっちゃってる所をごっそり書き換えたりしてるわけですが、Class::Componentはそれなりにテストを充実させてるので気楽に書き換える事が出来ました。

Class::Componentの使い方によって単純に比較出来ませんが、HTTP::MobileAttributeでは今回の最適化で6倍くらい速度が上がりました。
HTTP::MobileAttributeはそれ以外にも色々最適化が施されていて、昨日のリリースの時から比べると126倍速になってHTTP::MobileAgentより2倍遅い程度まで速くなってます。

Class::Component 0.11 リリースのお知らせ

Class::Component使ってるアプリはPluginで使える独自のAttributeを簡単に実装できるわけですが、そのときはattributeへの引数的な物が使えるのですね。

sub migi : Karada ('hikisuu') {}

sub migi : Karada ('hikisuu', 'ippai') {}

何でかって言うと、この部分はCatalystから略な感じだったので、もうちょっと使い勝手良くしたいよ！という事で、attributeへの引数の使い勝手が良い事で有名なAttribute::Handlerから盗んできました。

こんな感じのコードが書けます。

package MyClass::Plugin::ExtAttribute;

use strict;
use warnings;
use base 'Class::Component::Plugin';


sub args_0 :Method Dump {}
sub args_1 :Method Dump('hoge') {}
sub args_1_2 :Method Dump("hoge") {}
sub args_2 :Method Dump('hoge1', 'hoge2') {}
sub args_2_2 :Method Dump('hoge1', "hoge2") {}
sub args_2_3 :Method Dump("hoge1", 'hoge2') {}
sub args_2_4 :Method Dump("hoge1", "hoge2") {}
sub args_2_5 :Method Dump(qw(hoge1 hoge2)) {}
sub args_2_6 :Method Dump(qw/hoge1 hoge2/) {}

sub ref_array_1 :Method Dump([1,2,3,4]) {}
sub ref_array_2 :Method Dump([qw/1 2 3 4/]) {}
sub ref_array_3 :Method Dump([qw(1 2 3 4)]) {}
sub ref_array_4 :Method Dump(["1",'2','3',"4"]) {}
sub ref_array_5 :Method Dump(['1', '2', '3', '4']) {}
sub ref_array_6 :Method Dump(["1", "2", "3", "4"]) {}

sub hash_1 :Method Dump(key=>'value') {}

sub ref_hash_1 :Method Dump({ key => 'value' }) {}
sub ref_hash_2 :Method Dump({ key => { key => 'value' } }) {}

sub ref_hash_array :Method Dump({ key => [qw/ foo bar baz /] }) {}

sub ref_array_hash_1 :Method Dump([ 'foo', { key => 'value' }, 'baz' ]);
sub ref_array_hash_2 :Method Dump('foo', { key => 'value' }, 'baz');

sub ref_code_1 :Method Dump(sub { return 'code' }->()) {}
sub ref_code_2 :Method Dump(sub { _code }->()) {}
sub ref_code_3 :Method Dump(sub { _code2 4, 5 }->()) {}

sub run_code_1 :Method DumpRun(sub { return 'code' }) {}
sub run_code_2 :Method DumpRun(sub { _code }) {}
sub run_code_3 :Method DumpRun(sub { _code2 4, 5 }) {}

sub _code {
    '_code';
}

sub _code2 {
    $_[0] * $_[1]
}

1;

あとはClass::Component::PluginのPODをちょっと書き換えて、Proj::Plugin::*の各プラグインはuse base 'Class::Component::Plugin';って感じで直接Class::Component::Pluginを継承せずに、一度MyProj::Pluginを被せてから使ってね！
というポリシーに変更しました。
何でかって言うと、各モジュールごとにinitフェーズ書き換えたりとか便利メソッドをMyProj::Pluginの方に書いて便利にして欲しいからですね。
今回からattributeのパースの挙動も変更できるようになったしね。

若干Attributeの挙動を帰るため、自分が把握してる限りの所で影響でないか裏取りした後にリリースしました。
そんなわけでCPANには上げてあるので順次落とせるようになります。

I got the yapc.asia domain

まだ取れる状態だったので、いいですねーの波が来て取ってしまった。
malaに怒られないように

HTTP/1.1 307 Temporary Redirect
Location: http://conferences.yapcasia.org/ya2008/

http://yapc.asia/

デブサミ2008の発表資料、MacでバランスWiiボードのデータを取れるコードとプレゼンツールPlusenの公開

はてなが京都に帰ってしまう発表に盛り上がっている昨今みなさまいかがお過ごしでしょうか。
京都に帰るのははてなと任天堂が提携して、はてなワールドの移動がバランスWiiボードで出来るようになる為だと思い、その可能性を感じられるようなプレゼンをして来たので報告します。

デブサミの資料

早めに資料公開しないと放置してしまうので公開しました。
http://svn.coderepos.org/share/docs/yappo/devsumi2008/
頑張っても動かせない場合はdevsumi2008.plにテキストで文章が書いてあるので読んで下さい。
このディレクトリに置いてある.plファイルは、そのまま下記で紹介するPlusenとMac::WiiRemoteのサンプルにもなってます。

デブサミの動画

今回もcojiさんが動画の録画とニコニコへのうぷぉやって下さいました。
詳細はきっとtakesakoさんのところで書かれるのかもです。
coji++ Yoshiori++

失敗時

リベンジ

発表の様子

今回は、本番でOSが固まってプレゼンが出来ない刑を食らったので皆さんには大部ご迷惑をおかけしました。
なんでトラブったのかというと、物理的な準備に時間がかかるためkoizukaさんのプレゼンの前に全てセットアップしてプレゼンツールを起動していたのですが、CPUに負荷かけまくるプレゼンツールだったので、自分の出番が来る前にOSが超不安定になって制御不能になったわけです。
ぱっと見て動いてるのに実は動かなかったりTermが起動しなかったりvimが動かなかったりして、ようやくPCでプレゼンするのを諦めた頃には時間切れ直前でkazuho methodで発表も出来なくなってました。

せっかく矢印キーが壊れてもwiiリモコンで操作できたり、ブラウザ落ちてもターミナルに直ぐ切り替えたり、VGAとかスクリーンが壊れてもVFDで表示出来るようにプレゼンとしては凄く気の利いた冗長構成を取っていたのに、単一障害点のOSが逝ってしまうなんてプレゼンでは何が起きるかわかりませんね！
次は自分の端末が壊れても瞬時に別の端末でプレゼンする仕組みでも考えます。

大失敗してしまったものの最後の最後に無理矢理割り込みでリベンジ発表をするチャンスを頂けました。
takesakoさん並びに関係者や来場者の方に感謝です。ありがとうございます。
発表の内容も一人だけお題とズレすぎてしまってサーセン。

プレゼンはというと、会社で作ったコミュニケーション可能な検索サイトの紹介をしつつ、最近作り込んでるPlusenの紹介をしようとしてたのですが時間の都合上Plusenの紹介メインになっちゃいました。
内容は、MacBookにWii FitのバランスWiiボードとWiiリモコンとVFD電光掲示板とロケットミサイルランチャーを接続して、Wiiボードの右側に乗るとページが進んだりWiiリモコン振り回すとページが進んだり、ページが進むとミサイルランチャーが動いたりしつつ、スクリーン上ではFirefoxもしくはターミナル上にプレゼン内容が表示され、VFDにも内容が表示されるという、デバイスコミュニケーションをテーマとした発表でした。
Wiiボードを踏まないとページが進みにくいので、時間も足りない事もあって文字通り駆け足でページを捲りつつ発表しました。このへんのおかしさは動画じゃないと伝わらないけど、そのうち発表の様子をニコニコにうpしていただけるという話です。

プレゼンツールPlusen公開

動画でなくても面白い物として、今回発表したプレゼンツールPlusenをようやくCodeReposにコミットしました。
http://svn.coderepos.org/share/lang/perl/Plusen/trunk
SoozyCon#4とかで、はてなワールドにbotをjoinさせて、そのbotにもプレゼンの内容をリアルタイムにさせてたアレです。
Plagger的に様々なデバイスをプラガブルに組み合わせられるプレゼンツールになってます。
Class::Componentを使ってるお陰でメチャクチャコードがシンプルになってますYappo++
目下の目標は、今のPlusenは画像とかの表示やブラウザ側でダイナミックな表現が出来ないのでamachangのS6とかを組み込んでかっこ良くしたい！
色んなプレゼンメソッドを統合していけたら便利になりそうす。

SoozyCon#3では、PlusenのプロトタイプとしてFireVFDという物を使っていました、これはMozReplとVFDデバイスを組み合わせたツールです。
これをClass::Componentでプラガブルにし、プレゼンの内容の出力先をはてなワールドやirc等も追加出来るようにしたのがSoozyCon#4で使ったPlusen初期型です。
これでも納得がいかなくても少し書き直したのが今のPlusenです。
ここ最近のプレゼンは全部Plusen系列でやってたので資料公開が出来ずにいたですが、Plusen公開した事だし過去の出せてない資料を上げてく予定。

今回の目玉

で、一番面白い物としてはWii Fitの板のデータをPerlから取得出来るようにしたMac::WiiRemoteの公開ですね。
http://svn.coderepos.org/share/lang/perl/Mac-WiiRemote/trunk/
WiiRemoteFrameworkとCamelBonesが必要です。
WiiRemoteFrameworkをwii fitに対応させるパッチが入ってます。WiiRemoteFrameworkにパッチをあててxcodeでビルドして下さい。
詳しくはPODにあります。

ちょっと前にWindowsでWii Fit体重計ソフトが出て話題になってましたが、Macから弄る方法が良くわからなかったので、Windowsのソフト作った方の解析結果とかを参考にしながらWiiRemoteFrameworkのコードを書き換えてみました。
MacでWiiリモコンを使えるソフトで有名なDarwinRemoteが利用しているライブラリです。
両方ともコードが公開されているので自分でも作る事が出来ました。すばらしす。
ちなみにperlの実装はRubyとWiiリモコンをつなぐ - urekatのスカンク日記３を参考にしました。

うちのCamelBonesでは何故かオブジェクト通信とかいうやつが上手く動かないので、同梱のパッチではCamelBonesで上手く動くようにするパッチも入ってます。
あとでWiiRemoteFrameworkを作ってる方にもパッチ送らなきゃいけないすね。

CamelBonesが必須という所でピンとくると思いますが、WiiRemoteFrameworkはObjective-CでかかれたCocoaのなんかです。
なのでPerlじゃなくてもRubyCocoaつかったりPythonとかJavaとかからでもMac上のWii Fit弄れるようになれます！PHPもできたっけ?適当にググっても何か出ない。
CocoaだかObjective-Cだか何だかわからないけど、とても簡単で面白いです！空前のCocoaブーム到来してますし皆もCocoaアプリ書けばいいよ！

もっかの悩みはNSRunLoop->currentRunLoop->runを使ってWii FitのをハンドリングしようとするとDanga::Socketとかと連携出来ない所。

そういえば

控え室で機材テストしてたらYoshioriさんに「俺もやろうとして作り始めてたのに先にやられたー！」と大変残念がっていました。
Wiiリモコンプレゼンは速攻でみんながやりだしてて萎えたけど、Wii板は皆一斉にやってなさそうなので一歩先に進めましたね！やりましたね。

とにかく皆様お疲れさまでした。うん本当に疲れた。走りすぎた。

Wiiフィット(「バランスWiiボード」同梱)

posted with amazlet on 08.02.15

任天堂 (2007/12/01)
売り上げランキング: 6

Amazon.co.jp で詳細を見る

WWW::HatenaLogin - はてなにログインするだけのモジュール作った

はてなのサービスにログインした状態をスクレイピングして利用したい時にや、そういったモジュール(WWW::HatenaDiary)を作りたい時になると気になるのが、毎回毎回https://www.hatena.ne.jp/loginをスクレイピングするのは面倒だなぁと思ったので、WWW::HatenaLoginというログイン処理に関する事しかしないモジュールを作りました。
作ったとはいっても、殆どがWWW::HatenaDiaryからのコピペです。
WWW::HatenaDiaryのログイン部分だけ抜き出してCPANモジュール化した感じですね。

codereposはhttp://coderepos.org/share/browser/lang/perl/WWW-HatenaLogin/trunkです。
CPANにもupload済みで、予定地はhttp://search.cpan.org/dist/WWW-HatenaLogin/ です。
CPANに上げてるテストには含まれてないけど、codereposの方はConfig::Pitを使ってhatenaアカウント情報を取得してテストするコードにしてみました。

やってくれる事はWWW::Mechanizeを使って、はてなにログインとログアウトを行います。
ログイン後のWWW::Mechanizeのオブジェクトがそのまま利用出来るので、簡単にログイン後のはてなをスクレイプできます。
当然cookie_jarも取れるのでLWP::UserAgentで処理を書く事も出来ます。

naoyaさん謹製のHatena::API::Authとの違いですが、naoyaさんのは「はてな認証API」をの為のモジュールで自分のはWebブラウザから使うログインフォームからPerlでログインする為のモジュールという違いです。

早速WWW::HatenaDiaryがWWW::HatenaLoginを使うようにしたブランチを切っりましたので、サンプル的なコードを見たい方は、そちらでどうぞ。

autobox の実装を調べたのと tokuhirom のパッチを発展させた

Perl界隈で熱いと噂のautoboxの実装を調べたりtokuhiromパッチを発展させてみました。
autoboxはsexy。

このエントリのまとめ

本文が長過ぎるので先にまとめを書く。

autoboxはPerlの内部実装をhackして、とてもスマートに実装されたモジュールだというのがわかりました。
一カ所だけアクロバティックな事してますが、それ以外は無理無く実装されていて普通に使う分には十分使えるものっぽいというのが判った。

tokuhiromのパッチの件

tokuhiromのパッチはINTEGERとかFLOATとかSTRINGを別けて扱える様になって良いんだけど、既存のSCALARを拡張したautobox::Encodeとかが動かなくなってとても困るので更にパッチを書いた。
取得はhttp://tech.yappo.jp/tmp/autobox-tokuhirom-yappo-2.patchから。

@ISAにSCALARを突っ込めば良いじゃんという話もありますが、@ISAに突っ込んでしまうと意図しないメソッドまで継承してしまう可能性があるので、INTEGERパッケージにメソッド等が定義されていなければ、利用するパッケージをSCALARパッケージに切り替えるという事をやっています。
もし継承させたいなら、利用者が明示的に

@INTEGER::ISA = qw( SCALAR )

とりあえず既存のautoboxのテストが動く状態になったので、追加された要素のテストを書いてchocolateboyにパッチを送ってみようと思うのですが、いかがでしょうか。
2個以下の時はSCALARってのがad hoc過ぎる気がするのが気がかりですが。

ここから本編

物凄くざっくりとコードを読んだ時にメモしたりしたので、もったいないので公開しときます。
だいぶザックリとしてるので信憑性に問題があるかもしれません。
それでも問題無いよ、という人だけ読んで下さい。

autobox.pm

autobox.pmは、importでレファレンスタイプをどのパッケージに割り当てるのか、hintsを使ってuse autoboxをしている側のローカルスコープの中だけでautoboxされる様に良きにはらってくれる。
unimportも実装されてるけど使いどころを良く知らない。

ではautobox::importの処理を簡単に追っていきましょう。

use autobox SCALAR => 'MySCALAR'

hintsの操作もimportでやっている。
0x20000 だけでいいんだけど %^H 周りのバグがあるらしくて 0x100000 も追加しておかないといけない。
これをやる事により　%^H の中身がスコープの中でしか有効にならない。
もっというと use autobox されたスコープの中でのみ有効になる。

$^Hとか%^Hのいわゆるhint情報は、コンパイラが動作する為のヒント情報なのでBEGINフェーズ中でしか意図どおりに動かない。
下記のコードは意図どおりになるが

use strict;
use warnings;
BEGIN {
    $^H |= 0x120000;
    $^H{hoge} = 'start';
}

BEGIN{warn $^H{hoge}}
{
    BEGIN{$^H{hoge} = 'YYY';warn $^H{hoge}}
    BEGIN{warn $^H{hoge}}
}
BEGIN{warn $^H{hoge}}

use strict;
use warnings;
$^H |= 0x120000;
$^H{hoge} = 'start';
warn $^H{hoge}
{
    $^H{hoge} = 'YYY';warn $^H{hoge};
    warn $^H{hoge};
}
warn $^H{hoge}

最後にautobox.xsの中にあるenterscopeを呼び出す。
enterscopeは後述するが、perl内部のフックをautobox用に入れ替える。
遂になる物としてはleavescopeがあり、これはautoboxのスコープが抜けた時に元に戻す処理をしている。
スコープが抜けたという事は0x20000のhint bitsと%^HとScope::Guadを上手く組み合わせて実装している。

Scope::Guadというのは以下のような事をやります。

if (1) {
    my $sg = Scope::Guad->new(sub { } ); # DESTROYした時に呼ばれるコードを登録
    # ... 処理
}# ここで登録したコードが呼ばれる

use autoboxされたスコープを抜けるとScope::GuadのインスタンスもDESTROYされる事になり、Autobox::leavescopeが呼ばれる事になる。
なんでDESTROYされるかというと、%^Hの中にScope::Guadのインスタンスを入れとくので、スコープ抜けると%^Hのなかがクリアされるので、Scope::GuadのインスタンスがDESTROYされるのである。

importの中に書かれたらimportのスコープを抜けた時点でDESTROYされるじゃないか。という突っ込みもあるかもしれないが、useされた時はどうやら別物らしい。

autobox.xs

次はいよいよautobox.xsの中身だ！
autobox.xsにはAutoboxというpackageに属する、enterscope,leavescope,ENDという3個のメソッドが実装されている。
ENDは、いわゆるENDフェーズのアレだから省略する。

leavescope

autoboxの影響化を抜けた時に後述するenterscopeで入れ替えたメソッドを元に戻す。

enterscope

Autobox::enterscopeは、use autoboxされた時に呼び出される、autobox::importの最後の処理でenterscopeを呼び出している。
何をやっているかというと、PerlのVMのとあるフェーズで実行される処理を差し替えている。
具体的にPerl本体のコードで言うと、opcode.hの

EXT OP *(CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {

何を差し替えているかというと、OP_METHOD_NAMEDというOO的なcodeで指定されたmethodが存在するかといったチェックとかをやるフェーズっぽい。
本来はop.cのPerl_ck_nullが登録されてるので、何をやるべきかわかってない。
で、autobox.xsのautobox_ck_method_namedに差し替えられている。

autobox_ck_method_named

use autoboxされたスコープの影響範囲にいなければ本来の処理と同じ挙動になる。
影響範囲にいる時には、$^H{autobox}の中に入っている handler table をPL_hintgvから取り出しておき、autoboxの胆となる処理が走る。

autobox_method_named

このメソッドがautoboxの肝。
ここで呼ばれたメソッドがどういう形（"hoge"->foo, 1->foo, []->foo, {}->foo）で呼ばれるのか、何のリファレンスタイプで呼ばれてるのかを調べている、具体的にはtokuhiromのpatchしてる辺り。
そして、リファレンスタイプに対応するhandler tableに登録されてる実際に使われるpackage nameを取り出す。
gv_stashpvnというのは指定されたパッケージ名に紐づけられたhashを取り出すもの、Perlのコードでいう所の%SCALAR::みたいな物。gv.cを見よ。
そしてごにょごにょ処理をする。

gv_fetchmethod(stash ? stash : (HV*)packsv, name);

autobox_method_namedでもっとも大事な部分というのはXPUSHsでgvをpushしてる所。
スタックを操作することにより、

1->foo;

メソッドが見つからなければ

return PL_ppaddr[OP_METHOD_NAという所にいく。

これはメソッドがねーぞというエラーを出すことと同等。


autobox_ck_subr
OP_ENTERSUBというフェーズも書き換えている、本来はop.cのPerl_ck_subrというメソッドを呼んでおり、処理内容を見るとprototype宣言のパースをやってる。

何となくだけど、autobox_ck_method_namedで変更したフラグを戻すとかやってるのかな?

これといって大げさな処理は行われていない。

おまけ
以前encoding::sourceを5.8で動かそうとして無理だった件で、%^Hの値がレキシカルスコープ担ってないからってのがあったんだけど、autoboxを見たらhint bitsに0x20000を立てとけば同じような挙動になるのが解った。

それなんでdan.pmとかencoding::sourceをdorからdefined or にcallerの10個目のを%^Hに、import/unimportで0x20000の出し入れをやってみたけど、うまく動かなかった。

callerの件が実装されてないので、もしかしたらBEGINフェーズ以外でも%^Hが必要になってるのかもしれない。

こんど改めて調べてみることにする。

ちなみに、まだinstall autoboxしてない。





	Posted by Yappo at 20:20
		| Comments (1)
	
		| TrackBack
	

LvalueなAccessorのベンチマーク

空前のlvalue期に突入したので、lvalueなアクセサを作れるClass::Accessor::LvalueとClass::Accessor::Lvalue::Fastを比較したベンチマーク取ってみました。

package Tied;
use strict;
use warnings;
use base 'Class::Accessor::Lvalue';
__PACKAGE__->mk_accessors(qw/ a b /);
1;

package Tied;
use strict;
use warnings;
use base 'Class::Accessor::Lvalue::Fast';
__PACKAGE__->mk_accessors(qw/ a b /);
1;

bench.pl

use strict;
use warnings;

use Benchmark qw(:all);

use Tied;
use Fast;

my $inst  = {};
my $codes = {};

for my $pkg qw( Tied Fast ) {
    $inst->{$pkg} = $pkg->new;
    $codes->{$pkg} = sub {
        my $a = $inst->{$pkg}->a;
        $inst->{$pkg}->a++;
        $a = $inst->{$pkg}->a;
        my $b = $inst->{$pkg}->b;
        $inst->{$pkg}->b++;
        $b = $inst->{$pkg}->b;
    };
}
cmpthese(100000, $codes);

以下結果

[yappo@stfuawsc lvalue]$ls
Fast.pm  Tied.pm  bench.pl
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   8285/s    --  -92%
Fast 107527/s 1198%    --
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   9251/s    --  -91%
Fast 108696/s 1075%    --
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   9083/s    --  -91%
Fast 106383/s 1071%    --
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   9066/s    --  -92%
Fast 111111/s 1126%    --
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   9372/s    --  -92%
Fast 114943/s 1126%    --
[yappo@stfuawsc lvalue]$perl ./bench.pl 
         Rate  Tied  Fast
Tied   9259/s    --  -92%
Fast 111111/s 1100%    --
[yappo@stfuawsc lvalue]$

10倍くらいの差がでました、やはりtieを使ってるとこんなん結果になるんですね。

lvalueの挙動というのは、lvalue attributeを付けられたメソッドが最後に返したスカラ(returnでかえしちゃだめ)に対して代入処理を行っているため、lvalue が付いたメソッド自体は

$self->attr() = 'value'

やっぱり足して2で割ったやつが欲しいな。

CodeReposでShipItを快適に使うモジュールをCPANにうp

年納めという事でShipItを使ってCPANリリースする時にCodeReposのCommit messege rulesにそったコミットメッセージを吐くようや拡張としてShipIt::Step::CommitMessageWrapをリリースしました。
最初のバージョンあたりは、テストしつつうpるというとんでもない事やってたので動きません。
せめてversion 0.03 から動きます。

何をするかと言うとShipItがsvnとかでコミットした時のコミットメッセージに任意のコメントを追加出来たりします。
例は実際http://coderepos.org/share/browser/lang/perl/ShipIt-Step-CommitMessageWrap/trunk/.shipitを見て下さい。

ついでにpmsetupの方も良い感じにsetupしてくれるように変更しました。

Perlで数有る$selfを取る手法をベンチマーク取った

PerlでOOなコード書く時のコンテキストを取る方法は色々あります、最近audreyがselfvarsをリリースしたので、gugodのself.pmとingyのSpiffyそして、既存のmy $self = shift;やshift->や$_[0]->で$selfを取る方法それぞれのベンチマークを取ってみました。

テストコードのモジュール名は、それぞれのモジュールの作者名から取り、既存の手法はYAPC::Asiaでプレゼンした事のある日本を代表するPerlな企業のCTOからモジュール名を取らせていただきました。

コードは以下の通りです。

package Audrey;
use strict;
use warnings;
use selfvars;
sub new { bless { count => 0 }, shift }
sub inc { $self->{count}++ }
1;

package Gugod;
use strict;
use warnings;
use self;
sub new { bless { count => 0 }, shift }
sub inc { self->{count}++ }
1;

package Ingy;
use strict;
use warnings;
use Spiffy -Base;
#sub new { bless { count => 0 }, shift }
sub inc { $self->{count}++ }
1;

package Ikebe;
use strict;
use warnings;
sub new { bless { count => 0 }, shift }
sub inc { $_[0]->{count}++ }
1;

package Naoya;
use strict;
use warnings;
sub new { bless { count => 0 }, shift }
sub inc { my $self = shift; $self->{count}++ }
1;

package Batara;
use strict;
use warnings;
sub new { bless { count => 0 }, shift }
sub inc { shift->{count}++ }
1;

use strict;
use warnings;

use Benchmark qw(:all);

use Audrey;
use Gugod;
use Ingy;
use Ikebe;
use Naoya;
use Batara;

my $inst  = {};
my $codes = {};

for my $pkg qw( Audrey Gugod Ingy Ikebe Naoya Batara ) {
    $inst->{$pkg} = $pkg->new;
    $codes->{$pkg} = sub {
        $inst->{$pkg}->inc;
    };
}
cmpthese(1000000, $codes);

以下結果。

            Rate Audrey  Gugod   Ingy  Naoya  Ikebe Batara
Audrey  110375/s     --    -9%   -91%   -92%   -92%   -93%
Gugod   121803/s    10%     --   -90%   -91%   -91%   -92%
Ingy   1250000/s  1033%   926%     --    -4%   -12%   -21%
Naoya  1298701/s  1077%   966%     4%     --    -9%   -18%
Ikebe  1428571/s  1194%  1073%    14%    10%     --   -10%
Batara 1587302/s  1338%  1203%    27%    22%    11%     --

大体よそおどおりでしょうか？Spiffyはソースフィルタリングしてるので他と肩を並べる速度になってますね。

12/28 21:02追記：すんげー色々ポカってたのでちゃんとやり直しましたorz yasu++

Class::Componentから見たNEXT問題

ちまたで大ブームなNEXTキメェｗｗｗｗｗｗ問題ですが、Class::Componentを半年作って来て感じた事を

Class::ComponentにもClass::C3っぽい挙動をするNEXTメソッドを内蔵しています。
違和感ありますよね？NEXT.pmとかClass::C3とかを使ってるんじゃなくて、内蔵ですからね。
何でかって言うとClass::Componentは、利用する側に対して必要最小限の干渉しかしないというポリシーで書いてあるので、Class::C3とかを使ってないのです。
ソース見ればわかりますが、Class::C3を使うとnextという名前空間をこっそりと追加してたりするので、それを避けたかったのです。
Class::Componentのソースを見ればわかる通り、徹底的に不要な物を隠そうとしてる為ごちゃごちゃしたコードになってます。

ここまでがClass::Componentの事情の話、ここからはClass::ComponentとNEXTの付き合い方について。

Class::Componentは単体では何もやってくれないモジュールで、use Class::Componentしてからモジュールを作った時に初めて役に立ってくれます。
大まかに言うとClass::Componentを使うモジュールには3人の関係者が発生します。

1. Class::Component作者
2. Class::Componentを使ったMyAppというモジュールの作者
3. MyAppの利用者

MyAppでNEXTを使う局面としては、MyApp::Component::*以下の名前空間で実装されたモジュールで使う事が多いでしょう、ここはCatalyst::Plugin::*と役割的には同等なのです。
MyApp::Plugin::*以下は、Plagger::Plugin::*のそれと近くNEXTが使えません。

だんだん答えが近づいて来ましたが、Class::Component的NEXTの作法としては、MyAppの作者がNEXTを多用するMyApp::Componentの管理や作成に責任を負い、MyAppの利用者はMyApp::Pluginのみ弄れる様にします。

CatalystやDBICの混乱をみるとNEXTを実行する場所が、それぞれ好き勝手にやっていて混乱してしまっているので、Class::ComponentではNEXTを使ったMyApp::Component::*を弄れるのはMyApp作者が全責任を追う事で混乱を防ごうという訳です。

もっというとClass::Component::Component以下(MyApp::Component以下も同義)はClass::Componentを利用したモジュールの作者の為に有るという事ですね。
Pluginは、最終的な利用者の為の選択肢を広めるためにあって、Class::Componentを利用するモジュール作者の利便性を上げる為にある。
Attributeに関しては省く。

MyApp利用者側はHookとかを活用すればMyApp::Componentを弄れなくても困る事は無い筈なので、こんなポリシーでもいけると思います。
要するにClass::ComponentではNEXT以外の方法を提供してるのでCatalyst等の様にNEXT地獄に堕ちる必要が無い訳ですね。

ShipItつかわなくて良いのは小学生まで

超クールな CPAN リリースツール 1 選。ShipIt がスバラシイ件 - TokuLog 改め だまってコードを書けよハゲが火種になってるけど、今ShipItが熱い！
という事でちょっと前からShipItに移行してます。 一昨日辺には、オレオレpmsetupもplaggerからコピペしてきたリリースツールを消してShipItしてます。
http://coderepos.org/share/changeset/3295

結構どうでも良いBKがあって、cpanに上げる時にShipIt::ProjectType::Perlを利用してperl Makefile.PLするフェーズがあるのですが、ShipIt::ProjectType::Perl::MakeMakerの実装を見てわかるとおり

sub prepare_build {
    my $self  = shift;
    system("perl", "Makefile.PL") and die "Makefile.PL failed";
}

そんな感じなので、danをshipitする時にはひと工夫をして(5.9.5以上じゃないとmakeできない)

PATH=/usr/local/perl5.10.0/bin:$PATH shipit

ちなみにShipItはsoftware release toolという要約の通りCPAN以外へのリリースも出来ます。
標準だとCPANしか無いけどShipIt::Step以下の名前空間にモジュールを置いていけば色々と拡張できます。
皆が大好き跳ね込むが色々うpってるので参考にどうぞ。

JSとか、そういうののリリースツールとかで使うと面白げ

perl 5.10 and perl 20 years old

perlが20歳になったのと、5.10.0がめでたくリリースされたので、お祝い代わりにdanをCPANにuploadしました。

くわしい説明はYappoLogs: dan - リテラルとかを読まなくなるプラグマ作ったにて

overloadのreblessとRHLのoverloadが遅いパッチ

fbis++
overloadと再blessの問題 - Unknown::Programming

でも現状の対策としてはどうすればいいのかちょっと思いつかないですね。リファレンスを捜索してoverloadフラグを立てる、なんてことをするモジュールとか作れるのかしら・・・。

以前騒がせたFedoraCoreやCentOS系の遅いPerlのパッチの件で、overloadすると極端に遅くなるって話題ですが、問題のpatchのコメントに注目すると

This is a hack cope with reblessing from class with overloading magic to one without (or the other way).

長年の疑問がすっきり解消しました！
で、v5.9.4から解消されたという事で、もしや？と思ってv.5.10.0RC2で調べてみました。

$ perl /tmp/overload.pl 
Benchmark: timing 1000000 iterations of not overload, overload...
not overload:  2 wallclock secs ( 1.51 usr +  0.00 sys =  1.51 CPU) @ 662251.66/s (n=1000000)
  overload:  1 wallclock secs ( 1.48 usr +  0.00 sys =  1.48 CPU) @ 675675.68/s (n=1000000)

dan - リテラルとかを読まなくなるプラグマ作った

何を言っているのか解らないとは思いますが、use danをするとそれ以降の""とか''やq{}とかとかで囲まれた文字列を全て読まなくなります。

  use dan;
  print "foo"; # not displaying
  no dan;
  print "foo"; # foo

なんだかuse utf8してると、hint bits的にdanの処理がうまく行かないのでforceモード付けて、use utf8環境でも動くようにしました。
svn co http://svn.coderepos.org/share/lang/perl/dan/trunk dan
して、どうぞご利用ください。

ちなみに誰からも止められなければperl 5.10のリリースされた日に、これをCPANにうpる

GunghoっていうWebクロウラーたんの件

なんか男前そうなクロウラーたんを発見したお

資料はhttp://www.slideshare.net/lestrrat/gungho-swarmage-pocomdba/を見るべし。

ちなみに、これ書くのに使ったGunghoはVersion 0.09001 のCPANの。

概要

GunghoはPlaggerっぽいwebクロウラーたんです。なのでGunghoの名前空間以下にあるモジュールとかを個別に使おうとしたら大変です。
Gunghoのアーキテクチャにそった一本道な動作をさせるのがいいはず。
設定はConfig::Any使ってるので、色んな形式のを使えます。

Providerにより収集URLを取得し、EngineがHTTPでコンテンツを取得し、Handlerで取得したコンテンツを処理します。 Provider,Engine,Handlerは、それぞれ一つづつしか選べません。
まぁよくあるとおり、Gungho::Component以下のにあるやつとか+つきのcomponentを自由にGunghoに継承させれます。Pluginってのも追加出来ます。
おまけにLogってのも選べます。

Engine

EngineにはPOE,brad,IO::Asyncが選べます。どれも非同期なやつですね。
EngineはGunghoからrunメソッドにcontextを引数として起動されます。そのまえにsetup処理も入るけど。
とにかくrunから先はengineさんの好きにしても良いです。
でもやんなきゃいけない事は、runされたらcontextのdispatch_requestsを呼び出して下さい。 これはGungho::Component::Coreに居ます。

何をするかと言うとProviderのdispatchメソッドさんを呼び出します。