Amon2のDispatcher をカスタマイズしてCatalystライクなコントローラーを実装する

最近のWAFは、

get '/' => 'Foo#bar';

みたいなのをつらつらと書いていくのが主流みたいなんですが、コントローラに書いてある方が直観的だと思うのはCatalyst病に感染してるからでしょうか。
PerlのAttributeが微妙ってのもあって、CatalystライクなDispatchはあんまよろしくないのかもしれません。
個人的にはCatalystで慣れたってのもあるんで、Amon2でもCatalystライクなDispatchで書きたいなーと思う次第です。

Dispatcher

まずはDispatcherをすっきりさせます。

package MyApp::Web::Dispatcher;
use strict;
use warnings;
use utf8;

use Amon2::Web::Dispatcher::RouterBoom;
base 'MyApp::Web::C';

use Module::Find;
useall 'MyApp::Web::C';

1;

すっきりしましたw

コントローラの親クラス

コントローラの親になるMyApp::Web::Attributeってのを作りました。
今回のキモな部分です。
Sub::Attributeは事前にインストール済みです。

package MyApp::Web::Attribute;

use strict;
use warnings;
use utf8;

use Sub::Attribute;

# GET
sub _get : ATTR_SUB {
    my($class, $sym_ref, $code_ref, $attr_name, $attr_data) = @_;

    my $method = *$sym_ref{NAME}; // コントローラのメソッド名(index)
    my $call = (caller 4)[0]; // 呼び元(MyApp::Web::Dispatcher)を取得。

    # $attr_data = '/'; $class = 'MyApp::Web::C::Root'; $method = 'index'
    $call->router->add(['GET','HEAD'], $attr_data, { class => $class, method => $method } );
}

# POST
sub _post : ATTR_SUB {
    my($class, $sym_ref, $code_ref, $attr_name, $attr_data) = @_;

    my $method = *$sym_ref{NAME};
    my $call = (caller 4)[0];
    $call->router->add('POST', $attr_data, { class => $class, method => $method } );
}

# ANY
sub _any : ATTR_SUB {
    my($class, $sym_ref, $code_ref, $attr_name, $attr_data) = @_;

    my $method = *$sym_ref{NAME};
    my $call = (caller 4)[0];
    $call->router->add(undef, $attr_data, { class => $class, method => $method } );
}

# DELETE
sub _delete : ATTR_SUB {
    my($class, $sym_ref, $code_ref, $attr_name, $attr_data) = @_;

    my $method = *$sym_ref{NAME};
    my $call = (caller 4)[0];
    $call->router->add('DELETE', $attr_data, { class => $class, method => $method } );
}

1;

やってる事は、Amon2::Web::Dispatcher::RouterBoomのimportで、methodを追加してる部分をそれぞれに分けた感じです。

Sub::Attributeを使うと

sub hogehoge : ATTR_SUB {}

で、作られたメソッドがAttributeとして呼ぶことができるようになります。
-> sub foo : hogehoge {}

今回は、_get,_post,_any,_deleteの4つをAttributeとして追加しました。

下記のようなCODEを直接呼ぶやつは考慮してません。

get '/' => sub {
    my ($c) = @_;
};

MyApp::Web::Dispatcher自体は、今までどおりに使えるので、書けば動くと思いますが、、

コントローラ

package MyApp::Web::C::Root;

use strict;
use warnings;
use utf8;

# 上で作ったクラスを継承
use parent 'MyApp::Web::Attribute';

sub index : _get(/) {
    my ( $class, $c ) = @_;
    # ...
}

sub user : _get(/user/{id}) {
    my ( $class, $c, $args ) = @_;
    # ...
}

1;

やりたかった事は中途半端に達成できた。。
コントローラでMyApp::Web::Attributeを継承する必要があるのと、毎回pathを指定しないといけないってのがアレかなー・・。
結局、MyApp::Web::Dispatcherの内容をコントローラに移しただけっていう(ry

追記

Dispatchをコントローラに移した結果、pathの一覧が欲しくなった、、、
(元も子もない?w)
一番上ですっきりさせたMyApp::Web::Dispatcherを下記に。

package MyApp::Web::Dispatcher;
use strict;
use warnings;
use utf8;

use Amon2::Web::Dispatcher::RouterBoom;
base 'MyApp::Web::C';

use Module::Find;
useall 'MyApp::Web::C';

# 追加 --
use Data::Dumper;
$c->log->debug( Dumper __PACKAGE__->router->routes );
# --

1;

こんな感じで、今addされてるpathの一覧が取れます。
開発時にしか使わないけど。。