D-7 <altijd in beweging>

Day to day life of a Perl/Go/C/C++/whatever hacker. May include anything from tech, food, and family.

カテゴリ:Perl

もしあなたのperl HTTPハンドラが「可能ならgzipしたコンテンツを返したい」と思うなら、Compress::Zlibを使うだろう。だがそれを毎回eval + requireするのは正直無駄だ。なぜならプログラムが起動した時にすでにそれを毎回行うのかどうかすでにわかっているからだ。
sub psgi_response {
my ($self, $content) = @_;
my $req = $self->req;
my $res = $self->res;
if ($req->header('Accept-Encoding') =~ /\bgzip\b/i) { if (eval { require Compress::Zlib }) { $res->header('Content-Encoding' => 'gzip'); $content = Compress::Zlib::memGzip($content);
}
}
... }
こんな場合は定数にするべし
use constant HAVE_ZLIB => eval { require Compress::Zlib };
sub psgi_repsonse {
my ($self, $content) = @_;
my $req = $self->req;
my $res = $self->res;
if (HAVE_ZLIB && $req->header('Accept-Encoding') =~ /\bgzip\b/i) {
$res->header('Content-Encoding' => 'gzip');
$content = Compress::Zlib::memGzip($content);
}
...
}
 これで何が違うかというとCompress::Zlibがなかった場合はHAVE_ZLIBが定数で偽と判断されるので、ifのブロック全体がそもそも評価される対象と見なされない(constant folding)

Compress::Zlibがあった場合はHAVE_ZLIBは定数で真なのでifの評価ではAccept-Encodingヘッダの評価だけにとどまる。

毎回eval + requireをするのと比べると大分かかるコストが違うのがわかると思う。 

どういう評価されるのかわからない時は perl -MO=Deparse ... で評価するといいんだぜ!
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr


コメントを残せないブログなんて!どうなの!
と、それは置いておいて、Perlでconstant folding・定数とされるのは文字列・数値リテラルか、定数扱いできる関数だけです。

定数扱いできる関数というのは実は決まっていて、以下の条件がそろわないといけない:

続きを読む
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

現在STF は分散オブジェクトストアとしてピーク時にフロントのディスッパチャー1台につき最大80Mbpsを捌いています。この通常のオブジェクト配信するための動作に関しては裏で実際のオブジェクトを格納しているストレージサーバーもさくさくと動いていて特に問題はないのですが(本当の事を言うとアクセス量が増え続けているので、ストレージは増やし続けないとiowaitがじわじわとあがっていく、という問題はあるけど、それはあくまでも中長期的な問題なので今回の話からは除外)、運用しているとストレージサーバー側でオブジェクトの実体(エンティティ)を補充したり、ストレージサーバー間で移動させたりという処理が必要になります。
この際「このストレージにはいってるオブジェクトを全部なめて、正しい状態に戻す」(リペア)という処理を行う事があります。STFのインスタンスごとに規模が違うのですが、最大規模で1ストレージに付き3000万個程度のオブジェクトが格納されているのでこの「全てのオブジェクト」に対する操作は結構膨大なストレージサーバーへのアクセスを生みます。

例えばワーカーを100プロセス展開しておくと、リペアが起こるまでは平穏なわけですが一旦リペアが始まると突然それぞれのワーカーが一斉に唸りを上げながらストレージを痛めつけ始めるわけです。この際ストレージサーバー全台に対してアクセスがばらけていればこの処理もまだ対応できるのですが、同じストレージサーバーにアクセスが集中すればもちろん死亡フラグが立ちます。

STFに触りはじめて1年半、この間ストレージサーバーは当然壊れますので、リペアはたびたび行う必要がありました。その際アクセス負荷による障害を起こさないようにするのは運用者によるワーカー数の調整が必要になっていました。具体的にはワーカーの数などをちょこちょこ調節するわけです。

STFを触り始めた時からつい最近までこのワーカープロセス数の設定はファイルに記述されており、ファイルの編集→プロセスの再起動という処理を行う必要がありました。もちろん設定ファイルはレポジトリに格納されているのでレポジトリで編集→デプロイでもいいのですが、これはこれでまた面倒な話です。

というわけでこれを自動化していくべく何をしたか:

続きを読む
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

前提: STFのワーカーのプロセス数

STFを受け継いだ時点ですでにワーカープロセスの形は決まっていた。いくつかのサーバーにワーカーの「親」プロセスがいて、そいつが必要に応じて本当の処理をするための子プロセスをforkしていく。どの種別のワーカーがどれだけforkされているか、というのはParallel::Scoreboardに記録されてた。それぞれの種別のワーカーがどれだけforkされるべきか、というのは設定ファイル等に書いておく。設定ファイルは(面倒なので)全てのワーカーで共通。

共通設定ファイルにワーカー数が書いてあるということは、例えばワーカー(親)を増やしたりすると、その分だけ単純にワーカーが増える。例えば Replicateというワーカーが4プロセスforkされるように書いてある設定ファイルで、ワーカーを3から4に増やすと、システム全体のReplicateワーカー数が単純に12から16に増える。

だいたいの場合これでも問題ないけれども、そもそも直線的にワーカー数を増やした場合に皮肉な事に裏方のストレージサーバーが耐えられない、ということもありえる。ということは常に総ワーカー数を逆算しながら設定ファイルを書いて例えば「最大30個くらいのワーカーまで耐えられて、で今5サーバー x 4プロセスで20個で、これから4個追加するから1サーバーあたりのプロセス数は・・・」とか考えなくてはならない。

別に親ワーカーの数が10000とかおかしな事にならなければできない事じゃないけど、まぁそれでも計算を間違える可能性もあるし、なにより人間がその計算方法をちゃんと意識しなければいけないのがいけてない。総数から勝手に調節してほしい!

・・・というのがそもそもの発端。

続きを読む
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

ZeroMQ.pmをつい相続してしまってから本家libzmqの変更についていけず大分悩んだんだけど、ここのところ直してリクエストが多かったので一念発起してlibzmqのPerlバインディングを大幅リニューアルしました。まだ正式リリースは出してないので、何か文句を言うなら今のうち!英語での解説はこちら

いままでlibzmqの直接バインディング、定数、Perlっぽいシンタックスシュガーのラッパーを全部同じディストリビューションにいれていたのをばらしました。これまでZeroMQ::Raw とされていたのは ZMQ::LibZMQ2 ならびに ZMQ::LibZMQ3 となりました。ZMQはこれらのバインディングをうまいことオブジェクト風味にするPPモジュール。ZMQ::Constantsはlibzmqのバージョン毎にやたらと変わるので別モジュールで切り出しました。あとすごくざっくりですが CZMQのラッパも書きました。こちらはZMQ::CZMQというもの。

なおZeroMQ → ZMQの変更についてはlibzmqのメンテナから名前を変えてくださいという半強制的なお願いが出ていたので名前の変更はもう大分前から予定してました。


というわけでお父ちゃん疲れたよ。
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

STFではキューへのジョブ挿入は基本的にはエラーが起ころうとなんだろうと無視して次の処理に移るように最初から書いていたけど、挿入時にDBが接続を受け付けるけどそこでブロックしてしまった場合の考慮をしてなかったので、厳しめのタイムアウトを設定するとともに、そういうエラーが起こった際にキューがSPOFにならないようにkazeburoさんのアドバイスの元 複数のキューに書き込みをできるようにしました

現時点ではこの機能はQ4MだけでTheSchwartzはまだ実装してない。ドキュメント書かないとな・・・
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

小ネタ。GETした内容のMD5が欲しかったので。

    use strict;
    use Furl::HTTP;
    use Digest::MD5;

    my $digest = Digest::MD5->new;
    my $furl = Furl::HTTP->new;
    $furl->request(
        method => "GET",
        url => "http://whatever/text.txt",
        write_code => sub {
            my ($code, $msg, $hdrs, $partial) = @_;
            return unless $code ne 200;

            $digest->add( $partial );
        }
    );
    print $digest->hexdigest;
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

STFでMOVEをサポートした。オブジェクト名を変更できるヤツ。あとSTF_ENABLE_STORAGE_METAってのを1にすると管理画面からストレージ毎にコメントをつけられるようになる。

あと次に時間があるときに指定フラグがオンだったらオブジェクトのMD5とエンティティのMD5を記録するようにしようと思う。ただし、これはあくまでもオプションとして実装する予定。
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

昨日の夜、ビールの缶のプルトップをぷしゅっ!とあけてぐびぐびと一番うまい最初の一口を飲んで、ベッドの上からツイッターに発泡酒よかビールのほうがうまい、とか書いてたらtwitterで今年のWhite Camel Awardをもらったということを聞いた。ちなみに以前の受賞者には@miyagawaさんとかがいます。

本人いないところでやるのはどうなのよ、とは思いつつも(まぁしょうがないっすよね!)、大変ありがたい話です。White Camel Awardが何か知らない人に説明すると、要はPerlの技術とかそういうところでの貢献ではなくて、コミュニティであったりイベントであったりマーケティングとかそういうところでPerlに貢献した人を表彰してくれるっていうヤツです。JPAとかの活動により、ということらしいです

 でも仕事の大部分をしているのはYAPCを任せている櫛井さんであったり、JPAの中の人達だったり、僕から無茶ぶりな仕事を請け負ってもらっている方達だったり、JPAの経理を全部やってる嫁あたりなんですが、代表ということでありがたくいただいておきます!あと、もちろんスポンサーの企業の皆様もそうですね。YAPC, JPAともスポンサーの皆様のおかげで運営できております

前にもtwitterには書いたんだけど、折角こういう形で海外にも少し名前は売れてますし、英語もボチボチ喋る事ができるんで今後は日本での活動を海外にもアピールしていくっていうスタンスで僕はやっていきたいなぁ、と考えています。

そういう意味では国内の事は誰かに禅譲できるといいなぁ、とかなんとか考えております・・・団体としてちゃんとサポートするから、良い後継者いませんかね。公な活動というのもなかなか楽しいですよ!
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

6/22 修正: mod_perlじゃなくてただのapache moduleだった。自分の中でmod_perlとapache moduleが同じ箱に入ってて違和感なくmod_perlって書いちゃった・・・

-----

今の職場ではちょっと前から「開発支援」という名目で仕事をしている。まぁ要は「ちゃんとVCS使え」「テスト書け!」「プロセスを自動化しろ!」とか煩いことを言うおっさんの役目なわけです。

まぁそんな事をしてるのであんまり表側のアプリとかを直接触ったりはしないのですが、あるとき突然某システムの話をしてるときに「あ、これオブジェクトストレージに突っ込もう」という話になりました。聞くともう大分前から使ってるSで始まって、Tが間にあって、Fで終わるオブジェクトストレージの事らしいんですが、これのフロントエンドがmod_perl apache moduleで書かれてるわけですよ。

・・・テストできない(しづらい)じゃん!

そんなわけでAPIの基本部分だけでいいからPSGIのがほしいよね!ってことになり、Plack-App-STFってのを書いて、これを通してテストするようにしてみた・・・のが運の尽き。IRCでどっかのCTOさんが「本体も書き直してよ」的な事を言うわけですよ。

しょうがないですよね。昔はどうであれ僕も今はサラリーマンですからね。役職にChiefってつく人に言われたらやりましょう。

というわけでとあるオブジェクトストレージのフロントエンドがmod_perl apache moduleで書かれてたのを完全にPSGIベースに直して、この間からすこーーーしずつリプレースをしようという事で作業をしている。

元々動いているシステムなので全部入れ替わるのは大分先の話だろうけど・・・

で、まぁまだソースコード出してないけど、今回これを作るのにやったことやなんとなく思ったことなど。

仕組みとしてはディスパッチャーがあり、こいつが裏方にある複数台のストレージノードにGET/PUT/DELETEを発行する形でデータのやりとりをしている。例えば GET http://stf/hoge.jpg とかしたら、裏にN台ある/hoge.jpgを保管してあるストレージの中から一台を選んでそいつのデータをクライアントに送る。

これまでのコードは mod_proxyに近いことを apache module内でやってたんだけど、Plack/PSGIでProxyとかなんかPerlのリソースの無駄遣いな気がしたので mod_reproxyを使う事にしたのが大きな変更点のひとつ。要は新しいバージョンからディスパッチャーがまずランダムにHEADを裏方に発行して、一番速く、かつ200が帰ってきたストレージのURLをX-Reproxy-URLでmod_reproxyに送るというもの。

このmod_reproxyは弊社の内部事情でフロントがapacheなので@kazuho氏謹製のmod_reproxyを使っている・・・が、一部問題が出たので色々俺俺な変更を入れたmod_reproxyを現在はつかっている次第。マージ/レビューを待っている今日この頃!

あと、裏方にHTTPリクエストを送る方法なんだが、これ複数リクエストを同時に送って待つ、みたいなコードだからここだけ非同期にしたら速いんじゃね?とか安易な考えで実装してみたら正直大して速くなかった。まぁそこだけイベントループのスタート・終了がある分オーバーヘッドがあるわけだし当然っちゃあ当然なんだけど、それよりFurlの速いこと速いこと。もうこの手のAPIとかを叩く系のクライアントは本当Furlだけでいいよ。変にI/O多重化するより普通のループでFurlをぶんまわしたほうが全然速い。

最後に、はまったこと。歴史的な事情によりID生成の際のロック機構にSysV IPCを使ってるんだけど、semaphoreはグローバルだってことをみんな忘れないでな!特に、Starletとかの中のアプリでsemaphore使ってると、時々世代交代が起こることを忘れるな!DESTROYとかに $sem->removeとか入れておくと確保したはずのsemaphoreが子プロセスに勝手に消されてて他のプロセスが簡単に死ぬぜ。こういうのはDESTROYとかの中で if ($$ == $parent_pid) とかしてちゃんと「リソースを作ったプロセス」が「リソースを解放するプロセス」かどうか確認してから解放しましょう。



まぁそんなわけでmod_perl apache moduleだったオブジェクトストレージをPSGIで書き直した。正直大分コードの見通しもよくなった気がするし、なによりMiddlewareとかも使えるし、拡張性がぐっとあがったので満足。パフォーマンスはまったく遜色ないかと思う。

ロケタッチとかの一部サービスは今ヘッダを見るとPerlが裏で動いているのが見えるはずですね。しかしこれは開発支援なのか?という疑問は未だに残っている。

おしまい。



    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

最近PSGI/Perlをサポートし始めたdotCloudのinvite codeをもらったのでとりあえずHello World的なアプリを作った。

作り方だが、まずdotcloud用のツール類をインストールする必要がある。自分のマシンでpythonを動かした事がなかったのでそこから。まず自分のpythonは homebrew経由で入っているヤツで、全てユーザー権限で入っているのでsudoとか使ってないのに注意。

easy_install dotcloud
docloudではまず"deploy"というものを作る。deployは複数の"service"の集合体。"service"はそれぞれが一個のアプリなり、データベースなりを指す(はず)

なのでまず適当に"lestrrat"というdeployを作り

dotcloud create lestrrat
次に"lestrrat.www"というserviceを作る

dotcloud deploy --type perl lestrrat.www

この段階ではまだインフラがセットアップされているだけでアプリ自体は空。アプリ自体はどこに作ってもよくて、次のステップでそのディレクトリを指定すればOK。ここでは仮に~/git/lestrrat.wwwにあるとする

次にアプリそのものをリモートのserviceにpushしないといけない。

デフォルトの挙動では、以下のようにすると特定のディレクトリの中身を*全て*pushする。

dotcloud push lestrrat.www ~/git/lestrrat.www
ただ、ちゃんとバージョンコントロールをしたい場合は現段階ではhgとgitがサポートされていて、この場合は若干挙動が違う。

もし指定されたディレクトリに.gitディレクトリがあれば、リモートにgit pushしたのと同じような動作になる。つまり、git commitしてないファイルはpushされない。自分はとりあえず作業量のディレクトリを作り、git initした。

つぎ。リモート側で動くアプリは当然PerlにしたいのでPSGIファイルが必要なのだが、dotcloudではserviceディレクトリのルートにあるapp.psgiというファイルがデプロイされる。

追記5/1: 今回は生PSGIファイルを使うけれども、当然CatalystDancerMojoliciousをデプロイすることが可能だ。この記事では動くまでの理屈を追いたいので敢えてフレームワーク等は使ってないけれども、普通は何らかの形でそういうフレームワークを使う事になるだろう。それぞれの使い方はリンクを参照のこと。

dotcloudのチュートリアルではこのファイルはbinに実体を置いて、ルートにはsymlinkをつける、というような形になっていたが、なんせHello Worldで面倒くさいのでそのままぼん、とルートに置いた。

内容は以下のような感じ。

use strict;
return sub {
    my $env = shift;
    return [
        200,
        [ 'Content-Type' => 'text/html' ],
        [
            "<html><head><title>Hello</title></head>",
            "<body><h1>Hello, Stranger</h1><p>Here's a dump of what I know about you</p>",
            (map { "<tr><td>$_</td><td>$env->{$_}</td></tr>\n" }
                grep { /^HTTP_/ }
                keys %$env),
            "</table></body></html>"
        ],
    ]
};

これを以下のコマンドでリモート側に送ると、向こうで色々魔法が起こって、サービスが http://www.lestrrat.dotcloud.com/ であがっている・・・という感じ。

 dotcloud push lestrrat.www ~/git/lestrrat.www

ちなみに最後のコマンドはもう書くのが嫌になったので、Makefile.PLを作って以下のような記述をしておいた。これでmake dotcloudでpushされる。(注意!Module::Installを使う場合はinc/以下もpushしないといけないので、git commitしないといけないようです!)

use inc::Module::Install;

name 'lestrrat-DotCloud-Hello-World';
version '0.01';

postamble(<<EOM);
dotcloud:
     dotcloud push lestrrat.www \$(PWD)
EOM

WriteAll;

あと依存関係の類もMakefile.PLで解決してくれるとのこと。やったね!

ってことで、近々dotCloudでアプリをつくるですよ
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

LinuxやMac OS Xを使っていれば、大抵の場合/usr/bin/perl などの位置にPerlが入っていますが・・・これらを使うのはやめたほうがいい、というのが段々定説になりつつあります。

厳密に言うと、別に簡単なスクリプトを書くのにシステム標準Perlを使うのは問題ないのだけれども、CPANからモジュールをインストールするつもりならシステム標準Perlを使わないほうがいいでしょう、という事ですね。

自分としてはシステムPerlを使わない理由はふたつある。

ひとつはシステムPerlはそれに依存するものがOS・システム本体にあるため、それに変更を加えると何かが壊れることがあること。例えばついうっかりモジュールのバージョンをあげてAPIが変わってしまったためになにかが壊れるとか、Perl-5.14.0 を使いたい!と思った時にシステムPerlが5.10.0でアップグレードすると怖いとか。

もう一つはこういうわけのわからない理由で急に動かなくなったりしないから。自分があずかり知らないところで起こった事で自分のPerlが動かなくなるとか意味がわからん。

これからPerlを始めようという人は迷わず perlbrew を使うといいと思う。perlbrewなら複数のPerlを管理できるし、ユーザーの権限でperl本体やモジュールが入るのでsudoとかルート権限とか悩まないで済むし、自分だけが使うので知らないところで他の何かを壊す心配がぐっと減る。

ちなみに僕のマシンには今これだけのPerlが入ってます!下の二つは、5.8.9が昔いれたhomebrew のperl、/usr/bin/perlはシステム標準 Perlです。設定に失敗したらインストールをし直せばいいだけだし、気楽にいろんなperlが入りますね!これからは是非自分のPerlで作業してみてください!

daisuke@beefcake ~$ perlbrew list
  perl-5.12.2
  perl-5.12.2-threaded
  perl-5.12.3
  perl-5.12.3-threaded
* perl-5.14.0-RC1
  perl-5.8.9
  /usr/local/bin/perl (5.8.9)
  /usr/bin/perl (5.10.0)

    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

@tomitaさんが書いた「CPANモジュールガイド」の刊行記念ということで池袋のジュンク堂本店で話して・・・もとい、コードを書いてきました。普段は滅多にこういう場に現れない「初めてのPerl」や「プログラミングPerl」の翻訳者である近藤嘉雪氏がもう一人のゲスト。司会がもはや技術界のタモリと化しつつある@yusukebe。あと@941さんがスタッフとして手伝いに来てくれました

近藤さんを見られるというだけでも実はすごいイベントだった気がする。ちなみに近藤さんは出番直前まで頑張ってスライドを書いていて、そのおかげで話にクロージャが含まれたそうです!

こちらは@tomitaさんが書いた店頭POP。「Placクマ」の二重のパクリがひどいですねwww !


イベントの内容自体は・・・なんだかリハーサルというか、ちゃんとした打ち合わせもしてなかったのに、すごく内容が良い感じになった気がしますね。Perlの基本を@tomitaさんと近藤さんが丁寧に説明してくれて、最後に僕がわーーーっとCPANモジュールを使ってコードを書く過程をなぞる、という感じ。

自分の発表はCPAN 30分クッキングということでCPANから色々ダウンロードしてきてFacebook::Graphとか使ったらこうなるよー的なコードをざくざく書きました。

最終的に書いたコードは、@sugyanさんのブログのパクリと、自分の友達のタイムラインからロケタッチのリンクを抜き出してきてHTMLを作る、というようなもの。本番では実はトラブルがあって最後のロケタッチページを作成するためのHTTPリクエストがうまく動かなかったので一瞬焦ったが、「CPAN 30分クッキング」ということで「すでにこちらに出来たものがございます」というものを用意しておいたので助かった。一応その程度のネタは仕込んでおいてよかった・・・

というわけでなかなか楽しかった!みんな、もっと僕らの本を買ってくれると次が出せるようになるからよろしくお願いします!w


さて、僕の発表ですが、全然中身はないですが、スライドは以下のような感じ:


あと一応こちらがコード。最初にconfig.plというファイルの中に自分のFacebookアプリ用のapp_idとsecretを入れておく

return {
    app_id => "XXX your app ID",
    secret  => "XXX your app secret"
};

まずはsugyanさんのパクリのヤツ。アクセストークンをコピペするのが面倒くさいのでコンフィグファイルにダンプするようにしてある:

use strict;
use Data::Dumper;
use Facebook::Graph;
use Plack::Request;

my $config = require "config.pl";
my $fb = Facebook::Graph->new(
    app_id => $config->{app_id},
    secret => $config->{secret},
    postback => "http://localhost:5000/"
);

return sub {
    my $env = shift;
    my $req = Plack::Request->new($env);

    if ( my $code = $req->param('code') ) {
      warn "requesting access_token";
        $fb->request_access_token( $code );
        my $dump = Dumper({
            %$config,
            access_token => $fb->access_token
        });
        $dump =~ s/\$VAR = //;

        open my $fh, '>', "config.pl" or
            die;
        print $fh $dump;
        close $fh;
        return [ 200, [], [ $fb->access_token ] ];
    }
      warn "redirect";

    return [
        302,
        [
            Location => $fb->authorize
                ->extend_permissions( "publish_stream" )

                ->uri_as_string
        ],
        []
    ];
}

で、こっちがFacebookにアクセスしてロケタッチのデータだけ抜き出してくるヤツ。普通にFacebook::GraphのAPI使ってたらおせーな、と思ったのでFurl+Coroしてみた。よくよく考えてみると CoroとCoro::LWPしとけばFurl使わなくても多重化できるから速くなる気がするが、まぁ後悔はしてない

use strict;
use Text::Xslate;
use JSON;
use Coro;
use Coro::Select;
use Furl::HTTP;
use Facebook::Graph;
use Data::Dumper::Concise;

my $config = require "config.pl";
my $fb = Facebook::Graph->new(
    app_id => $config->{app_id},
    secret => $config->{secret},
    access_token => $config->{access_token},
);
my $data = $fb->query->find("me/friends")->request->as_hashref;

my $furl = Furl::HTTP->new;
my @coros;
foreach my $friend ( @{ $data->{data} } ) {
    my $q = $fb->query->find( "$friend->{id}/feed" );
    push @coros, async {
        my (undef, $code, undef, undef, $body ) = $furl->get( $q->uri_as_string 
);
        return unless $code eq 200;
        return decode_json $body;
    } $q->uri_as_string;
}

my @spots;
foreach my $coro (@coros) {
    my $feed = $coro->join;
    next unless $feed;
    foreach my $entry ( @{ $feed->{data} } ) {
        if ( $entry->{caption} eq 'tou.ch' ) {
            push @spots, $entry->{link};
        }
    }

}

my $xslate = Text::Xslate->new(
    path => [ "." ],
    syntax => 'TTerse',
);

print $xslate->render_string( <<'EOM', { spots => \@spots } );
<script type="text/javascript" src="jquery-1.5.2.min.js">
<script type="text/javascript">
var urls = [ [% FOREACH spot IN spots %]"[% spot %]"[% IF ! loop.last %],[% END %][% END %] ];

$(document).ready( function() {
    var delay = 200;
    var f = function() {
        url = urls.pop();
        url = url.replace( /\/$/, "" );
        url = url.replace(/\/spot/, "/widget/spot");
        var iframe = $('<iframe frameborder="0" scrolling="no" allowtransparency="ture" height="321" width="350" src="' + url + '?i=0&m=1&t=blue&width=350"></iframe>');
        $("#container").append( iframe );
        setInterval(f, delay);
    };
    f();
} );

</script>
<div id="container"></div>
EOM
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

なんかふと気づいたら最近以前書いたPerlでシグナル処理の記事にブクマがついていたので続き的な感じで書いてみた。

例えば 以下のように、ワーカーとかでずーーーーっとDBにクエリを投げてその結果を使って処理をする、というような処理を書くとする

     while ( $loop ) {
         my $sth = $dbh->prepare( .... );
         $sth->execute();
         while ( $sth->fetchrow_arrayref ) {
              ....
         }
     }

以前書いた%SIGを用いたPerlの普通のシグナル処理では、もしexecute()でブロックしていた場合など(例:Q4Mでqueue_waitしてる)ではいくらSIGINTとかを送ってもブロックしたまんまになる。理由はPerlの素のシグナル処理は*Perlの*1オペと1オペの間に実行されるから。データベースに対する処理はCレベルでブロックしていて、実はこれはほとんどの場合Perlの1オペがブロックしてる間に終わらない

そういう場合は%SIGでシグナル処理をするのではなくて、POSIX::SigActionとかを使う。POSIXレイヤーでシグナルハンドラを指定できるので、Cレイヤでのブロック状態中でもシグナルハンドラを呼び出せる。Perlの世界から見ると、Perlのオペ完了を待たずにすぐに実行されるのでこれらをリアルタイムシグナルと呼ぶ。基本の使い方はperldoc POSIXした時にでてくる。

で、シグナルを受け取った時に現在実行中のステートメントハンドラをキャンセルするには$sth->>cancelを呼べばいいし、ついでにDBも接続を落としちゃうなら$dbh->disconnectとかしちゃえばいい

    use POSIX qw(:signal_h); # import SIGINT, SIGTERM, and other signal related stuff

    my $sth; # declare now to make it accessible
    my $sigset = POSIX::SigSet->new( SIGINT ); # specify which sig we're handling
    my $cancel = POSIX::SigAction->new(sub { # the handler
        if ( $loop ) {
            eval { $sth->cancel };
            eval { $dbh->disconnect };
            $loop = 0;
        }
    }, $sigset, &POSIX::SA_NOCLDSTOP);
    POSIX::sigaction( SIGINT, $cancel ); # register them handler

    while( $loop ) {
        $sth = $dbh->prepare( ... );
        $sth->execute();
        while ( $sth->fetchrow_arrayref ) {
             ....
        }
     }

これでSIGINTでちゃんとキャンセルされる。ただ、当然ながらキャンセルされた結果undefになる変数とかがあるなら、それは while の中で参照しないように自分で気をつけて処理をするように。

あと、sigaction() でシグナル設定するの面倒くさいよ!って人は%SIGRTっていう、リアルタイムシグナル用の%SIGハッシュがあるらしい。自分は間違えそうなので使ってないけど。use POSIX; すると自動的に現スコープから参照できるようになる。

そうそう、激しくオフトピだけど、use POSIX; は、実に数百個(うろ覚え)もの関数や変数を現パッケージにインポートするので、効率を重視したいなら注意。必要なものだけ明示的にインポートするか、常にPOSIX::hogeのようにして参照するほうがよいだしょう。
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

追記2:参考まで【その1】【その2】。そして僕は最初に書いた時も、sysreadの指摘を受けたときも正直な感想としては「そこまで考えて使ってません!」みんなよう気づくわ。すごいっす。

追記:間違えてた。ほんとだー。そう言われれば当たり前ですねすみません。sysreadのほうが速いのは当然です!

use strict;
use Benchmark qw(cmpthese);

cmpthese -1, {
    sysread => sub {
        my $buf;
        open my $fh, '<', __FILE__; 
        sysread $fh, $buf, -s __FILE__;
    },
    slurp_local => sub {
        local $/;
        open my $fh, '<', __FILE__;
        my $buf = <$fh>;
    }
};

なんかtwitter見てたらこういうのを貼ってる人がいたので、一応書いておく。

Perlでファイルを一気に読み込むのは local $/; <$fh> が一番速い。

     open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
     my $content = do { local $/; <$fh> };

いずれにせよ大きいファイルを処理する場合はこういう風に一気に読み込むのは効率悪い。それを分かった上で、それでも1行ずつ改行コードが取り除かれた状態で配列に読み込みたいならこれをsplitするのが一番速い

     open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
     my @lines = split /\n/, do { local $/; <$fh> };

単純に一行ずつ処理する、という話だったら一括読み込みとかは忘れて、一行ずつ処理がベター。

    open my $fh, '<', "/path/to/file.txt"
         or die "failed to open file: $!";
    while (my $ln = <$fh>) {
         ....
    }
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

ちょっとだけ躓いたりしたので、備忘録のため。AnyEventでData::MessagePackを受け取るサーバー
use strict;
use AnyEvent;
use AnyEvent::Socket;
use Data::MessagePack;
use Data::Dumper;

main();

sub main {
    my $host = undef;
    my $port = 8888;
    my $guard = tcp_server $host, $port, sub {
        my ($fh) = @_;
        handle($fh);
    };

    my $cv = AE::cv;
    my $w; $w = AE::signal 'INT' => sub {
        undef $w;
        undef $guard;
        $cv->send;
    };

    $cv->recv;
}


sub handle {
    my $fh = shift;

    my $packer = Data::MessagePack::Unpacker->new;
    my $buf = '';
    my $offset = 0;
    my $w; $w = AE::io $fh, 0, sub {
        my $n = sysread $fh, $buf, 65536, length $buf;
        if ( $n == 0 ) {
            undef $w;
        }

        while (length $buf > 0) {
            $offset = $packer->execute( $buf, $offset );
            if (! $packer->is_finished) {
                last;
            }

            warn Dumper( $packer->data );
            substr( $buf, 0, $offset, '' );
            $offset = 0;
            $packer->reset;
        }
    };
    my $s; $s = AE::signal INT => sub {
        undef $w;
        undef $s;
    };
}
適当なクライアントスクリプト
use strict;
use Data::MessagePack;
use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;
use AnyEvent::Util;
my $count = shift @ARGV || 100;

my $cv = AE::cv;
my $w; $w = tcp_connect '127.0.0.1' => '8888' => sub {
    my $fh = shift;

    AnyEvent::Util::fh_nonblocking($fh, 1);
    my $i = 0;
    my $h = AnyEvent::Handle->new(fh => $fh);
    my $next = sub {
        $cv->begin;
        $h->push_write( Data::MessagePack->pack({ foo => $i }) );
    };

    $next->();
    $h->on_drain(sub {
        my $h = shift;
        $cv->end;
        if (++$i < $count) {
            $next->();
        } else {
            undef $w;
        }
    });
};

$cv->recv;
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

追記:わかりにくかったらしいので若干コードと説明を変えてみた

use strict;

sub foo {
     my $n = shift;
     warn $n;
     next if $n > 5;
}

foreach my $x  ( 1..10 ) {
     foo( $x );
     warn "after foo";
}
これで嵌った。問題は当然 "next"。ループの中で呼ばれるfooの中で"next"を使ってるので"after foo"は5回しか表示されないのだ。

理由が分かってみればなるほど、だったけど、これはしばらく嵌った。ちなみにuse warningsしてると
"Exiting subroutine via next"
っていう警告がでるよ!良い子はnextの変わりにreturnを使ってね!
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

package MyApp::Xslate::Bridge;
use strict;
use parent qw( Text::Xslate::Bridge );
use Text::Xslate qw( html_builder );
use Text::Markdown ();
    
__PACKAGE__->bridge(
    function => {
        markdown => html_builder { Text::Markdown::markdown(@_) }
    }
);  
        
1;       
呼び出す側はこう
use Text::Xslate;
my $xslate = Text::Xlate->new(
    ....,
    module => [ 'MyApp::Xslate::Bridge' ]
);
$xslate->render( ... );


おいおい、Text::Xslate素敵すぎるだろ。

今日Markdownを使いたいと思ってちょっと考えたら、これだけで終了した:
use strict;
use Text::Xslate;
my $xslate = Text::Xslate->new(
     ....
     module => [
          'Text::Markdown' => [ 'markdown' ]
     ]
);
print $xslate->render_string( <<EOT, { text => $some_markdown_text });
     [% text | markdown | mark_raw %]
EOT
素敵!gfx 先生になら抱かれてもいい。

俺もXSできる人間の端くれとしてxslateの中身をちゃんと把握しよう・・・
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

さきほどの記事に関してtokuhiromに指摘されたのでRPC::XMLにしてみた。基本的にはここに書いてある事と同じ
で自分がちょっと変更した部分は以下の通り:

  1. XMLRPCで prefix.method_nameって呼んでた名残があるので、prefixをとっぱらっちゃう
  2. $q->argsが返すのは RPC::XML::simple_type とかの値なので、これを直してあげないとXMLRPC::Liteで動いてたコードが動かない
  3. @ret = () で RPX::XML::resposeを作ろうとするとundefを返してくるので、その後の $content->as_stringがこける。レガシーコードを期待しているクライアント側との兼ね合いもあるので@retが空だったら [] を渡してあげる

use strict;
use Plack::Builder;
use Plack::Request;
use RPC::XML;
use RPC::XML::ParserFactory 'XML::LibXML';

my $app = sub {
    my $req = Plack::Request->new(@_);
    my $q = RPC::XML::ParserFactory->new()->parse($req->content);
    my $method_name = $q->name;

    # (1) 
    $method_name =~ s/^prefix\.//; 

    my $code = $webapp->can($method_name);
    if (! $code) {
        return [
            404,
            [ "Content-Type" => "text/plain" ],
            [ "RPC method $method_name not found" ]
        ];
    }

    # (2)
    my @ret = $webapp->$code( map { $_->value } @{$q->args} );

    # (3)
    my $content = RPC::XML::response->new( @ret ? @ret : [] );
    return [
        200,
        [ "Content-Type" => "text/xml" ],
        [ $content->as_string ]
    ];
};

builder {
    enable 'ContentLength';
    $app;
};

    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

諸事情によりレガシーなXMLRPC::LiteベースのプログラムをPlack上にポートすることになったので色々悪戦苦闘してみた。とりあえず普通に動かすのは辛い、ということはなんとなくわかったので色々やった結果、こんな感じのコードを書けばとりあえずディスパッチは動くようになった。もしベターな方法があったら教えて下さい(XMLRPC::Lite以外のベターなライブラリでもOK!)

(追記:指摘を受けたのでRPC::XMLで書き直してみた

use strict;
use Plack::Builder;
use CGI::Emulate::PSGI;
use IO::String;
use XMLRPC::Transport::HTTP;

my $xmlrpc = XMLRPC::Transport::HTTP::CGI->dispatch_to( "MyApp" );

builder {
    my $code = CGI::Emulate::PSGI->handler(sub {
        $xmlrpc->handle;
    });
    sub {
        my $env = shift;
        my $io = $env->{'psgi.input'};
        my $content = do { local $/; <$io> };

        $env->{'psgi.input'} = IO::String->new($content);
        delete $env->{'psgix.io'};
        local %ENV;
        $code->($env);
    };
};
psgi.inputに関してはPOSTデータを読み込むのにSOAP::Lite側で Plack::TempBufferをsysreadしようとしていて、そうすると必ず 0 を返すのですな。open()で作れる疑似ファイルハンドルやなんかでお茶を濁そうとがんばって見たのだけど、結局IO::Stringのようにtieしないと動かないという結論に

なんで local %ENVしてるのかは忘れちゃった。

というわけでこうして動くサーバーは作れたのだけど、なんか他に良い方法あるのかなー
    このエントリーをはてなブックマークに追加 mixiチェック Share on Tumblr

このページのトップヘ