As Sloth As Possible

可能な限りナマケモノでありたい

タグ:Perl

「RubyKaigiが終わったら真面目にやろう」とか言ってたくせに、中々やる暇無くて放置してたら大変に分かりやすい作り方講座が出てしまった上、弾さんまで乗ってきてしまって完全にタイミングを逃したfaultierですこんばんは。

悔しいので対抗してみる

うどんげが出たならてゐもいてもいいだろう、ということでてゐ。AAは上記の記事同様こちらを使わせてもらった。初春もいいなーと思ったんだけど表示してみたら大き過ぎて自分のターミナルで表示できなかったのでやめといた。コードはこんな感じ。

# tewi.rb
eval$s=%w't=true;e="eval($s=join("<<34<<34<<",qw{$t=1;$s=~/"<<92<<"[[0-9,]+"<<92<
<"]/;$n=eval($&);$e=          "<<39<<"eval$s=%w"<<39<<    ".chr(39)."<<39<<($s+(
($s.length>1756)?"   ":"#"<<$    s.gsub(/[^0-9a-zA-   Z]/,      "")[0,(1755-$s.l
ength)]));e[-312,  311]=""<<39<<   ";$e.=          ("<<39<<"#"<   <39<<".substr(
join("<<39<<39<<  ",split(/[^0-9a-z              A-Z]/,$s)),0,(200  9-length($s)
))).chr(39)."<<  39<<".join"<<39<<";@o   =       map{$t=!$t;split(//  ,((!$t)?su
bstr($e,0,$_,"< <39<<39<<"):chr(32)x$_)         )}@$n;for(1..34){spli  ce(@o,$_*
81,0,chr(10))}  ;print(join("<<39<<39<<         ",@o).chr(10      )    )}))";o=[
101,10,24,4,40 ,3,8,4,18,3,4,6,33,2,13           ,3,6,10,1            2,3,30,2,1
7,14,17,2,27,  2,21,3,1,7,19    ,2                     ,              25,1,23,9,
21,2,23,2,23,  9,12,6,1,                           4                   ,23,1,23,
11,9,12,23,2, 13,4,2,2                   1                             ,1,14,23,
2,9,27,1,19   ,22,1,8         ,                  1    9   ,             1,29,20,
3,7,9,1,      18,1,4      ,         1        ,          3           ,    1,13,16
,6,6,6,      1,9,1,8                          ,1           ,    1    0,    1,11,
1,4,14,      6,7,26,                   2,1     1,1,4   ,1              ,4,   2,4
,12,6,7     ,19,3,5,             5,  3,2,14,3  ,3,1   0,5               ,8,13  ,
2,2,8,    2,4,3,3,15,          5,2    ,7    ,  4,11 ,10,3,              4,2,4,1,
2,4,    1,6,14,12,4,1      3  ,   6,1,     2,1,3,4,5,18,3,1,3   ,   1   ,3,12,3,
12,1   3,5,1,2,4,15             ,1,1, 11    ,10,3,14,12,6,1 ,           2,5,13,2
,1   ,1,1,6,12,2,16            ,11,7, 8,     13,2,1,7,13,1  , 1      8,10,8,6,14
,  1,2,10,10,1,20,1           2,5,3,1        2,1,6,13,7,2,  1       9,13,26,14,7
, 2,16,16,11,1,13,14          ,8,2,14,      16,13,7,5,15,1 0,          3,8,10,1,
8 ,25,10,1,4,13,27,23,            12,4,   2,12,5,1,1,1 ,8,1,1             3,17,1
0  ,1,3,5,1,12,14,4,8,             4,10,2,13,25,2,3,9,4,2,1,3              ,15,1
3,  33,4,5,1,4,3,20,                8,182].map{ |i|t=!t;((!t)              ?e.sl
ice  !(0,i):32.chr*                i)}.join;1.up       to(35               ){|i|
o[(i*   81)-1,0]          =        10.chr};puts(o)#ttrueeeva          l    sjoin
3434qwt1                           s920992nevale39evalsw39            chr3  939s
slength1     7 5        6             sgsub09azAZ01755s          l   ength e3123
1139e39              39su        bstr          jo             #t1s09nevaleevalsw
chr39tt  rue         eeva  l   sjoin3434qwt1s9             20992nevale39evalsw39
chr3939sslen    gth17 56sg   sub09azAZ01755slengt        he31231139e3939substrjo
in3939split09azAZs02009lengthschr3939join39omapttsplittsubstre03939chr32xnfor134
spliceo810chr10printjoin3939ochr10o10110244403841834633213361012330217141'.join

Gistにも置いてあります。はい。

Quineじゃない件

上のコードをコピペしてRubyに実行させると何やらコードを吐くので、それをさらにRubyに流し込んで実行させてやると…なんということでしょう!エラーを吐くではありませんか!Quineになってねぇじゃねーか、このド低能が!

# tewi.pl(tewi.rbの出力結果)
eval($s=join("",qw{$t=1;$s=~/\[[0-9,]+\]/;$n=eval($&);$e='eval$s=%w'.chr(39).'t=
true;e="eval($s=join(          "<<34<<34<<",qw{$t=1;$s=    ~/"<<92<<"[[0-9,]+"<<
92<<"]/;$n=eval($&)   ;$e="<<3    9<<"eval$s=%w"<<39   <<".      chr(39)."<<39<<
($s+(($s.length>17  56)?"":"#"<<$   s.gsub          (/[^0-9a-zA-   Z]/,"")[0,(17
55-$s.length)]));  e[-312,311]=""<<3              9<<";$e.=("<<39<<  "#"<<39<<".
substr(join("<<3  9<<39<<",split(/[^0-9   a       -zA-Z]/,$s)),0,(200  9-length(
$s)))).chr(39)." <<39<<".join"<<39<<";@o         =map{$t=!$t;split(//,  ((!$t)?s
ubstr($e,0,$_,"  <<39<<39<<"):chr(32)x$_         ))}@$n;for(1      .    .34){spl
ice(@o,$_*81,0, chr(10))};print(join("<           <39<<39<<            ",@o).chr
(10))}))";o=[1  01,10,24,4,40    ,3                     ,              8,4,18,3,
4,6,33,2,13,3,  6,10,12,3                           ,                   30,2,17,
14,17,2,27,2,2 1,3,1,7,                   1                             9,2,25,1
,23,9,21,2,2   3,2,23,         9                  ,    1   2             ,6,1,4,
23,1,23,1      1,9,12      ,         2        3          ,           2    ,13,4,
2,21,1,1      4,23,2,                          9,           2    7    ,1    ,19,
22,1,8,1      9,1,29,                   20,     3,7,9   ,1              ,18   ,1
,4,1,3,1     ,13,16,6             ,6  ,6,1,9,1  ,8,1   ,10               ,1,11  
,1,4,14    ,6,7,26,2,1          1,1    ,4    ,  1,4, 2,4,12              ,6,7,19
,3,5,    5,3,2,14,3,3,      1  0   ,5,8     ,13,2,2,8,2,4,3,3,   1   5   ,5,2,7,
4,11,   10,3,4,2,4,1             ,2,4, 1,    6,14,12,4,13,6, 1           ,2,1,3,
4,5   ,18,3,1,3,1,3,            12,3,1 2,     13,5,1,2,4,15  , 1      ,1,11,10,3
,1  4,12,6,1,2,5,13,           2,1,1,1        ,6,12,2,16,11  ,       7,8,13,2,1,
7, 13,1,18,10,8,6,14,          1,2,10,1      0,1,20,12,5,3, 12          ,1,6,13,
7, 2,19,13,26,14,7,2,16            ,16,1   1,1,13,14,8, 2,14,1             6,13,
7,  5,15,10,3,8,10,1,8,             25,10,1,4,13,27,23,12,4,2,              12,5
,1,  1,1,8,1,13,17,10                ,1,3,5,1,12 ,14,4,8,4,10,              2,13
,25,  2,3,9,4,2,1,3,                15,13,33,4,5,       1,4,3               ,20,
8,182]   .map{|i|          t        =!t;((!t)?e.slice!(0,i):3          2    .chr
*i)}.join                           ;1.upto(35){|i|o[(i*81)            -1,0  ]=1
0.chr};pu     t s        (             o)#ttrueeevalsjoi          n   3434q wt1s
920992ne              vale        39ev          al             sw39chr3939ssleng
th1756sg  sub         09az  A   Z01755slengthe3             1231139e3939substrjo
';$e.=('#'.su    bstr( join   ('',split(/[^0-9a-zA        -Z]/,$s)),0,(2009-leng
th($s)))).chr(39).'.join';@o=map{$t=!$t;split(//,((!$t)?substr($e,0,$_,''):chr(3
2)x$_))}@$n;for(1..34){splice(@o,$_*81,0,chr(10))};print(join('',@o).chr(10))}))

ええはい。良く見てもらえると分かると思うけど、実はこのコードは自分自身を出力してない。何を出力してるかと言うと、Perlのコードを出力している。んで、そのPerlのコードは何をするかというと、最初のRubyのコードを出力する。つまり、最初のコードは「『このRubyのコードを出力するPerlのコード』を出力するRubyのコード」で、後のコードは「『このPerlのコードを出力するRubyのコード』を出力するPerl」のコードになっていて、お互いがお互いの自分自身を相手に出力させるという、「人は一人では生きて行けないんだ」というメッセージ性を持った難読コードなわけです。まぁ嘘です。RubyもPerlもやられちゃったので、そのまま真似してもつまらなかっただけです。こんな感じで遊んでみるといいよ!

$ cat tewi.rb | ruby | perl | ruby | perl | ruby

何をしたの?

実のところ別になんということはなくて、やってることは基本的にはうどんげQuineと一緒。配列リテラルとjoinとevalを使ったQuineはPerlでもRubyでも全く同じ要領でできるので、自分自身を吐く代わりに相手のコードを吐くように書き換えると簡単に行ったり来たりできるようになる。

# 任意に加工できるRubyコードを出力する、
# 任意に加工できるPerlコードを出力する、
# 任意に加工できるRubyコードの例
eval$s=%w'puts("eval(join("<<39<<39<<",qw{print("<
<39<<"eval$s=%w"<<
39<<".chr(39)."<<39<
<$s<<39<<".chr(39)."<<39<<".join"<<39<
<")}))")'.join

あとは、二言語分のコードが一つのAAの中に入ることになるし、PerlとRubyだとリテラルがそっくりなのでデータ部は共有したいので生のデータを書きたい、となると流石に元のAAデータだと文字数の制限がキツいから、反転して白抜きのAAにした。ちなみに、てゐの方はうどんげのとはAAデータ持ち方は換えてる(元記事のロジックをPerlで実装するのが面倒だっただけ)。

あとはまぁ、出力時に尻尾に適当なゴミを付けて文字数調整してるんだけど、文字列リテラルの入れ子が簡単に崩れるので面倒臭いとかそんな程度。chr(39)濫用しまくり。あとドットがRubyのドットなのかPerlのドットなのか良くわかんなくなったりします。

まとめ

途中で「俺は一体何をやってるんだ」と思ったら多分負けなんだと思います。一度ベースができちゃうと後はデバッグと文字数の調整が面倒なだけで、割と簡単にできます。あと段々哲学的な気分になります。

もう、こなったら、iphone用livedoorアプリの出力するXML見て、自前でXML組み立てるかな。

誰か助けてください。(切実)

俺日記 : [HELP ME!]perlでlivedoorに投稿するときのカテゴリ設定方法

誰か助けてください、とのことなのでお助けします。…と、その前に一つ注釈というか弁明というかしておくと、実はそのAPI、AtomPubの仕様が完全に固まる前に実験的に作られたもので(まだAtomPPとか呼ばれてたはず)、色んなところがすごく古いです。

結果は惨敗。生成されたXMLを見てみると、ちゃんとcategory要素が追加されてるんだけどなー。

<?xml version="1.0" encoding="utf-8"?>

<entry xmlns="http://www.w3.org/2005/Atom">
  <title>ちょっとテスト(すぐ消します)</title>
  <content type="xhtml">
    <div xmlns="http://www.w3.org/1999/xhtml">いっぱいのつぶやき</div>

  </content>
  <category term="カテゴリ"/>
</entry>
俺日記 : [HELP ME!]perlでlivedoorに投稿するときのカテゴリ設定方法

AtomAPIの仕様を確認したら、atom:categoryじゃなくてdc:subjectを見ていた。どうも当時、2004年くらいはカテゴリーを表す仕様がなかったようで、dc:subjectで代用していたらしい。良く見たらXML::Atom::EntryのUsageにもそんな例が書いてある。ということで、dc:subjectのエレメントを作ってつっこんでやればカテゴリが追加されます。

です、が。AtomAPIはもともと正式にサポートしているものでないブログのQ&A:APIのURLは? - livedoor ヘルプ)上、見ての通り古いものなのでそのうちふさがれます。livedoor Blogで正式に公開してるAPIは今現在はAtomPubAPIの方なので、今AtomAPIでうまく動かないとか、今後Blogと連携するアプリを作りたいとかの場合は、こっちを使って下さい。ちなみにiPhoneアプリはこれを使ってる。

AtomPub APIの方を使って元記事のコードを書くとこんな感じ。あと、AtomPub APIは認証方式がWSSEなので、XML::Atom::ClientじゃなくてAtompub::Clientを使う。

#!/usr/bin/env perl

use strict;
use warnings;
use Atompub::Client;
use XML::Atom::Entry;

my $client = Atompub::Client->new;
$client->username('username');
$client->password('apikey');

my $service     = $client->getService("http://livedoor.blogcms.jp/atom/");
my $article_url = $service->workspace->collection->href;

# ブログが一個しかない場合は↑のコードでarticle collectionのURLが取れるけど、
# (workspaceの一個目がメインブログで、collectionの一個目がarticle collectionだから)
# ちゃんとやる場合は以下のように全部列挙したりして必要なのを選んでください。
# my @workspaces = $service->workspaces;
# for my $ws (@workspaces) {
#     my @collections = $ws->collections;
#     for my $c (@collections) {
#         print $c->title . "\n";
#         print $c->href . "\n";
#     }
# }

my $entry    = XML::Atom::Entry->new;
my $category = XML::Atom::Category->new;
$category->term('つぶやき');
$entry->title('これは、訓練ではない。');
$entry->content('繰り返す、これは訓練ではない。');
$entry->category($category);
$client->createEntry( $article_url, $entry );

あと他にもいくつか独自要素があるとか、実はlivedoor以外のBlogger Allianceのブログでも使えるとか、iPhoneアプリの絡みでときどきアップデートされるとか、あんま使い過ぎるとスパム判定されるのでほどほどにしてね、とかあるけど、その辺は追い追いどっかにちゃんと書きますんで、Wikiとか見てて貰えると。

こないだ言ってたばりったーは実はもう完成してたんだけど、なんかサンプルアプリのつもりが作ってるうちに段々ガチなフレームワークと化してきて、大したアプリじゃないのに中身は意外と複雑でしかもバグだらけ、みたいなことになってしまった。

うーんこれ公開してもいいけど参考になんねーよな、つか飽きたなーとか思って別の遊びを始めたら意外とそっちが楽しくなってきちゃって、こんなものが出来た。

faultier's Asagao at master - GitHub

何これ

Plackを使ってSinatraっぽい感じでWebアプリを書ける雰囲気のフレームワークみたいな(弱々しく)。一応README.jaを読むとどんなものかは何となく伝わるんじゃないかしら。ドキュメントとサンプルアプリくらいは作ってみようとは思いますが、何ができるか試してみる際にはソース読んでくだしあ。(追記)簡単なサンプルコードドキュメント(予定地)作ったよ。

TODO

  • Sinatraが出来ることは一通り出来るようにはしたい
  • 例えばPlack::Builderのenableとかを直に書けるようにするとか
  • passとかbeforeとかafterとか
  • configとかdispatchとか適当すぎるのでどうにかする
  • 今テンプレートがText::MicroTemplateだけなので他のも対応する

思ったこと

Sinatraの中身は意外とサッパリしてた。割とさらっと読めるレベル。

あとこういうDSL的な見た目になるものを実装するのはやっぱりRubyのが楽でいいなぁと思った。同じことやるのにPerlの方がもうちょっとトリックがいる感じ。いやまぁ、慣れの問題もあるんだけども。

なんだか最近個人的にPlack期到来中なんだけど、面白いからみんなもっといじるといいよ。

追記

ブコメで「CPANにDancerってのがありますよ」と教えてもらった。うはぁ。ほんとだ、被ってら。向こうはバージョン1.0ですし当然ながらもっとずっとちゃんとしてます。ひー。わかっててやったんならともかく知らなかったのはとても恥ずかしい。

強いて言うなら、向こうは全部自前実装だけどこっちはPlackに乗ってるっていうのが強みなくらいかなぁ。動かせる環境が増えても楽とかミドルウェアを重ねられるとか、ほら、いいことあるよ。あと俺TemplateToolkit嫌いなのでText::MicroTemplateでviewを書けるようにしたとか。…でもDancerは最小限の依存しかないのでインストールやデプロイは楽そうだけど、AsagaoはAny::MooseとかPath::Dispatcherとか色んなものに依存しててレンタルサーバとかに上げにくいかもしれない。

むしろお手本にさせてもらおう。後でソース読もう。

さらに追記

ブコメで「Dancer::Handler::PSGI があるから plack の上でもうごかせるよ!」って教えてもらいました。

あれー。

あれー。

あれー。

残念でござる。もう完全に意味ないでござる。まぁ勉強だと思ってとりあえず作ろうと思ってたところまでは全部作っちゃうか。

こないだ言ってたPlackアプリのサンプルでは、出来るだけ普段使ってない構成にしようと目論んでて、そのために例えばテンプレートエンジンにはText::MicroTemplateを使ってみたりしている。

Text::MicroTemplateはシンプルで軽くてなかなか良かった。ちなみにこんな感じで使う。

use Text::MicroTemplate qw(:all);

my $html = render_mt('Hello, <?= $_[0] ?>', 'faultier')->as_string;

でもファイルから読みたいよねーそれ実装しなきゃなのかなーとか思ってたらちゃんとText::MicroTemplate::Fileってのがあって、こっちを使えばキャッシュも使ってくれるしラッパーの機能とかもあるしで素敵だ。

?# hello.mt
Hello, <?= $_[0] ?>
use Text::MicroTemplate::File;

my $mtf = Text::MicroTemplate::File->new(use_cache => 1);
my $html = $mtf->render_file('hello.mt', 'faultier');

で、ここまでちょこちょこ弄ってみて思ったけど、やっぱりviewの中で@_とかを触るのはなんか嫌だ。そりゃ、引数にHashRef渡してやるとかテンプレートの頭で変数に入れてやるとかすればいいんだろうけど、そういう生々しい情報はviewで扱いたくない。つまり、やりたいのはこういうこと。

?# hello.mt
Hello, <?= $name ?>
use Text::MicroTemplate::File;

my $mtf = Text::MicroTemplate::File->new(use_cache => 1);
my $html = $mtf->render_file('hello.mt', { name => 'faultier' });

で、どの辺をいじればいいんだろうと読んでたら、Text::MicroTemplateのbuildメソッドの中身はこんな風になっていた。

    my $expr = << "...";
package $_mt->{package_name};
sub {
    ${_mt_setter}local \$SIG{__WARN__} = sub { print STDERR \$_mt->_error(shift, 4, \$_from) };
    Text::MicroTemplate::encoded_string((
        $_code
    )->(\@_));
}
...

ふむふむ。この$_mt_setterってなんだろうなと見てったら、デフォルトでは空、つまり何もしないんだけど、ここに適当なコードを突っ込むとテンプレートを処理する前にやることを追加できるようだ。

use Text::MicroTemplate qw(:all);

$Text::MicroTemplate::_mt_setter = 'my $name = shift;';
my $html = render_mt('Hello, <?= $name ?>', 'faultier')->as_string;

おお、出来た。んでも実はText::MicroTemplate::Fileの方ではこれはできない。build_fileの中でbuildを呼ぶ前に

local $Text::MicroTemplate::_mt_setter = 'my $_mt = shift:';

ってやっちゃってるし、テンプレートに渡す引数がわかるのはrender_fileの段階だし、大体これ多分外から挙動を制御する用じゃないよなぁ。というわけで当初は自前でモジュール組んでたんだけど、良く考えたら事前に引数を名前付きで渡せないこと以外は概ねText::MicroTemplate::Fileで良いわけで、作ってるうちにどんどん似てきてしまったのでじゃあText::MicroTemplate::Fileを拡張すればいいじゃんってことになった。それでこんなものを作ってみた。

faultier's p5-text-microtemplate-file-bindvars at master - GitHub

use Text::MicroTemplate::File::BindVars;

my $mtf = Text::MicroTemplate::File::BindVars->new(use_cache => 1);
my $html = $mtf->render_file('hello.mt', { name => 'faultier' });

動いたー。一応Text::MicroTemlate::Fileと同等の内容のテスト通るし、ベンチも取ってみたらキャッシュ無しのときでほんのちょびっと速いくらい、キャッシュ有りだとちょっと残念なことに15%ほどもパフォーマンス落ちちゃうけどそれでもTTの4、5倍くらい速いしまぁいっかーなんて思ったりしました。どうせここ全然ボトルネックじゃないし。

とそんな感じで一通り書き終えてこの記事をまとめてるところでこんなものがあるのに気付いた。

Text::MicroTemplate::Extended - search.cpan.org

…これでいいじゃん。マクロとかブロックとかあるし高機能じゃん。最初に良く調べなさいよって話ですねほんと。CPANで関係ありそうなモジュール探すとか基本中の基本じゃん。残念すぎる。

せっかくなので取ったベンチ結果。

Benchmark: timing 10000 iterations of T::MT::E, T::MT::F, T::MT::F::BV, TT...
  T::MT::E: 16 wallclock secs (16.01 usr +  0.61 sys = 16.62 CPU) @ 601.68/s (n=10000)
  T::MT::F: 17 wallclock secs (16.00 usr +  0.39 sys = 16.39 CPU) @ 610.13/s (n=10000)
T::MT::F::BV: 16 wallclock secs (15.85 usr +  0.39 sys = 16.24 CPU) @ 615.76/s (n=10000)
        TT: 46 wallclock secs (45.60 usr +  0.55 sys = 46.15 CPU) @ 216.68/s (n=10000)
              Rate           TT     T::MT::E     T::MT::F T::MT::F::BV
TT           217/s           --         -64%         -64%         -65%
T::MT::E     602/s         178%           --          -1%          -2%
T::MT::F     610/s         182%           1%           --          -1%
T::MT::F::BV 616/s         184%           2%           1%           --
Benchmark: timing 10000 iterations of T::MT::E, T::MT::F, T::MT::F::BV, TT...
  T::MT::E:  1 wallclock secs ( 1.04 usr +  0.06 sys =  1.10 CPU) @ 9090.91/s (n=10000)
  T::MT::F:  1 wallclock secs ( 0.75 usr +  0.05 sys =  0.80 CPU) @ 12500.00/s (n=10000)
T::MT::F::BV:  1 wallclock secs ( 1.10 usr +  0.06 sys =  1.16 CPU) @ 8620.69/s (n=10000)
        TT:  5 wallclock secs ( 4.92 usr +  0.00 sys =  4.92 CPU) @ 2032.52/s (n=10000)
                Rate           TT T::MT::F::BV     T::MT::E     T::MT::F
TT            2033/s           --         -76%         -78%         -84%
T::MT::F::BV  8621/s         324%           --          -5%         -31%
T::MT::E      9091/s         347%           5%           --         -27%
T::MT::F     12500/s         515%          45%          37%           --

できること少ないのに負けてるじゃん…。ちなみに、T::MT::EとT::MT::F::BVは全く同じテンプレートがレンダリングできたので同じの使ってる。キャッシュの仕方が悪いんだろうなー。でもT::MT::Eの方はオブジェクト生成時に引数指定しなきゃだから、複数ファイルをレンダリングさせたらちょっと変わったりするかしら。あとはまぁ高度なことをやらせればその分速度落ちるけど、そもそもT::MT:FとT::MT::F::BVには出来ないことなのでそこで差がついたとしてもT::MT::Eを選ぶなぁ。しかしそれにしてもTT遅いな。残念な子ですわね。

追記

やってみたけど大してかわんない。そもそも何万何十万て回数やるうちの数回オブジェクト生成が増えたところで差が付くわけもないだろっつー。あまりに意味ないのでもうちょい見直そう。

さらに追記

ちょっと試行錯誤してみたけど上手くいかなかった。思い付きで作ったものじゃ勝てないかー。ほとんど何もやってないんだけどな…。で、単純に1ファイルだけのテンプレートでキャッシュ有りだと当然のことながらText::MicroTemplate::Fileのがずっと速い(余計なことしてないから)。十万回やったら3秒くらい差がついた。T::MT::EとT::MT::F::BVの差はまぁ数%ってところ。十万回やって0.3秒違うだけだしTTとの40秒の差とくらべたらなんてことないかな。

ラッパー有りだと細かい処理の差よりそっちのが重いのでT::MT::FとT::MT::F::BVの差が3割弱から1割強まで縮まる。悪くはない。是非T::MT::Eのテンプレート継承機能との差を試したかったんだけどなんか上手く動かせなくて悩み中。TTは十万回やると1分くらい帰ってこなくなるのでもうなんかいいやって感じになってきた。いや、うちのサービスのほとんどがTT使ってるんだからキャッシュの仕組みとか工夫してさえいれば大した問題じゃない(だってDBとかのがずっと遅いんだもの)のはわかってるんだけど、こんだけ速度に差が付いてて、素のPerlで書けて、HTMLのエスケープもデフォルトでやってくれて、とか考えたらこっち使いたくなるねぇ。

タイトルからして既に残念な感じが漂ってるけど、前回の記事で言った通りPlackでアプリを作ってみようと試行錯誤中。ちなみにこないだサーバをApacheからnginxに変えたついでにHTTP::EngineのアプリもFastCGIで動かすようにしたので、PlackのアプリもFastCGIで動かしてみた。設定はこんな感じ。

# app.psgi
use NetaKit::TweetProxy::App;
use Plack::Builder;
builder {
    #mount '/baritter' => builder {
        NetaKit::TweetProxy::App->new->to_app;
    #};
};
#!/usr/bin/env perl
# bin/fcgi.pl
use strict;
use warnings;
use File::Spec;
use FindBin qw($Bin);
use Plack::Server::FCGI;
use lib File::Spec->catfile( $Bin, qw(.. lib) );
my $app = eval { require File::Spec->catfile( $Bin, qw(.. app.psgi) ) };
my $server = Plack::Server::FCGI->new(
    nproc       => 4,
    listen      => '/tmp/plack_netakit.sock',
    pidfile     => '/tmp/plack_netakit.pid',
    detach      => 1,
);
$server->run($app);
# nginx.conf
server {
    listen       80;
    server_name  localhost;
    location / {
        root   /var/www/faultier.jp/htdocs;
        index  index.html index.htm;
    }
    error_page   500 502 503 504  /50x.html;
    location = /50x.html {
        root   share/nginx/html;
    }
    location /baritter {
        set $script "";
        set $path_info $uri;
        fastcgi_pass unix:/tmp/plack_netakit.sock;
        include fastcgi_params;
    }
}

PlackのがH::EよりもRackと似たような感じに書けて楽だった。DLSとかURLMapとかもあるしね。あと、Rackで言うところのconfig.ruにあたるのがapp.psgiなんだけど、せっかくこれ書いたのにfcgi.plで同じのまた書くのやだなぁと思ってなんとなくrequireしてみたら普通に行けた。素敵。使い方これでいいのか疑問だけど。mount使おうとして上手くいかなくてコメントアウトした形跡があるのはまぁ御愛嬌。

baritter

いい加減彼女が404ばかりで飽きてきたので今回は真面目になんかしら遊べるものを作ってみることにした。

バリバリ 嘘じゃないもん

まぁアプリ名とかから推測つきそうなもんですが、ようはtwitterのポストを拾ってきてアレげなフォーマットにはめ込んで表示するだけの簡単なお仕事をするサービスです。サンプルなので単語を抽出するとかそういう凝ったことは決してやりません!(キリッ。上のスクショはそもそも元発言(もしくは発言者の脳味噌)が残念なのであんまり変わらないけど、津田さんとか池田信夫さんとかにこのフィルタをかますと脱力感が半端ないので3秒くらいは楽しめた。

ちなみに成果物はこんなだけど、内部ではPlackとText::MicroTemplateとData::ModelとCoroを使ってるとかいう、構成だけ見ると面白いサンプルになってるんだぜ。無駄遣いにも程があるぜ。出来たらソースも公開する予定。

そう言えばこないだのうどん屋のコードは一切テストを書かなかったけど、それはよろしく無い、まったくもって主義に反するし、RubyのときはちゃんとSpec書いたのにPerlのときは書かないだとかふざけてる、と思ったのでテストも書いてみることにした。

さてテストだけど、HTTP::Engineにはちゃんとテスト用のインターフェースが用意されている。あと、テストリクエストを生成するモジュールもある。なんだ、じゃあ話は簡単だ。

  1. interface => { module => 'Test' } でengineを作る
  2. HTTP::Engine::Test::Requestでrequestを作る
  3. engineのrunメソッドにテストリクエストを投げてやる
  4. 返ってきたレスポンスをチェックする

ってことですね、わかります。

まずは素直に書いてみる

コード量少ないのではっつけちゃおう。Udon::AppにGETリクエストを投げるテストはこんな感じ。

use strict;
use warnings;
use FindBin qw($Bin);
use Udon::App;
use Test::More;
use HTTP::Engine::Test::Request;

plan tests => 1;

my $app = Udon::App->new( { viewdir => "$Bin/../view" } );
my $engine = $app->setup_engine( { module => 'Test' } );
my $req = HTTP::Engine::Test::Request->new(
    uri => 'http://udon.example.org/',
    method => 'GET'
);
my $res = $engine->run($req);
is $res->code, 403, 'should return "Forbidden" when GET request';

ふむ、まぁ、簡単ですね!あとはこんな感じでどんどん$reqを作ってどんどん$engine->runしてやれば良い。

Test::Declare

ところで、Test::Moreはまぁ見慣れてるんで使い方に迷うことは無いんだけども、普段からRSpecが大好きで勢いあまってObjective-CのテストにまでRSpecを使っちゃう僕としては少々見栄えが気に入らない。のでTest::Declareってやつを使ってみることにした。

use strict;
use warnings;
use FindBin qw($Bin);
use Udon::App;
use Test::Declare;
use HTTP::Engine::Test::Request;

plan tests => blocks;

describe 'GET' => run {
    my $res; 
    init {
        my $app = Udon::App->new( { viewdir => "$Bin/../view" } );
        my $engine = $app->setup_engine( { module => 'Test' } );
    };
    test 'should return "Forbidden"' => run {
        $res = $engine->run(
            HTTP::Engine::Test::Request->new(
                uri => 'http://udon.example.org/',
                method => 'GET'
            ),
        );  
        is $res->code, 403;
    };  
};  

ようし、少し見栄えが良くなった。いや、べ、別に describe が入ってるから気に入ったんじゃないんだから。えーとほら、こうして何に対するテストなのかの説明と順番とテストコードとがひとまとめになってた方がわかりやすいじゃん。ね?

それは良いんだけど、setup_engineとかHTTP::Engine::Test::Request->newとかが今度は美しくない。このコードだと一個しか書いてないからまだあれだけど、「彼女が404」のSpecくらいに網羅しようと思うとちょっとげんなりする。そんなもん大体同じなんだから何度も書きたくないし、見にくい。

Test::HTTP::Engine

そう言えばRackのときはRack::Testを使ったら劇的にさっぱりした。じゃあ同じ方法で解決してみれば良いんじゃなかろうか。と思い立って適当にこんなものを拵えてみた。

package Test::HTTP::Engine;

use strict; 
use warnings;
use Exporter;
use HTTP::Engine::Test::Request;
our @ISA    = qw(Exporter);
our @EXPORT = qw(engine get);

sub engine { die }
    
sub get {
    my $path = shift;
    engine->run(
        HTTP::Engine::Test::Request->new(
            uri    => "http://example.org/$path",
            method => 'GET'
        ),  
        env => \%ENV
    );
}   

1;

で、これを使うとさっきのテストはこうなる。

use strict;
use warnings;
use FindBin qw($Bin);
use Udon::App;
use Test::Declare;
use Test::HTTP::Engine;

plan tests => blocks;

# engineの生成は各テストで上書きして変える
no warnings 'redefine';
*Test::HTTP::Engine::engine = sub {
    my $app = Udon::App->new( { viewdir => "$Bin/../view" } );
    $app->setup_engine( { module => 'Test' } );
};
    
describe 'GET' => run {
    test 'should return "Forbidden"' => run {
        is get('/')->code,    403;
        is get('/get')->code, 403;
    };  
    test 'should return "I\'m a teapot" with mode="prev"' => run {
        is get('/?mode=prev')->code, 418;
    };
    test 'should return "Gone" with mode="next"' => run {
        is get('/?mode=next')->code, 410;
    };
};

さっぱりした。しれっとテスト増やしたけどさっきより見易いし、そこはかとなくRSpec版に近付いた気がするぞ。あとはpostとかdeleteとかも作ってやればRack::Testでやったのと近いことができる。思い付きで作ったけど意外と良いな。

テストも簡単だから怠けてないで書けよと

というわけでApacheやServerSimpleでサーバプロセスを立ち上げたりしなくてもサクっとアプリのテストが出来ちゃって良いですね。こんな簡単なら最初からテスト書けよって言われそうですね。や、やりますよ。ちゃんと後でうどん屋のやつにもテスト追加しときますって。ひぃ。

追記

自分でもTest::HTTP::Engine::engineを毎回置き換えるのは無いよなー、なんか違うなーと思ってたら、yappoさんから

engine {}; で setup したほうがいかもー

とのこと。という訳で手直し中。

先週末からこっちうどん屋をいじって遊んでたのだけど、HTTP::EngineにはHTTP::Engine::Middlewareというミドルウェアを作る仕組みもあるので、せっかくなのでUdonMap(Rack::URLMapもどき)をミドルウェアで実装してみた。

gist: 117012 - GitHub

前回の記事のときと構成が変わってるけど気にしない方向で。あとで前の記事直しとこう前の記事も補足した。Udon::Middleware::URLMapがミドルウェアで、server-middleware.plがミドルウェア版UdonMapを使って書き直したもの。

ミドルウェア自体は簡単に作れた。use HTTP::Engine::MiddlewareするとMooseの初期化処理をしたりミドルウェア用のメソッドを生やしたりしてくれるので、HTTP::Engineをnewするときに指定したハンドラより前に実行する処理を作りたいときは、before_handleでHTTP::Engine::Requestを受けとってHTTP::Engine::Responseを返す処理を書いてやればいいだけ。 そのミドルウェアが処理すべきRequestじゃないときや、Requestを加工して次に渡したいときは、ResponseじゃなくてRequestを返してやると次のミドルウェアやハンドラに処理が渡る様子。簡単簡単。あとモジュールの最後に__MIDDLEWARE__を書くのを忘れずに。これで後処理もしてくれる。

ちょい補足。厳密に言うと、before_handleの返す値がHTTP::Engine::Responseだったときに限り、そこでbefore_handleのループが終了する。なので次のミドルウェアに処理を回したいときは、別にHTTP::Engine::Requestを返さなきゃいけないわけではない。ただ、前のミドルウェアが返した値がそのまま次のミドルウェアもしくはrequest_handlerにリクエストとして渡るので、普通はHTTP::Engine::Requestかそれと同じ振る舞いをするオブジェクトを返すものだと思う。そうしないとミドルウェアを重ねられないし。

で、その後request_handler、after_handleの処理へと続くんだけど、もしbefore_handleがあるのうちのどれかがHTTP::Engine::Responseを返してた場合はrequest_handlerは呼ばれない。でもafter_handleはエラーでも出てない限りは呼ばれるし途中で止まることもない。つまりafter_handleを持ってるミドルウェアは全部実行される。という挙動のはず。

ところで実はこれ自体はさくっと作れたんだけど、公開しようと思ってファイルの場所移してモジュールの名前変えたらいきなり動かなくなってちょっとだけハマった。最初に書いてたときはNetaKit::Middleware::URLMapって名前にしてたんだけど、UdonMap2って名前にすると何故か「before_handleだの__MIDDLEWARE__だの、そんなもんねーよ、アホか」とPerlさんに怒られる。なんじゃろ、と思いつつソース読んでるときにその理由に気付いた。HTTP::Engine::Middlewareをuseしてるやつのモジュール名の中にMiddlewareってのが含まれてないと、そのモジュールをミドルウェアとして初期化してくれない。

# HTTP/Engine/Middleware.pmから抜粋
sub import {
    my($class, ) = @_;
    my $caller = caller;

    return unless $caller =~ /(?:\:)?Middleware\:\:.+/;

    strict->import;
    warnings->import;

    init_class($caller);

    if (Any::Moose::moose_is_preferred()) {
        Moose->import({ into_level => 1 });
    } else {
        Mouse->export_to_level( 1 );
    }

    no strict 'refs';
    *{"$caller\::__MIDDLEWARE__"} = sub {
        use strict;
        my $caller = caller(0);
        __MIDDLEWARE__($caller);
    };

    *{"$caller\::before_handle"}     = sub (&) { goto \&before_handle     };
    *{"$caller\::after_handle"}      = sub (&) { goto \&after_handle      };
    *{"$caller\::middleware_method"} = sub     { goto \&middleware_method };
}

なんでかなーとちょっと考えたんだけど、ミドルウェア作るときも使うときもuse HTTP::Engine::Middlewareなんだけど、importの中でいろいろと前処理してるので、何もしなければ使う側のときでもMooseの初期化したりbefore_handleを生やしたりしてしまう。だから多分モジュール名に制約を付けておけばよしなにやってくれるようにしてるんだろう。とか思ってたらちゃんとそう言ってるじゃん。気付けよ俺…。

というわけでHTTP::EngineとHTTP::Engine::Middlewareの使い方がなんとなく分かってきたので、そろそろうどん屋と戯れるのは終わりにして、一通りWAFっぽい動きをするものでも作ってみようかな。

このブログではまず滅多にPerlの話を書かないのだけど、実は仕事ではPerlばっかり書いてたりする。にもかかわらず最近RubyRuby言いすぎなので、このままではマズい、社内のPerl Mongerな方々にトゥシューズに画鋲を入れられたり机に花を飾られたりしてしまう(※)、ということで今週末はHTTP::Engineをいじってみることにした。

※Perl Mongerはそんな陰湿ないじめはしませんし、Rubyistを公言してると社内で立場が危うくなるなんてことももちろんありませんし、そう言えばトゥシューズなんか履いたことないや。

比較の為に「彼女が404」を作ろうかと思ったんだけど、そのまんま同じのを作ってもあんまり芸がないので「うどん屋が403」にしてみた。彼女のと同じくGET、POST、PUT、DELETEに対応しててそれぞれ違うレスポンスを返すので、適当にリクエスト投げてみてくだしあ。

ファイルの構成はこんな感じ。

UdonApp.pm
うどん屋のステータスを返すアプリ。
UdonMap.pm
Rack::URLMapもどき。パスとアプリを関連付けてアプリのhandle_requestを呼ぶ。要Path::Dispatcher。
UdonHandler.pm
UdonMapを呼ぶためのmod_perl2用のハンドラ。PerlSetEnvでAPP_BASE_DIR(必須)とAPP_LOCATION(任意)を設定できる。APP_BASE_DIRはviewのディレクトリを決定するのに、APP_LOCATIONは例えば/perl/resource/udonみたいなパスでアクセスさせたいときに「PerlSetEnv /perl」みたいにして使う。
server.pl
実行するとスタンドアロンでサーバ立ち上げる。
server-switch.pl
server.plを「HTTP::Engine をつかった、ごくシンプルなプログラムの例(The simple example code for HTTP::Engine) - TokuLog 改めB日記」を参考に直したもの。要Perl5.10。なんで最初からそう書かなかったのかと言うと、Macの方のPerlが5.8なので…。given-whenの方が好みだなぁ。
server-urlmap.pl
server.plをUdonMapを使うように直したもの。これが一番すっきりするかなぁ。ていうかしないとUdonMapの意味無いけど。
udon.cgi
CGI。普通にApacheとかで動く。
*.msn
viewファイル。

ちょっと構成変えた。モジュールはUdon*.pmからlib/Udon/*.pmに、テンプレートは*.msnからview/*.msnに、スクリプトは*.plからbin/*.plに移動。

Ruby版の挙動になるべくあわせるようにしようとして、わざわざURLMapもどきを作ってしまった。Path::Dispatcherの無駄遣いな感が否めない。本当はPath::Dispatcherはもっと色々できる高機能なディスパッチャなので、WAFを作るときはUdonMapにあたるところがディスパッチャでUdonAppがアプリケーションじゃなくてコントローラ、的な構成にすると思うけど、まぁRackのプチアプリとの比較ってことでその辺は御愛嬌。

今思ったけど、これHTTP::Engine::Middlewareとかで実装すべきかしら。というかすでにこんなのあったりしそう。まだMiddlewareの方はちゃんと追えてないので後で。やってみた。次の記事参照。

ちなみにテンプレートにはText::MicroMason::SafeServerPagesを使った。普段使ってないテンプレートエンジンを試してみたかったってだけなので、特に意味はない。でも良いな、TTよりよっぽど素直に書けて好きだ。

参考にしたもの

どうにも腑に落ちない現象にでくわしたのでメモ。まず、以下のようなモジュールがあったとする。

# Foo.pm
package Foo;
use strict;

sub work {
    # なんたらかんたら
}

# Hoge.pm
package Hoge;
use strict;

sub work {
    die "ABSTRACT METHOD";
}

# Fuga.pm
package Fuga;
use strict;
use base qw(Hoge);
use Fop;

sub work {
    my $self = shift;
    my $foo = Foo->new();
    $foo->work();
    # なんたらかんたら
}

要点をまとめると、

  • Foo、Hoge、Fugaがある
  • FooもHogeもFugaもworkメソッドがある
  • Fugaはuse baseでHogeを継承していて、workメソッドをオーバーライドしてる
  • Hoge、FugaとFooの間には何の関係もないが、Fugaの中でFooを使ってる
  • use Fooのところをtypoしてる(ちなみにFop.pmなどというファイルはない)

という状況があるってのが前提。俺は何をしたかったかというと、$fuga->workってやるとFooを使った何らかの処理をして欲しかった。ところがuse Fopとかしちゃってる為、これはエラーが出て実行できないコードだった(ということに気付いたのは実は大分後の話なんだけど)。これだけなら大した問題じゃない。

ところが、実際にどんなことが起きたかというと、こうだった。

  • Foga.pmのuse Foo以降のコードが無視されるが、この時点ではエラーが出ない
  • Hoge::workが実行され、"ABSTRACT METHOD"というエラーメッセージを吐いて死ぬ

何でこんな挙動になるのか理解が出来なかった。useのところでエラーが出て死ぬんならまぁ、「まーたtypoってるよ、俺ってばドジっ子で低能でワーキングプアだなぁ、あはは」でいい話なんだけど、同じくHogeをuse baseしてる別モジュールは全く何の問題もなく動き、にもかかわらずFugaは自分のworkを無視して親であるHogeの方を読みに行くってのが意味不明で、そのせいでtypoだって気付くまでに時間がかかってしまった。

結局、typoを直したら期待した通りに動いたし、そもそも設計が微妙なので後で直そうとは思ってるんだけど、なんつーか、気持ち悪い。すごいもやもやした感触が残る。うーん?なんだこれ?TheSchwartz絡みなのかなぁ、この妙な挙動。あとで調べてみよう。

↑このページのトップヘ