Practice of Programming

プログラム とか Linuxとかの話題

Hachioji.pm #10 に行ってきた

行きたいなぁーと思いつつ、遠いなーと思っていたのですが、行ってみることにしました。


僕は東京の東の方に住んでるので、会場までは、1時間20分くらいかかりました。交通費は780円。時間とお金で遠さを実感w
迷いやすい会場ということでしたが、方向音痴の僕にしては、珍しく迷わずにいけました。


Hachioji.pmは基本的に飲み食いして、酔いが回ったころにLTするというノリとのことで、最初は雑談と飲み食い…というか、最初から最後まで飲み食いで、途中でLTみたいな感じ。初めての人が多いとのことで(僕も初めて)、自己紹介タイムなどがありました。


LTは、2hくらい経ったところから開始。
ノートPCやらiPadなんかでVNCクライアントを立ち上げて、プレゼンをみんなで眺めるといったやり方でした。紙の人もいました。
みんなで覗き込んでプレゼンを見るっていうのは、なんか良いですね。
でも、飲み食いしながらだから、メモってなかった。あと、前日5時まで飲んでたから、ちょっと眠かった(ぉ


LTは、1〜2分という話だったので、僕は資料をなるべく短くしたんだけど、割とフリーダムで長めの人もいました。
以下、頭に残っている話題。LT以外のも入ってるし、時系列はよくわからないです(最初あんまり食べずに飲んだので、大して飲んでないけど割と酔ってたのです)。ちなみに、LTのお題は、「ぼくのかんがえたさいきょうの○○」でした。

  • オフィス環境の話
    • ヤクルトのおばちゃんに入室権限とか、掃除のおばちゃんの入室権限とか。
      • 清掃業者とは守秘義務結んでるかもなぁーとか、思った。
  • ブラック企業は怖いという話
    • Ajaxが使えないのは、tomcatがインストールされていないせいだというシステム会社があるらしい
  • @hsksyuskさんの、Perl初心者用のチュートリアル
    • 良いですねー。
    • Mojolicious::Liteより、Amon2のが受けが良いんじゃないかとか。Mojolicious::Liteで頑張るのもいいんじゃないか的なアドバイスなど。
  • @uzullaさんのイベント系アプリの話
    • 既存のイベントアプリ(atndとか)の批判とこんなの作りたいっていうのが、共感できました。
  • @hondallicaさん、titanium mobile で hachioji.pm というアプリを作ったという話
    • 割と簡単にできたそうです。2時間くらいだとか。
    • 色々言われてますが、さくっと作る分には良いようですね。
  • @norry_gogoさんの勉強法
    • try & error
    • hachioji.pm が良い
  • O/Rマッパーなど
    • YAPCの感想でも書いたけど、僕は別に使えば良いと思っている派
    • 条件を組み立ててSQL作る必要があるなら、SQL::Makerとか、SQL::Abstractとか使ったほうが楽
      • 決め打ちだったら別に使わなくてもいいけど
    • 全部のシステムがユーザーに頻繁に使われるわけではない(管理系とか数人しか使わない)
    • WebサーバのCPUがささるようなサービスとか相当大きい気がする。刺さるにしても、先にDB刺さらない?
    • iterator使わなかったらメモリ食っちゃうけど、そこは気にならないのかな。
    • 要はケースバイケース(規模、要件、開発コストなどなど)ですよね
  • 誰のコードが綺麗か?(学習用途)
    • yousukebeさんが綺麗らしい
    • 僕はあんまり気にしたこと無いけど、読むのが辛くない程度であれば良いと思う(自分はシラナイ)
  • @kyannyさんが、REMPというアプリケーションの紹介
    • youtubeの動画をプレイリストに入れたり、Facebookの友人にプレイリストを送るとかできるらしい(開発版の話かも)
    • そこで、WebSocket使って通知とか出来るんじゃない的なデモでした。RubyのEventMachineというのを使ってるそうです。
  • Text::CSV_PPの話
    • まかまかさんに報告していたけど、対応なしってことになるっぽい
  • @hide_o_55さんの、Acme::ChuckNorris(今CPANにあるやつではないやつ)
    • 面白かった。ソースが上がったら、突っ込みを入れれるか見てみたい。
  • 名前空間の話とか
    • @vkgtaroさんと@kannyさんとがpythonrubyについてそれぞれ。pythonは粒度が大きめ。rubyは名前が想像付かないとかあるらしい。
  • Hachioji.pm at machida
    • LT最中に15人に達して、@ytnobodyさんが、慌てて定員を引き上げてました。
    • 今、見たら、20人に達してた。
  • 最強のYAPCレポーターは@hirataraさん
  • @kyannyさんが百度クローラーの話で
    • 百度のクローラは、クッキーを食ってるらしく、数msecで違うIPでクッキーは共有しているのを、どうやってんのかなーと色々考えたらしい。
  • @okamuuuさんのGangというCMS(のベース?)
    • CRUDの管理画面とか、JSONAPIとか備えてるっぽいものだった。あと、groongaを使ってる
  • まかまかさんのさいきょうのプレゼン(強度が)
    • ダンボールでのプレゼンというか、ダンボールがプレゼン
    • 内容は薄かったていうか、無かったw

僕のLTは、以下においてます。
Web Application Testing with Scraping Framework
設定ファイルの例はオワコンYAMLですが、Config::Anyですので、何でもいいです。
Test::WWW::Mechanize使えって言うのは、まぁ、置いといてくださいw
# FSWiki懐かしいって言われましたけど、未だにFSWikiかよって思いながら使ってます。


@kyannyさんと@ytnobodyさんに、むかーしのドキュメント(Encodeとか、オブジェクト指向とか)について言われて、嬉しかったけど…調べると…(http://d.hatena.ne.jp/ktat/about#p5 に書いてる)

ふ、古すぎる…。頑張ろう…。


ともあれ、Hachioji.pmはなかなか和やかで良い感じですね。LTも酔ってるから滑ろうが、反応薄かろうが、気にしないという前向きな気分になれる気がするし。
皆様、ありがとうございました。

YAPC Asia 2011行ってきた

とは言え、2日目のみの参加でした。1日目も出たかったなー。
個人スポンサーにもなってんだから、せめて懇親会くらい行きたいなーと思ってたんだけどね。夜に会議入っちゃったから、諦めた。

1日目後

Twitterで眺めてたら、PerlDojoとかいう面白いことをやっていたので、参加。
gfxさんの問題に回答おかしくないですか?と質問したら、自分が問題読んでないことが発覚。すみませんでした m(__)m

ツッコミを受けた後、
と言われたので、perldojo を fork。
動作確認してから、pull request したかったので、Arkのインストールから、依存モジュールをいれていると…
Perl 5.12以降でしか動かないことが発覚。


がーん。


で、仕方ないので、Perl 5.14系のコンパイル、依存モジュールのインストールなどなどしているうちに、結構な深夜に。
なんか眠れないし、1日目行けなかったのを、問題作ることで参加した気分になるメソッドを実施してみた。
言われた分のpurll requestと、問題を5件くらい(?)。今のところ採用されたのは、3件かな。
で、あんまり知らないだろうというところで攻めて見たら、15日時点で難問ランキング1位でした。良かった(何が


残りは、レビューされて止まっています。深夜クオリティでごめんなさいって感じです。 m(__)m


しかし、選択問題にしようと思うと、なかなか難しいなーと思いました。


というわけで、残念な一日目でしたが、録画が公開されたら気になるトークでも見ようと思います。

2日目

そんなわけで、pull request する前に没にした問題なんかもあって、6時くらいまで起きてた。その後、いつの間にか寝てて、起きたら8:40くらい。
kazuhoさんのトークを聞きたかったので、助かったーと思い、支度を整えて、YAPCへGo!

続 Unix Programming with Perl by id:kazuho

UNIXでプログラミングする上での勘所の解説。
パイプにもサイズがあるとか、セキュリティ的に、open '|-'な呼び出しじゃなくて、IPC::Open3を使いなさいとかそういったお話。
最後の方に、プロセスを止めるSIGNALを受けるタイミングの話があって、こないだ実装した状況と似ているなーと思った。


ログを監視して怪しげな文字列を見つけたら何かするてのを書きましたが、これは、forkを使って、File::Tailで、別プロセスでファイルを読み込み続け、怪し気な文字列を引っ掛けてなにかするっていうものです。


ログファイルはローテートされるので、renameされたらファイルを読みなおしてもらわないと困る。だが、そのプロセスはファイルを読み続けているわけなので、他のこと出来ない。ので、ALRMで一定時間で割り込んで、そのALRM処理の最後に、また、ALRMを仕込むとかいうことをしていた。


って、別プロセスで監視して子プロセスにHUPでも投げて、そこで、読み直させればいいんじゃないか…(ぉぃ


…ま、まぁ、それはおいておいて、参考になるお話でした。

大規模環境における、マニアックなキャッシュ利用術 (Cache Maniacs) by id:xaicron

memcachedのキャッシュの生成は戻り値をチェックして、リトライすべきとか、キャッシュをワーカーで作るとか。
DNSのキャッシュをどうするかとか、キャッシュに関するマニアックな話。


すごいいい話だったと思います。
でも、この手の話は、相当な大規模環境でしかあんまり関係ない話なので、聞いてる人がそれを実装することはあんまりないんだろうなぁ。僕も含めて。

ぼくがかんがえたさいきょうのうぇぶあぷりけーしょんふれーむわーく by id:cho45

薄いフレームワーク。安全側に倒す。安全じゃないところは面倒臭くさせる。
フレームワークっていうのは、究極に薄くすると、設計指針だ、という話。


今、ちょうどAmon2を拡張してWAF作ってるところなので、参考になりました。


ちょっと反論があるとすれば、「コストがかかることを便利にしてはいけない」というところかなぁ。
これは、規模にもよるんですが、例えば、CPUすかすかのサービスで、そこまで伸びるようなサイトでもないとします。


そのようなサイトに生DBIで書いて、開発コストを上げるよりも、ORマッパーでシステムのコスト(負荷)を上げて、開発コストを少なくしたほうが良いという判断は蟻だと思う。まぁ、これは、観点の問題で、


コスト=開発コスト(お金)であれば、 「コストがかかることを便利にすべきだ」
コスト=システムコスト(負荷)であれば、「コストがかかることを便利にしてはいけない」


となる。いずれかを選択するかは、ケースバイケースだと思います。でも全体に納得できるお話でした。
※システムコストもサーバ台数などにも関係するので、それもお金っちゃお金ですが、そこは開発人員とか、納期とか、サービスの規模とか色々な要素が絡むところではあります。

watch your log by id:nekokak

ログ監視の重要性のお話でした。開発者と運用者のコミュニケーションは大事だと。まぁ...うちは別れてないから「好き勝手しても大丈夫」な部類なんですけども。それでも、ある程度のドキュメントは必要だと思います。ていうか、自分が明日急に働けなくなるとか死んじゃうとかいう可能性を考慮すると、最低限のことは、どっかに記しとかないといけないなぁ、と前から思ってる(いや、足りてないですけど、全然)。


そして、ログ監視フレームワークKomainuというのを作っているそうです。
ちょっと画像なんかがなかったので、いまいちイメージ付かなかったんだけども、notifyやグラフ化とかできそうな感じです。
相当数の台数で実運用しているということなので、ちょっと興味があります。

闇のEメール伝説 by rjbs

Email::関係の作者rjbsのお話。
とりあえず、Emailに関する仕様はクソだ!ということを連呼していた。
クソっていうか、なんというか、あんなん実装しろとか言われたら、逃げたいなーと思いましたw
ありがとうございます。


でも、ぶっちゃけ、送るのだけでも結構メンドクサイ気がします。僕はラッピングして使ってますけども…。

Evolution of API With Blogging by Takatsugu Shigeta

タイトル通りの、BlogとAPIの進化の歴史についてのお話。

なぜ、高校生がPerlを使うのか?

若い人が頑張ってるのはイイなーと思った。もう僕はおっさんか。ていうか、発表者の秋山さんとは、ぎりぎりダブルスコアじゃない年齢差w
僕が大学の頃にやった道を小学生からやってる辺り時代が違いますね!


小学生で掲示板をつくろうとして、プログラミングPerlを買って、諦めたらしいw
小学生にあの本は厳しすぎると思う。その後、とある情熱(yusukebeさんが感動していた)で勉強しはじめたらしい。


僕が小学校のころといえば、N88-Basicで、中学校はやらなかったけど、高校もまだBasicやってた。あとは、Excelのマクロくらいか。
大学で趣味で掲示板作るのに、Perl始めたって言う感じ。


是非、頑張っていただきたいと思います。

DTrace: printf debugging for seventh-level wizards by sartak

dtraceで、デバッグするという話。寝不足がきわまりだしたのと、英語で結構寝てしまってた。
たまに、strace でデバッグするときはあるけど、dtraceは出力を柔軟に変更できるということで良いんだろうか。

http://yapcasia.org/2011/talk/45:titel=Perlで仮想サーバ制御

福岡はRuby押しっていうのが分かった。要件にRubyでって入るのかー。悲しいですね。
Sys::Virtていうのがあるらしいので、ちょっと見てみようかなぁ。

LT

YAPCがLisperに侵されていた。もっとやれば良いと思うw
いずれも面白かったです。Yappoさんの話が非常に良かったと思います。
竹迫さんが相変わらずすごい。安定している。

Managing A Band Of Hackers by id:hidek

マネージメントの話。為になりました。

マネージャーがなぜいるか

1 + 1 = 2 だったら、マネージャーなんかいらない。組織として人を動かして、より大きな成果をだすためにいる。

マネージャーの仕事

1. プロジェクトマネージメント

計画->開発->運用のプロジェクトのライフサイクルを維持する。

マネージャーは開発の経験者であるべき。もし違ったら月曜にでもやめたほうがいいとまで言ってました。
広い知識も必要。

2. 人事

採用の面接とか。これもエンジニアじゃないと判断できないよねっていう話。
採用したら、仕事を与える。どんなスキルを持っているのかを把握する。何がしたいのかを把握する。
コミュニケーション力は重要。
評価もしないといけない。

3. その他

事務仕事はめんどくさいけど、粛々とやるべき。
僕も嫌いだけど、メンドクサイことは引き受けて、開発者に開発に集中してもらうのは筋だと思う。
会議なども多くなる。無駄な会議もあるけど、面と向かって話すことで話がすすみやすいこともある。

ハッカーを率いる
  • ハッカーを一人にすると死んじゃうらしい
    • とんがってるので、衝突することもあるから、仲間が必要
  • 飽きやすい
  • プライオリティ < 興味
    • 興味をもったことをするために、プライオリティの高い仕事を意欲的に片付ける

ていうか、hidekさんのチームのろけ話のようでした。

マネージャで重要なこと
  • コードを書かない
    • プロダクトを持っちゃうとそっちに集中しちゃって、マネージメントがおろそかになる
  • 任せる
    • 信頼して任せる。丸投げ肌目
  • 悪いニュースは最初に
    • 後から悪いニュースを言われてもどうしようもない
  • TMTOWTDI

で、エンジニアリングのマネージャーはエンジニアでないと務まらない。
だから、そういうキャリアパスもあるということを頭に入れておいて。
ということだそうです。
また、YAPCやコミュニティなどで培った人間関係はとても大切とのことでした。

おすすめ書籍

Beeing Geek という本がおすすめらしい。買ったら良かった。

クロージング

牧さんによるクロージング。今年のYAPCは過去最大規模(客、スポンサー、スタッフ、トークの応募など)だったらしく、大成功ということでした。
941さんと牧さんがうまく回ってるんでしょうか。なんかいい感じでした。

後夜祭

一番端っこの方で、最年少の秋山さんを囲んでお話してました。名刺は全然交換できなかった。
まぁ、いいか(会社の人に怒られそうだけど)。
perlmonカードゲーム朝に買っておけば良かった。なんか、飲み会の最後の方に、まかまかさんと冨田さんがやってたのを見てると、楽しそうだったw

最後に

来年…は、本当にわかんないよ?というお話でしたが、是非頑張っていただきたいなーと思います。
うちの会社はお金を出すくらいしかないけど。
個人的には翻訳とかなら手伝いますけど、charsbarさんのクオリティが高いから気が引けるのはある。スライドの翻訳は難しい。


牧さん、941さん、スタッフの皆様方、本当にありがとうございました! m(__)m

Text::Parts てのを書いた

githubにおいてます。

テキストファイルを複数のパーツに分けるものです(実際に分割するわけではなく、分けた部分を読むためのオブジェクトを返します)。
各パーツは、行頭から始まって行末で終わる感じになります。行の途中で分けられるということはありません。
とても大きいCSVファイルとかを分割する用途とかに使います。既にありそうなもんだけど、無さそうだったんで作りました。

  my $s = Text::Parts->new(file => "file.txt");
  my @parts = $s->split(num => 4); # num => 割りたい数。size => 割りたいバイト数 も可
  foreach my $part (@parts) {
      my $l = $part->getline; # or <$part>
      # ...
  }

て感じで使います。


$part はそのパートのファイルの開始と終了のポジションを持っており、オブジェクト作成時にファイルをopen & seekして、後は、<$fh>しながら、そのパートの最後の位置に達したら終了という感じの簡単なものです。


実際ありそうな、CSVファイルを分割する場合は、次のようにします。

  my $s = Text::Parts->new(file => "file.txt", , eol => "\r\n", parser => Text::CSV_XS->new({binary => 1, eol => "\r\n"}));
  my @parts = $s->split(num => 4);
  foreach my $part (@parts) {
      my $columns = $part->getline_parser;
      # ...
  }

$columns は、Text::CSV_XS のgetline の戻り値なので、パース後の配列リファレンスとなります。
Text::CSV_PP の場合、どうも壊れたCSVファイルを渡す(aaa", みたいなクォートが不一致なカラムがある)と、ファイルの終端まで読んでしまうので、check_line_start => 1 というオプションを渡してください。このオプションを付けると、行頭まで戻ってから、getline に渡します。

ただ、CSVで改行を含むカラムとかだと、壊れたフォーマットになる可能性はあるので、PP版だとうまく行きません。まぁ、XS版でうまくいってるのも、たまたまっていう話かも。


parser には、ファイルハンドルを受け取るパーサなら何でも渡せます。例えば、log のパーサとかでも良いかもしれない。
parserに渡したオブジェクトで使うメソッドは getline がデフォルトになってます。変更する場合は、parser_method オプションでメソッド名を渡してください。


なお、厳密に何行ずつに分けるのではなくて、ファイルサイズを割りたい数で割った分で分けていきます。
ただ、1行だけ非常に長いといった場合はありますので、4つに分ける場合は、

最初のパートのサイズ -- ファイルサイズ / 4 で試す
次のパートのサイズ -- 残りサイズ / 3 で試す
次のパートのサイズ -- 残りサイズ / 2 で試す
...

のようにして調整して、最初に渡された分割数になるようにしています(サイズで渡した場合も、ファイルサイズから分割数を計算しているので、同じです)。

ログを監視して怪しげな文字列を見つけたら何かする

Parallel::ForkManager訳しました(nekokakさんの0.7.5の翻訳からの差分だけなので楽でした)。


で、複数のエラーログファイルがあって、そのログファイルを tail(File::Tailを使って)しつつ、Errorを見つけたら、何かするっていうスクリプト
例として、それどうよって感じですね!(ぉ


(一般的には、定期的なデータ更新とかで結構デカ目だけど、複数サーバで分散とかいうほど大げさじゃない(ていうか、予算上そんなサーバないし…)、素直にやると5〜6hくらいかかっちゃうんだけども、どーすっかなーみたいな処理を1hくらいで済ましたいなーみたいな処理に使えば良いと思います -- Web/FTPからデータ(複数ファイル)取ってきて、パースして、DBに突っ込む的なアレ)。

#!/usr/bin/perl

use strict;
use warnings;
use File::Tail;
use Proc::PID::File;
use Parallel::ForkManager;

main();

sub main {
  my $name = $0;
  $name =~s{/}{-}g;
  my $pidfile = Proc::PID::File->new(name => $name, dir => "/tmp/");
  # Proc::PID::Fileで複数プロセス動かないようにチェック
  if (not $pidfile->alive) {
    $pidfile->touch; tail_error_log($pidfile);
  }
}

sub tail_error_log {
  my $pidfile = shift;
  my %error;
  my @files = </var/log/httpd/*error_log>;

  my $parent_pid = $$;
  local(@SIG{qw/INT TERM HUP/});
  $SIG{TERM} = $SIG{INT} = sub {$pidfile->release; exit(1)};
  # cronでたまに動かすようにしてるので、HUPでもexitさせた
  $SIG{HUP}  = sub { $pidfile->release; exit;  };

  # 子プロセスは終わらないので、ファイルの数だけプロセスが必要
  my $pm = Parallel::ForkManager->new(scalar @files);
  foreach my $file (@files) {
    my $past_log_ctime = (stat $file . '.1')[10]; # .1 log's epoch time;
    print "start tail -f $file\n";
    my $pid = $pm->start and next;

    my $tail = File::Tail->new($file) or die "cannot tail log $file";
    # -1 渡すと、最初に全体読むそうな
    $tail->tail(-1);

    # alarmでlogrotateをチェックする
    local $SIG{ALRM} = sub {
      my $past_log_ctime_test = (stat $file . '.1')[10];
      if ($past_log_ctime_test != $past_log_ctime) {
        # ログがローテートされたもよう
        print "file is changed";
        $past_log_ctime = $past_log_ctime_test;

        # ログファイルがローテートされたので、ファイルを読み直す
        $tail->resetafter(0);
        %error = ();
      }
      # 親が $pidfile を解放したら(HUP/INT/TERM時)、子プロセスも終了する
      $pm->finish if not $pidfile->alive;

      # もっかい、alarmを仕込む
      alarm(300);
    };
    alarm(300);
    while (defined(my $error = $tail->read)) {
      my $error_string = $error;
      $error_string =~s{^.+?\] Error in}{Error in} or next;
      $error_string =~s{, referer.+?$}{};
      # 初めてのエラー内容のみ処理(ローテートの時にはクリアしてます。ALRMんとこ参照)
      if (not $error{$error_string}++) {
        do_something($error);
      }
    }
    $pm->finish;
  }
  $pm->wait_all_children;
}

sub do_something {
  # 何かする
}

Amon2を継承して自分のWAFを作る

2ヶ月くらい前からか、id:tokuhiromさん作成のAmon2を会社のFrameworkのベースにしています。
Amon2は拡張しやすい感じだし、Flavorをメンテするのは結構だるいし、会社なら共通させたほうがいいなーということで、継承して使ってます(Flavorも使っていますけど)。ORマッパーはid:nekokakさんのTeng、テンプレートはid:gfxさんのText::Xslate。
当分公開できるような状態にはならない気がするので、こんな感じにしてます的な話(実際のコードと同じだったり、全然違ったりするところもあるけど、手を入れたポイント的な話)。仮に、MyWAFていう名前空間で書きます。

コードが断片的なのでよくわかんないかも…しれません。

最近書かれているAmon2に関する記事

id:tokuhriomさん自身の解説
http://blog.64p.org/entry/20110713/1310510015

id:hirataraさんのAmon2のソースを読む
http://d.hatena.ne.jp/hiratara/20110823/1314085436

Dispatcher

Amon2では、amon2_setup.pl で出来上がる app.psgi で、

MyApp::Web->to_app();

となっていて、to_app 内で、MyApp::Webのdispatchが呼ばれるだけです。
もし、MyAPpp::Webと違う名前を使いたければ、ここの名前を変えれば良いです。
同じライブラリで、複数のサーバ、複数のpsgiを書きたいとか言ったときには、そんな必要があるやもです。


また、パスによってdispatchするクラスを分けたいっていうときは、
BEFORE_DISPATCHというトリガーがあるので、そこの中で、パスを判断して、パス別にdispatch処理を分けることもできます。

__PACKAGE__->add_trigger(
    BEFORE_DISPATCH => sub {
      my ( $c ) = @_;
      $c->message;
      $c->{_dispatcher_class} = 'MyApp::Web::Dispatcher::User';
      if ($c->req->env->{PATH_INFO} =~m{^/(admin)}) {
        $c->{_dispatcher_class} = 'MyApp::Web::Dispatcher::Admin';
      }
      # ...
    });

sub dispatch {
  my $c = shift;
  $c->{_dispatcher_class}->dispatch($c);
}

みたいな。

Amon2::Web::Dispatcher::Liteについて

Amon2::Web::Dispatcher::Lite は好きなんですが、パスごとにフックかけたりするのが、BEFORE_DISPATCHERのトリガーしかないのは(そんなことない?)ちょっとやりにくいと思っています。
例えば、ログイン処理とか書く時に、トリガーに書くのかなぁ?みたいな。

Amon2::Web::Dispatcher::Liteのやってることは、継承元に各関数をexportしてるだけなので、真似して自分で作るのは簡単です。
で、継承元にexportしてるdispatchていうメソッド(ちょうど、上で書いたのコードのdispatchの中で使われているdispatchメソッド)は、Amon2::Web::Dispatcher::Liteでは、以下な感じ。

    *{"$caller\::dispatch"} = sub {
      my ($klass, $c) = @_;
      if (my $p = $router->match($c->request->env)) {
        return $p->{code}->($c, $p);
      } else {
        return $c->res_404();
      }
    };

このコードをちょっと変えて、get/postなどの関数に渡しているパスのパターンをチェックして特定のパスならhookをかけるとかっていうのを追加してます。うちのMyWaf::Web::Dispatcherでは、

hook '/path/to/hoook' => sub {
  my ($c) = @_;
  # ...
};

みたいな感じで書けるようにしています。hookに登録したコードを実行する処理や、フックのコードがresponseオブジェクトを返した場合は、そこで処理を終了といった判断を、上のdispatchメソッドに追加しています。これをするために、get/postなどのメソッドも全部自分で書き直しになりますが。

  tie %{$caller . '::HOOK_RULE'} => 'Tie::IxHash';
  $hook = \%{$caller . '::HOOK_RULE'};
  *{"$caller\::get"} = sub {
    my $pkg = caller(0);
    my ($path, $code) = @_;
    my $router = $pkg->router;
    my $hook_path = _hook_path($hook, $path);
    $router->connect($path, {code => $code, -hook => $hook_path}, {method => ['GET']});
  };

-hook に、hook 関数で登録したコードリファレンスを配列で持たせる感じです。
で、_hook_pathていうのは、以下のようなもの。

sub _hook_path {
  my ($hook, $target_path) = @_;
  my %except;
  foreach my $path (keys %$hook) {
    foreach my $except_path (@{$hook->{$path}->{except} || []}) {
      if (ref $except_path eq 'Regexp') {
        $except{$path} = 1 if $target_path =~ $except_path;
      } elsif ($target_path eq $except_path) {
        $except{$path} = 1;
      }
    }
  }
  [
   map {
     (not $except{$_} and $target_path =~m{^\Q$_\E$}) ? $hook->{$_}->{code} : ()
     } keys %$hook
  ]
}

-hook に登録されたコードをMyWAF::Web::Dispacherがexportするdispatchメソッドで実行するわけです。
※ちなみにこの書き方だと、対象のパスについて、get/post等の関数で定義する前にhook関数を使う必要があります。
後から書いても有効になるようにも作れるけど、普通、先に定義するし、hook処理はなるべく軽い方がいいんじゃないかと思って、そうしました。


後、内容がstaticなページ(ログイン判断はあるけど)とかで、ファイル指定するだけとかめんどくさいので、

get '/path/to/static_page';

だけでいいようにとか(/path/to/static_page.tt を表示する)。これは、別に静的ファイルじゃなくてもそういう感じにしています。ファイルが指定されなければ、パスのパターンから決める。


これをするためには、MyWAF::Web::Dispatcherがexportするdispatchで、$router->routematchが返す$routeを$cに突っ込んでいます。
$c->{route}->{pattern}を使って、MyWAF::Webのrenderのところでファイル名を決定するためです。hookの箇所も近いのでついでに引用。

  *{"$caller\::dispatch"} = sub {
    my ($klass, $c) = @_;
    my ($p, $route) = $router->routematch($c->request->env);
    $c->{route} = $route; # 後で、パスのパターン(get/post..の引数)を取りたいので、入れてる。
    # ...
    if ($p) { # $p がundefの場合は、マッチしなかった場合
      { # この部分、hookの処理
        foreach my $cm (@{delete $p->{'-hook'} || []}) {
          my $res;
          $res = $cm->[0]->($c, $p);
          return $res if ref $res eq 'Amon2::Web::Response';
        }
      }
    #...

Teng

Tengも拡張しやすいですね。以前pullリクエストだしたのですが、取り込まれる様子は無さそうだし、他にも色々したいし、どうせ継承してるんだから、上書きすればいいかぁと言うことで上書きしました。

以下、pullリクエストしたやつだけど、会社のFramework内にもともと書いちゃっておけば毎回書く必要もない。

sub search {
  my ($self, $table_name, $where, $opt) = @_;

  my $table = $self->schema->get_table( $table_name );
  if (! $table) {
      Carp::croak("No such table $table_name");
  }

  my ($sql, @binds) = $self->sql_builder->select(
      $table_name,
      $opt->{columns} || $table->columns, # ここ変えただけ
      $where,
      $opt
  );

  $self->search_by_sql($sql, \@binds, $table_name);
}

こうすると、

$db->search({ ... }, {columns => ["id"]});

だけ取りたいとか、

$db->search({ ... }, {columns => ["date(create_time) as day", "sum('sales') as sales_sum"], group_by => ['date(create_time)']});

とか、書けるようになります。group by があるのに、関数(sum/countなんかを)使おうと思ったらsearch_by_sqlてのはちょっと面倒なんですよね。
後、パフォーマンス出したいとか、リソース減らしたい時に、fetchするカラムを減らすのは、巨大なテーブルなら効果はあるかと思います。
28カラムあるテーブルから30万レコード中、100行持って来たときのベンチマーク

               Rate 00_no_columns    10_columns        20_dbi
00_no_columns 198/s            --          -28%          -65% # 全28カラムselect
10_columns    274/s           38%            --          -52% # 1カラムselect
20_dbi        567/s          186%          107%            -- # fetchrow_hashref で1カラムselect

あと、こんな感じで統計情報とかのデータ出すのに、より手抜きしたいなーと。

sub search_group {
  my ($self, $table_name, $where, $opt) = @_;
  my $table = $self->schema->get_table( $table_name );
  if (! $table) {
    Carp::croak("No such table $table_name");
  }
  my $stmt = $self->sql_builder->new_select;

  $stmt->add_select(\"COUNT($_) as " . ($_ ne '*' ? "_$_" : '')) for @{ $opt->{count} || []};
  $stmt->add_select(\"SUM($_) as sum_$_")                        for @{ $opt->{sum}   || []};
  foreach my $g (@{ $opt->{group_by} }) {
    my ($name, $as) = ($g, $g);
    if ($as =~ m{(\w+)\((.+?)\)}) {
      $stmt->add_select(\"$name as $1_$2");
    } else {
      $stmt->add_select($name);
    }
  }
  if (ref $where eq 'HASH') {
    $stmt->add_where($_ => $where->{$_}) for keys %{ $where || {} };
  } elsif (ref $where eq 'ARRAY') {
    while (my ($col, $val) = splice(@$where, 0, 2)) {
      $stmt->add_where($col, $val);
    }
  }
  $stmt->add_group_by(\$_)             for @{ $opt->{group_by} || []};
  if ($opt->{join}) {
    $stmt->add_join(%{$opt->{join}});
  } else {
    $stmt->add_from($table_name);
  }
  my @bind = $stmt->bind();

  # 以下、SQL::Makerからコード借りてます
  $stmt->prefix($opt->{prefix}) if $opt->{prefix};
  if (my $o = $opt->{order_by}) {
    if (ref $o eq 'ARRAY') {
      for my $order (@$o) {
        if (ref $order eq 'HASH') {
          # Skinny-ish [{foo => 'DESC'}, {bar => 'ASC'}]
          $stmt->add_order_by(%$order);
        } else {
          # just ['foo DESC', 'bar ASC']
          $stmt->add_order_by(\$order);
        }
      }
    } elsif (ref $o eq 'HASH') {
      # Skinny-ish {foo => 'DESC'}
      $stmt->add_order_by(%$o);
    } else {
      # just 'foo DESC, bar ASC'
      $stmt->add_order_by(\$o);
    }
  }

  $stmt->limit( $opt->{limit} )    if $opt->{limit};
  $stmt->offset( $opt->{offset} )  if $opt->{offset};

  if (my $terms = $opt->{having}) {
    while (my ($col, $val) = each %$terms) {
      $stmt->add_having($col => $val);
    }
  }

  $stmt->for_update(1) if $opt->{for_update};
  # 以上、SQL::Makerからコード借りてます

  my $sql = $stmt->as_sql();
  $self->search_by_sql($sql, \@bind, $table_name);
}

みたいなので、

  my $sales = $self->search_group('sales', [\'year(sales_datetime)' => $year],
                                  {sum => ['sales'], group_by => ['account_id', 'month(sales_datetime)']});

  while (my $r = $sales->next) {
    $r->get_column('month_sales_datetime');
    $r->get_column('sum_sales');
    # ...
  }

みたいな。

上のメソッドでも使ってますが、search_by_sqlに渡すSQLSQL::Makerで作りたければ、

my $stmt = $self->sql_builder->new_select;

で取れます。Teng::QueryBuilderは、SQL::Makerを継承して、InertMultiプラグインをロードしているだけなので、SQL::Makerの書き方はそのまま使えます。とはいえ、上のメソッドでもSQL::Makerからコピペしちゃってる部分がありますので、そのへん切り出した方がいいかもしれない。

Viewまわり

Amon2 では、Flavorが、create_view ていうのを作るので、それを参考にして、自分用の create_viewをMyWAF::Webに書きました。Text::Xslateに渡す関数の書き足しとか、そんなもんだけど。また、Amon2::Webのrenderメソッドでレンダリング&レスポンスを返すのですが、こちらも上書きしました。
理由としては、viewに値を埋めるのがrenderメソッドでしかできないのを変えたかった。

staticの話でも書きましたが、テンプレートファイルはパスから自動的に決めるっていうような仕組みを入れた場合、別のやり方でviewに値を埋めれないと困るわけです。変数だけじゃなく、ファイルもレスポンス返すのと別のタイミングで埋めたい時もあったので、そのへん手を入れました。hookの時に埋めたいような場合もあるし。

 $c->view_param('foo' => 'bar');
 $c->view_file('/path/to/template.tt');

みたいにしたかったわけです。こうしておいて、dispatcherを以下のように変えます。

sub dispatch {
  my $c = shift;
  my $res = $c->{_dispatcher_class}->dispatch($c);
  return ref $res eq 'Amon2::Web::Response' ? $res : $c->render;
}

基本renderで返すことが多いわけなので、responseオブジェクトが帰って来なければrenderしてしまうという感じです。
render内で、view_fileが渡されてればそれを、渡されていなければ、パス(Dispatcherでgetなどの関数に渡したパターンなので、"/path/:id/"とかもあります)からテンプレートを特定し、view_paramで渡された値で表示する(Dispatcherのところで書いた話)。

といったようにしています。

また、サイト共通のview用の設定みたいなものをどこで定義したらいいかなーと思っていたのですが、今のところ、設定ファイルにviewに使う用の場所を用意しておいて、関数から使えるようにしています。単純な話で、こんな感じ。

  site_config => sub { $self->config->{site} };

まぁ、$c が渡っているので、 c().config.site でいいやん的な話もありますが。

Text::Xslate

Text::Xslateは、TTerseで使っていますが、TTで書いてた大きめのmacroも移せたし、基本的には調子よく使ってます。ちょっとした不満は以下くらい。

[% WRAPPER .... WITH ... %] 〜 [% END %] を毎回書くのはメンドクサイので、header にWRAPPERのテンプレートファイルを渡したものの、パラメータ渡せないから使えないなー…て、MLで書いたけど、うまく伝わらずでした。すみません。

実際、ドキュメントにこんなふうにTTのWRAPPERは使えるよって書いてるけど、base側にcontent以外の変数がある気がするんだけど、どうなんだろう?
例えば、ページのタイトルとか、METAの指定とかしたくないのかな。デザイナ側からコントロールする術はないんだろうか。
TTerseのドキュメントより

    my %vpath = (
        wrap_begin => '[% WRAPPER "base" %]',
        wrap_end => '[% END %]',

        base => 'Hello, [% content %] world!' . "\n",
        content => 'Xslate',
    );

    my $tx = Text::Xslate->new(
        syntax => 'TTerse',
        path => \%vpath,

        header => ['wrap_begin'],
        footer => ['wrap_end'],
    );

    print $tx->render('content'); # => Hello, Xslate world!;

あと、もう一点、最近言われて気付いたんだけど、TTのUSEはいちいちモジュール作るのがいけてないけど、再利用っていう点ではそっちのが便利ではあるかなぁ。
今回のように自分でWAFを作るのであれば、create_viewで使いそうな関数をなるべく突っ込んでしまえば済むわけですが、全体的な再利用にはならなさそうな気分はする。

Plugin

追記。tokuhiromさんから、コメントがありました。

load_plugin() にかんしては、+ を prefix につけるという DBIC/Catalyst 的なルールがつかえます。
__PACKAGE__->load_plugin("+MyApp::Plugin::Foo");

てわけで、以下は、嘘情報です。
load_plugin(s)は、Amon2名前空間固定なので、MyWAF::Pluginを作っても読み込まれません。mywaf_load_plugin(s)を作っても良いだろうし、プロジェクトのリポジトリ内に、Amon2::Plugin::* 名前空間で作ってもいいし。既存のload_pluginを両方チェックするように上書きしてもいいだろうし。公開していいものなら、Amon2::Plugin::で公開してしまえばいいかは…知らないです。

Flavor

自分で、Flavorを作る場合、Amon2::Flavor::* な、名前空間にします。

% amon2-setup.pl --flavor=YourFlavor

てな感じで使えます。Flavorの中身は、run ていうメソッドを定義するだけ。Amon2:Setup::Flavor::Minimumあたりを参考にすれば簡単に書けます。
うちでは、Amon2::Setup::Flavor::Minimumを継承して書いています。

というわけで

これらの変更を全部Flavorに書いてメンテすることもできますが、Flavorのメンテは結構大変だし、テストも書きにくくなるし、あんまりおすすめできないと思います。ので、継承して自分用のWAF作っちゃえばいいなじゃないかなーと、勝手に思っております。

巨大なファイルをgetする場合のLWP::UserAgentとFurlの場合

バッチ処理がやたらメモリくってると思ったら、なんかおっきいファイルをgetしてたせいでした orz
一旦ファイルに吐き出して、後でopenして使いたいような場合は、LWPでは、

my $ua = LWP::UserAgent->new();
$ua->get('http://example.com/big_file.gz', ':content_file' => '/path/to/big_file.gz');

Furlの場合、write_fileオプションを使います。こちらはファイルハンドル。

my $f = Furl->new();
open my $fh, '>', $filename;
$f->request(url => 'http://example.com/big_file.gz', write_file => $fh);

Furl::HTTPのドキュメントにあるけど、Furlのドキュメントから抜けてる?
# ファイルに書くなら、curl/wgetでいいよねっていう話もある。


ちなみに、gzipされたファイルを読み出したりするのは、PerlIO::via::gzip とか使える。
http://search.cpan.org/~majensen/PerlIO-via-gzip-0.021/lib/PerlIO/via/gzip.pm
# 別に、gunzipしたらいいよねっていう話もある。


ちなみに、読みつつ処理するのは、LWP::UsearAgentだと、:content_cb。Furlだと、write_code。

LWP::UserAgentの例は以下で。
http://blog.livedoor.jp/dankogai/archives/51141631.html
Furlのドキュメントにはプログレスバーの例が載ってます。
http://search.cpan.org/~tokuhirom/Furl-0.37/lib/Furl.pm#FAQ

Perl で WebSocket クライアント(AnyEvent)&サーバ(psgi)

こんなんでいいかなぁ。その2。

forkじゃアレなんで、AnyEventで書いてみた(https://gist.github.com/1000223)。
追記: 以下、to_stringですが、Protocol-WebSocket-0.00906 では、Protocol::WebSocket::Handshake は to_bytes に変わっているようです。

#!/usr/bin/perl

use utf8;
use strict;
use warnings;
use AnyEvent;
use Protocol::WebSocket::Frame;
use Protocol::WebSocket::Handshake::Client;
use IO::Socket;
use constant {READ => 0, WRITE => 1};

$| = 1;

run();

sub run {
  my $cv = AE::cv;
  my $s = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 50000, Proto => 'tcp', Blocking => 0);
  if (not $s or not $s->connected) {
    client_exit();
  }

  my $hc = Protocol::WebSocket::Handshake::Client->new(url => 'ws://127.0.0.1:50000/');
  # handshare request
  $s->syswrite($hc->to_string);

  my (@messages, $wsr, $wsw, $stdin);

  my $finish = sub { undef $stdin; undef $wsr; undef $wsw; $cv->send; client_exit($s) };

  local @SIG{qw/INT TERM ALRM/} = ($finish) x 3;

  $stdin = AE::io *STDIN, READ, sub {
    my $line = <STDIN>;
    unless ($line) {
      $finish->();
    } else {
      chomp $line;
      push @messages, Encode::decode('utf8', $line)
    }
  };

  $wsw = AE::io $s, WRITE, sub {
    if ($s->connected) {
      while (my $msg = shift @messages) {
        $s->syswrite(Protocol::WebSocket::Frame->new($msg)->to_string);
      }
    } else {
      $finish->();
    }
  };

  # parse server response
  my $frame_chunk = '';
  until ($hc->is_done) {
    $s->sysread(my $buf, 1024);
    if ($buf) {
      if ($buf =~ s{(\x00.+)$}{}) {
        $frame_chunk = $1;
      }
      print $buf;
      $hc->parse($buf);
      if ($hc->error) {
        warn $hc->error;
        $finish->();
      }
    }
  }

  my $frame = Protocol::WebSocket::Frame->new();
  $frame->append($frame_chunk) if $frame_chunk;
  $wsr = AE::io $s, READ, sub {
    $s->sysread(my $buf, 100);
    $frame->append($buf);
    while (my $msg = $frame->next) {
      print Encode::encode('utf8', $msg), "\n";
    }
  };

  $cv->recv;

  client_exit($s);
}

sub client_exit {
  my $s = shift;
  close $s if $s;
  exit;
}

Protocol::WebSocket は、Handshake時にサーバに投げるリクエスト作ったり、それをparseして、レスポンス作ったり、WebSocketのフレームを作ったりするモジュールです。単体でサーバになったり、クライアントになったりするものではありません。


ミニマムなサーバの実装は、下記にあります。
http://showmetheco.de/articles/2011/3/using-protocol-websocket-with-plack.html


あんまり説明するようなこともないのですけれど。


上のクライアントのコードでクライアントがサーバにHandshakeのリクエスト送る部分は、以下の部分。

  my $s = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 50000, Proto => 'tcp', Blocking => 0);
  # ...
  my $hc = Protocol::WebSocket::Handshake::Client->new(url => 'ws://127.0.0.1:50000/');
  # handshare request
  $s->syswrite($hc->to_string);

上に紹介したblogのコードで、クライアントからのHandshakeのリクエストをパースしてる部分。

      my $hs = Protocol::WebSocket::Handshake::Server->new_from_psgi($env);
      $hs->parse($fh) or return [400, [], [$hs->error]];

それから、クライアントにレスポンスを返している部分。

            my $h = AnyEvent::Handle->new(fh => $fh);
            # ...
            $h->push_write($hs->to_string);

クライアント側は、サーバのレスポンスを受け取るのだけど、sysreadで読んでいるので、サーバがすぐにフレームを送ってきた場合、余計に取れちゃいます。
レスポンス最後にくっついたフレームまで取っちゃいます。なので、フレームの手前を正規表現で切り取って、残りをフレームに渡すようにしました。

  # parse server response
  my $frame_chunk = '';
  until ($hc->is_done) {
    $s->sysread(my $buf, 1024);
    if ($buf) {
      if ($buf =~ s{(\x00.+)$}{}) {
        $frame_chunk = $1;
      }
      print $buf;
      $hc->parse($buf);
      # ...
    }
  }

  my $frame = Protocol::WebSocket::Frame->new();
  $frame->append($frame_chunk) if $frame_chunk;

ついでに、さっきのblogをを参考にした、簡易なchatサーバ。

#!/usr/bin/perl

use strict;
use warnings;

use AnyEvent::Handle;
use Protocol::WebSocket::Handshake::Server;
use Protocol::WebSocket::Frame;

my %member;
my $cnt = 0;

my $psgi_app = sub {
    my $env = shift;

    my $cv = AnyEvent->condvar;

    my $fh = $env->{'psgix.io'} or return [500, [], []];
    my $hs = Protocol::WebSocket::Handshake::Server->new_from_psgi($env);
    $hs->parse($fh) or return [400, [], [$hs->error]];

    return sub {
      my $respond = shift;

      my $h = AnyEvent::Handle->new(fh => $fh);
      $member{fileno($fh)} = $h;

      $h->push_write($hs->to_string);

      my $frame = Protocol::WebSocket::Frame->new;
      $h->on_read(
                  sub {
                    $frame->append($_[0]->rbuf);
                    while (my $message = $frame->next) {
                      $message = Protocol::WebSocket::Frame->new($message)->to_string;
                      $_->push_write($message) for values %member;
                    }
                  }
                 );
      $h->on_error(
                   sub {
                     my ($hdl, $fatal, $msg) = @_;
                     delete $member{fileno($fh)};
                     $hdl->destroy;
                     $cv->send;
                     undef $h;
                   });
      $h->on_eof(
                 sub {
                   my ($hdl) = @_;
                   delete $member{fileno($fh)};
                   $hdl->destroy;
                   $cv->send;
                   undef $h;
                 });

    };
};

$psgi_app;

twiggyで起動します。

% twiggy -p 50000 app.psgi

50000 にしてるのは、最初に書いたクライアントと合わせただけなので、特に意味はないです。


htmlとjsは、id:motemenさんの以下のものを参考にすれば、結構簡単に作れるんじゃないかなとか思います。
https://gist.github.com/632374


初AnyEvent、初WebSocketみたいなもんなんで、なんか変なことしてるかもしれません。
お気づきの点があれば、突っ込んで頂ければと思います。