はちゅにっき

こっちのブログはまったり更新

ソース読めるところまで読んでみる

MENTA のソースを読むことができる範囲で読んでみました。

読んだのはこのリビジョン

$ svn info
パス: .
URL: http://svn.coderepos.org/share/lang/perl/MENTA/trunk
リポジトリのルート: http://svn.coderepos.org/share
リポジトリ UUID: d0d07461-0603-4401-acd4-de1884942a52
リビジョン: 23848
ノード種別: ディレクトリ
準備中の処理: 特になし
最終変更者: drry
最終変更リビジョン: 23801
最終変更日時: 2008-11-15 21:50:13 +0900 (土, 15 11月 2008)

たぶん、たくさん間違ってます><

流れに沿って読む

とりあえずサンプルをビルドして

$ perl bin/menta-builder.pl

ページにアクセスした際には、生成された out/menta.cgi が実行されるので、このファイルから読むことにしよぅ。

BEGIN 節

読み始めるとBEGIN 節が。
MENTA では携帯にも対応しているので、その判断のための正規表現を生成しているみたい。

  • Line: 16 〜
BEGIN {
    $REQUIRED = {};

    {
        # copied from HTTP::MobileAgent
        my $DoCoMoRE = '^DoCoMo/\d\.\d[ /]';

        # ・・・ 中略

        $MOBILEAGENTRE = qr/(?:($DoCoMoRE)|($JPhoneRE|$VodafoneRE|$VodafoneMotRE|$SoftBankRE|$SoftBankCrawlerRE)|($EZwebRE)|($AirHRE))/;
    }
}

その後はひたすらサブルーチンが並んでいて。。。

MENTA の呼び出し

391行目にようやく、最初に実行されそうなコードが。
ハッシュリファレンスを与えて run_menta を呼び出しているみたいで。
与えているハッシュは、見たまんま&コメント通り、アプリケーション設定に使うみたい。
この形式なら、外部に YAML ファイルを作って、それをロードしても良さそう!
あ、でもなるべく標準以外のパッケージは使わないんだ。。。

  • Line: 391 〜
run_menta({
    # MENTA 自体の設定
    menta => {
        # ・・・ MENTA の設定がたくさん
    },
    # あなたのアプリの設定
    application => {
        # ・・・ アプリケーションの設定
    },
});

実は out/controller/counter.pl を読むと

  • out/controller/counter.pl - Line: 5
    my $fname = config->{application}->{counterfile} or die "データファイル名が設定されていません";

と、application を指定して値を取得しているので、必ずしも application に設定を書かなくても良さそうな雰囲気?

run_menta

これはいきなり挫折しそうだね!
最初にたくさん並んでいる local 宣言は全部クラス変数的なものっぽい。
あと、POST で受け付ける最大 byte 数もここで代入している。
DEFAULT_MAX_POST_DOBY については 39 行目でサブルーチンとして定義されていました。

  • Line: 45 〜
sub run_menta {
    my $config = shift @_;

    local $MENTA::CONFIG;
    # ・・・ 中略 クラス変数っぽい定義

    {
        # config に書いた値 or DEFAULT_MAX_POST_DOBY の値を代入
        $config->{menta}->{max_post_body} ||= MENTA::DEFAULT_MAX_POST_BODY;
        $MENTA::CONFIG = $config;
    }

$MENTA::CONFIG は 43 行目に accessor らしきものが定義されているので、config->{application}->{hogehoge} とするだけで値が取得できるみたい。
あ、あとこれで気付いたんだけど、41 行目にさりげなく

  • Line: 41
package main;

が書いてあって、これのおかげ(?)*1

$self->config->{application}->{hogehoge}

とかやらなくて済むようになっているみたい。

  • Line: 58 〜
    local $SIG{__DIE__} = sub {
        my $msg = shift;
        warn $msg unless ref $msg;
        return $msg if ref $msg && ref $msg eq 'HASH' && $msg->{finished};
        my $i = 0;
        my @trace;
        while ( my ($package, $filename, $line,) = caller($i) ) {
            last if $filename eq 'bin/cgi-server.pl';
            my $context = sub {
                my ( $file, $linenum ) = @_;
                my $code;
                if ( -f $file ) {
                    my $start = $linenum - 3;
                    my $end   = $linenum + 3;
                    $start = $start < 1 ? 1 : $start;
                    open my $fh, '<:utf8', $file or die "エラー画面表示用に ${file} を開こうとしたのに開けません: $!";
                    my $cur_line = 0;
                    while ( my $line = <$fh> ) {
                        chomp $line;
                        ++$cur_line;
                        last if $cur_line > $end;
                        next if $cur_line < $start;
                        my @tag =
                            $cur_line == $linenum
                            ? ( '<strong>', '</strong>' )
                            : ( '', '' );
                        $code .= sprintf( "%s%5d: %s%s\n",
                            $tag[0], $cur_line,
                            escape_html($line),
                            $tag[1], );
                    }
                    close $file;
                    chomp $code;
                }
                return $code;
            }->($filename, $line);
            push @trace, +{ level => $i, package => $package, filename => $filename, line => $line, context => $context };
            $i++;
        }
        die { message => $msg, trace => \@trace };
    };

$SIG{__DIE__} はエラーが発生したり die したときに呼ばれる(シグナル)で、MENTAではそれを hook しているみたい。*2
大まかな流れとしては、die を finalize に利用していて、処理が正常終了しようが、異常終了しようが、必ずこの部分を通過するようにできているみたい。
ただし、正常に処理が完了した場合は detach 関数を経由するから

  • Line: 250 〜
sub detach() {
    die {finished => 1};
}

よって、die しても 66 行目の

  • Line: 66
        return $msg if ref $msg && ref $msg eq 'HASH' && $msg->{finished};

で無事に return してくるみたい。
こんなやり方もあるんだなー。
これは参考になるかもしれない。

    eval {
        my $path = $ENV{PATH_INFO} || '/';
        $path =~ s!^/+!!g;
        if ($path =~ /^[a-z0-9_]*$/) {
            my $mode = $path || 'index';
            my $meth = "do_$mode";
            if (my $code = main->can($meth)) {
                $code->();
                die "なにも出力してません";
            } else {
                if (my $cdir = config->{menta}->{controller_dir}) {
                    my $controller = "${cdir}/${path}.pl";
                    if (-f $controller) {
                        package main;
                        do $controller;
                        if (my $e = $@) {
                            if (ref $e) {
                                die $e->{message};
                            } else {
                                die $e;
                            }
                        }
                        die $@ if $@;
                        if (my $code = main->can($meth)) {
                            $code->();
                            die "なにも出力してません";
                        } else {
                            die "「${mode}」というモードは存在しません!${controller} の中に ${meth} が定義されていないようです";
                        }
                    } else {
                        die "「${mode}」というモードは存在しません。別コントローラファイルもありません(${controller})";
                    }
                } else {
                    die "「${mode}」というモードは存在しません。別コントローラ用ディレクトリは設定されていません";
                }
            }
        } elsif ($path ne 'menta.cgi' && -f $path) {
            if (open my $fh, '<', $path) {
                printf "Content-Type: %s\r\n\r\n", guess_mime_type($path);
                print do { local $/; <$fh> };
                close $fh;
            } else {
                die "ファイルが開きません";
            }
        } elsif ($path =~ /^(?:crossdomain\.xml|favicon\.ico|robots\.txt)$/) {
            print "status: 404\r\ncontent-type: text/plain\r\n\r\n";
        } else {
            die "${path} を処理する方法がわかりません";
        }
    };
    if (my $err = $@) {
        die "エラー処理失敗: ${err}" unless ref $err eq 'HASH';
        return if $err->{finished};

        warn $err->{message};

        print "Status: 500\r\n";
        print "Content-type: text/html; charset=utf-8\r\n";
        print "\r\n";

        my $body = do {
            if ($config->{menta}->{kcatch_mode}) {
                my $msg = escape_html($err->{message});
                chomp $msg;
                my $out = qq{<!doctype html><head><title>500 Internal Server Error</title><style type="text/css">body { margin: 0; padding: 0; background: rgb(230, 230, 230); color: rgb(44, 44, 44); } h1 { margin: 0 0 .5em; padding: .25em .5em .1em 1.5em; border-bottom: thick solid rgb(0, 0, 15); background: rgb(63, 63, 63); color: rgb(239, 239, 239); font-size: x-large; } p { margin: .5em 1em; } li { font-size: small; } pre { background: rgb(255, 239, 239); color: rgb(47, 47, 47); font-size: medium; } pre code strong { color: rgb(0, 0, 0); background: rgb(255, 143, 143); } p.f { text-align: right; font-size: xx-small; } p.f span { font-size: medium; }</style></head><h1>500 Internal Server Error</h1><p>${msg}</p><ol>};
                for my $stack (@{$err->{trace}}) {
                    $out .= '<li>' . escape_html(join(', ', $stack->{package}, $stack->{filename}, $stack->{line}))
                         . qq(<pre><code>$stack->{context}</code></pre></li>);
                }
                $out .= qq{</ol><p class="f"><span>Powered by <strong>MENTA</strong></span>, Web application framework</p>};
                $out;
            } else {
                qq{<html><body><p style="color: red">500 Internal Server Error</p></body></html>\n};
            }
        };
        utf8::encode($body);
        print $body;
    }
}

いろんな if が並んでいるけれど、ささっと読む分には、action を実行してみようと試みて(can している)実行できそうなら実行して、できないならエラー処理にまわしているみたい。
die した時にキレイな画面の Internal Server Error を表示してくれるのも、ここのおかげ。


と、イロイロメモ書きしてきたけれど、更新速度がめちゃくちゃ速いので、いったん読むの中止!
でも、結構いろいろな要素が詰まってて面白い!
「can は CODE のリファレンスを返す」とか、最初は理解不能だったりするけれど、こーゆーソースとかを直接読んでしまうと、改めて理解しやすいしね。
ベストプラクティスと言われている Plagger のソースを、本気で読み込むのは結構大変で、いっつも途中から縦読み状態だけれども、こうやって何か一つを読み込んでみると(と言っても、まだほんのさわりの部分だけれども。。。)結構勉強になるね!


さてさて、あとは Shibuya.pm での発表を楽しみにしよーっと。
ってゆーのと、ざっと流れが分かったので、実際にアプリケーション書いてみようよ!
って、今週来週とまとまった時間がとれないのが残念。。。
あ、その前に SQLite について簡単なまとめを今度は書きたいな。

*1:これは必然なのかもしれないけど。。。

*2:実は理解不足かもしれない