CGI::Application::Dispatch のディスパッチ

CGI::Application を使ったときのディスパッチをしてくれるクラスとして，CGI::Application::Dispatch がある．
CGI::Application::Dispatch - Dispatch requests to CGI::Application based objects - metacpan.org

CGI::Application::Dispatch を使ったときの Dispatch Table の定義は CGI::Application::Dispatch::dispatch_args に書くのが正しい (CGI::Application::Dispatch::dispatch の引数としても書けそうだけど，mod_perl を使うときは CGI::Application::Dispatch::handle 経由で dispatch が呼び出され，プログラマ側ではいじりにくいので，結局 dispatch_args に書かざるを得なさそう)

というわけで，SYNOPSIS に書かれている

    sub dispatch_args {
        return {
            prefix  => 'MyApp',
            table   => [
                ''                => { app => 'Welcome', rm => 'start' },
                ':app/:rm'        => { },
                'admin/:app/:rm'  => { prefix   => 'MyApp::Admin' },
            ],
        };
    }

の Dispatch Table の定義を読み解くことにしました．

読み解く

table キーに対応する値として渡されている array ref が Dispatch Table になります．
通常は hash ref として与えるのがキレイですが，ここではマッピングを行う際のマッチングに優先順位を付けるために敢えて array ref が使われています(hash ref だと順番が変わってしまう)．結果，上に書いてあるほど優先順位が高くなり，最初にキーにマッチしたものが dispatch されます．

マッピング前のパスの解析を行っているのが _parse_path メソッドです．引数として渡されるのは，スラッシュで囲まれた PATH_INFO ($path)と Dispatch table (array ref: $table) になります．

sub _parse_path {
    my ($self, $path, $table) = @_;

結構省略しますが，こんな感じの for 文で table の内容が最初からマッチングに使われていくので，table の順序というのは非常に重要です．
table のキーに当たる部分がマッチングの rule になります．

    # look at each rule and stop when we get a match
    for(my $i = 0 ; $i < scalar(@$table) ; $i += 2) {

        my $rule = $table->[$i];

rule として ':' が前置されるものは後段でパラメータとして扱うことが可能になります．

Any token which begins with a colon (:) is a variable token. These are simply wild-card
place holders in the rule that will match anything in the URL that isn't a slash. These
variables can later be referred to by using the $self->param mechanism. In the rule
'posts/:category'
:category is a variable token. If the URL matched this rule, then you could retrieve
the value of that token from whithin your application like so:
my $category = $self->param('category');

これを実現するためにキャプチャ用の正規表現を作ります．コメントが親切なので分かりやすい．

        # translate the rule into a regular expression, but remember where the named args are
        # '/:foo' will become '/([^\/]*)'
        # and
        # '/:bar?' will become '/?([^\/]*)?'
        # and then remember which position it matches

        $rule =~ s{
            (^|/)                 # beginning or a /
            (:([^/\?]+)(\?)?)     # stuff in between
        }{
            push(@names, $3);
            $1 . ($4 ? '?([^/]*)?' : '([^/]*)')
        }gxe;

$rule が '/admin/:app/:rm/' だったとすると，上記処理によって '/admin/([^/]*)/([^/]*)/' に展開されます．また，@names は ('app', 'rm') になっているはずですね．
そして実際にマッチングが行われます．

        if(my @values = ($path =~ m#^$rule$#)) {

            warn "[Dispatch] Matched!\n" if $DEBUG;

            my %named_args = %{$table->[++$i]};
            @named_args{@names} = @values if @names;

            return \%named_args;
        }

例えば $path が '/admin/search/edit' だったとすると，%named_args は

(prefix => 'MyApp::Admin', app => 'search', rm => 'edit')

てなってるはずですね．

あとはこれが dispatch メソッドに渡された後，情報が取り出され，

        ($module, $local_prefix, $rm, $local_args_to_new) =
          delete @{$named_args}{qw(app prefix rm args_to_new)};

モジュール名が構築され

        $module = $self->translate_module_name($module);

        $local_prefix ||= $args{prefix};
        $module = $local_prefix . '::' . $module if($local_prefix);

モジュールがロードされた後，実行されるという流れ．

        # load and run the module
        @final_dispatch_args = ($module, $rm, $local_args_to_new);
        $self->require_module($module);
        $output = $self->_run_app($module, $rm, $local_args_to_new);

というわけで，例えば以下の指定だけで，

 'admin/:app/:rm'  => { prefix   => 'MyApp::Admin' },

PATH_INFO が /admin/search/edit となったリクエストに対して MyApp::Admin::Search::edit が呼び出されることになる．

理系学生日記

おまえはいつまで学生気分なのか

CGI::Application::Dispatch のディスパッチ

読み解く