[Perl]PSGI入門第三章 動的ルーティングを実装する

# 本日のお題：動的ルーティングを実装する

## おさらい

1. [PSGI入門第一章 環境変数の一覧を出す](http://qiita.com/worthmine/items/96f36332e620aef34001)
2. [PSGI入門第二章 CGI::SessionをPSGIで無理やり使う](http://qiita.com/worthmine/items/987ac1e422348b9f0ea5)

## 背景
予告に書いてなかったんですけど、ここなかなかのハードルの高さだったの思い出したので共有します。

1. [Plack](http://plackperl.org/)をインストールしただけではRouterはインストールされない
2. 選択肢がたくさんありすぎて、何が違うのか読まないとわからない。ヒットする順に
    1. [Plack::App::Path::Router](http://search.cpan.org/~doy/Plack-App-Path-Router-0.08/lib/Plack/App/Path/Router.pm)
    - [Plack::App::Path::Router::PSGI](http://search.cpan.org/~doy/Plack-App-Path-Router/lib/Plack/App/Path/Router/PSGI.pm)
    - [Router::Boom](http://search.cpan.org/~tokuhirom/Router-Boom-1.03/lib/Router/Boom.pm)
    - [Rooter::Simple](http://search.cpan.org/~tokuhirom/Router-Simple-0.17/lib/Router/Simple.pm)
    - and so on 
2. え？これ全部読むの？手っ取り早く使いたいんですけど？
3. で、[第一章](http://qiita.com/worthmine/items/96f36332e620aef34001)のように環境変数の取得から始めてみたら
4. Plack::App::Path::Router::PSGIが一番私の肌に合う[^1]

[^1]: 環境変数にやたらとアクセスする場合、常に第一引数に環境変数がセットされてる方が使いやすい。

ということがわかりましたので採用しました。「いや、その選択間違ってるよ」とのことでしたらご指摘願いたいところです。

## やってみた。
実はすでに動的なルーティングは実装済み[^2]なんですよね。ただ、一個一個個別にルーティングを定義していただけで。
[^2]: 画像やjavascriptなどのサーバー側にすでにstaticに存在するファイルに対して実装するのが、本来の意味での静的ルーティングのはずで、それを行いたいなら[Plack::Middleware::Static](http://search.cpan.org/dist/Plack/lib/Plack/Middleware/Static.pm)を導入すべし。

今回追加したのは、ユーザー名や日付などの可変な文字列をルーティングする場合の記述です。

```perl:Myapp.pl
use strict;
use warnings;
use Carp;

use Plack::App::Path::Router::PSGI;
use Path::Router;
use Plack::Request;

use CGI::Session;
my $session = CGI::Session->new( undef, undef, { Directory => './sessions' } ); # ダミーのセッション
my $sid = $session->param('CGISESSID') || undef;
$session->delete(); # ダミーはすぐ消す
$session = CGI::Session->new( undef, $sid, { Directory => './sessions' } ); # 本セッション
if ( $session->is_expired() ) { # 期限切れを消して再発行
    $session->delete();
    $session = CGI::Session->new( undef, $sid, { Directory => './sessions' } );
}else{
    $session->expire('+1d');
}

my $router = Path::Router->new;
$router->add_route( '/'         => target => \&root );
$router->add_route( '/env'      => target => \&env );
$router->add_route( '/session'  => target => \&session );
# ++ 今回の注目ポイント
$router->add_route( '/:action/:id' =>
    validations => {
        action  => qr/^\w[\w\-]{1,10}$/,
        id      => qr/^\d{1,10}$/,
    },
    target => \&action
);
# ++

# now create the Plack app
my $app = Plack::App::Path::Router::PSGI->new( router => $router );
$app->to_app();

# 以下routerで呼ばれる要素
sub root {
    my $env = shift;
    my $title = 'Welcome to ' . $env->{'HTTP_HOST'};
    return response( $env, <<"END");
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>$title</title>
</head>
<body>
<h1>$title</h1>
<ul>
    <li><a href="/env">環境変数一覧へ</a></li>
    <li><a href="/session">セッションのテストへ</a></li>
    <li><a href="/action/1234567890">動的ルーティングのテストへ</a></li>
</ul>
</form>
</body>
</html>
END
}

sub action {
    my $env = shift;
    my ( $action, $id ) = @{ $env->{'plack.router.match.args'} };
    my $req = Plack::Request->new($env);
    my $method = $req->method;
    if( $method =~ /^(:?GET|HEAD)$/s ) {
        return response( $env, <<"END" );
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>動的ルーティング</title>
</head>
<body>
<h1>動的ルーティングしてみる</h1>
<form method="POST" action="/$action/$id" enctype="multipart/form-data"><p>
    指定されたmethod:$method<br>
    指定されたaction:<input type="text" name="action" value="$action">任意の英数字<br>
    指定されたID:<input type="text" name="id" value="$id">10桁までの整数<br>
    <button type="submit">変更する</button>
</p></form>

<hr>

<p><a href="/">トップに戻る</a></p>
</body>
</html>
END
    }elsif( $method eq 'POST' ){
        $action = $req->body_parameters->{'action'};
        $id = $req->body_parameters->{'id'};
        return response( $env, <<"END" );
<!DOCTYPE html>
<html lang="ja">
<head>
        <meta charset="utf-8">
        <title>動的ルーティング</title>
</head>
<body>
<h1>動的ルーティングしてみる</h1>
<p><a href="/$action/$id">アクセスしてみる</a></p>
<form method="POST" action="/$action/$id" enctype="multipart/form-data"><p>
    指定されたmethod:$method<br>
    指定されたaction:<input type="text" name="action" value="$action">任意の英数字<br>
    指定されたID:<input type="text" name="id" value="$id">10桁までの整数<br>
    <button type="submit">変更する</button>
</p></form>

<hr>

<p><a href="/">トップに戻る</a></p>
</body>
</html>
END
    }
    return response( $env, <<"END", -status => 405 );
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>HTTPメソッドエラー</title>
</head>
<body>
<h1>HTTPメソッドエラー</h1>
<p>指定されたメソッドが不正です。method:$method</p>
<p><a href="/">トップに戻る</a></p>
</body>
</html>
END

}

sub session {
    my $env = shift;
    my $req = Plack::Request->new($env);
    my %param = %{ $req->body_parameters };
    if( exists $param{'action'} and $param{'action'} eq 'forget' ) {
        $session->param( 'str', '' );
    }elsif( exists $param{'str'} ){
        $session->param( 'str', $param{'str'} );
    }

    my $str = $session->param('str') || '';
    return response( $env, <<"END");
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>セッション管理</title>
</head>
<body>
    <h1>セッション管理してみる</h1>
    <form method="POST" action="/session" enctype="multipart/form-data"><p>
        <input type="text" name="str" value="$str">
        <button type="submit" name="action" value="remember">記憶</button>
        <button type="submit" name="action" value="forget">消去</button>
    </p></form>
    <p><a href="/">トップに戻る</a></p>
</body>
</html>
END
}

sub env {
    my $env = shift;
    my @str;
    while ( my ( $key, $value ) = each %$env ) {
        push @str, "$key = $value" unless ref $value;
    }
    my $list = join( "<br>\n", sort(@str) );
    return response( $env, <<"END" );
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>環境変数一覧</title>
</head>
<body>
    <h1>環境変数一覧</h1>
    <hr>
    <p>$list</p>
    <hr>
    <p><a href="/">トップに戻る</a></p>
</body>
</html>
END
}

# サブルーチン
sub response {
    my $env = shift;
    my $body = shift || croak 'empty body!';
    my %ARG = @_ if @_;
    my $status = $ARG{'-status'} || 200;
    croak "unvalid status: $status" if $status !~ /^\d{3}$/s;
    my $mime = $ARG{'-MIME'} || 'text/html; charset=utf-8';
    my $headers = $ARG{'-headers'} || {};
    my $req = Plack::Request->new($env);
    my $res = $req->new_response($status);
    $res->content_type($mime);
    $res->header(
        'Set-Cookie' => $session->cookie,
        %$headers
    );
    $res->body($body);
    $res->finalize;
}
END
}

sub env {
    my $env = shift;
    my @str;
    while ( my ( $key, $value ) = each %$env ) {
        push @str, "$key = $value" unless ref $value;
    }
    my $list = join( "<br>\n", sort(@str) );
    return response( $env, <<"END" );
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="utf-8">
    <title>環境変数一覧</title>
</head>
<body>
    <h1>環境変数一覧</h1>
    <hr>
    <p>$list</p>
    <hr>
    <p><a href="/">トップに戻る</a></p>
</body>
</html>
END
}

# サブルーチン
sub response {
    my $env = shift;
    my $body = shift || croak 'empty body!';
    my %ARG = @_ if @_;
    my $status = $ARG{'-status'} || 200;
    croak "unvalid status: $status" if $status !~ /^\d{3}$/s;
    my $mime = $ARG{'-MIME'} || 'text/html; charset=utf-8';
    my $headers = $ARG{'-headers'} || {};
    my $req = Plack::Request->new($env);
    my $res = $req->new_response($status);
    $res->content_type($mime);
    $res->header(
        'Set-Cookie' => $session->cookie,
        %$headers
    );
    $res->body($body);
    $res->finalize;
}
```

はい、あちこちにHTMLのヒアドキュメントが散在しててうざいですね。次回は[Text::Xslate](http://search.cpan.org/~syohex/Text-Xslate-3.4.0/lib/Text/Xslate.pm)の導入をテーマにする予定です。使わないとこうなるよ！っていう悪い例を今回はわざと表現しました。

## ポイント
- 指定の文法自体は、どのRouterを使っても大体一緒のようです。`/:str`という感じで捕捉したいpathを記載して、望めばvalidateもできます。これに漏れると自動的に404 Not Foundを返します。今回の例だと、idが数字だけに限定してますので英文字などが入ると404 Not Foundです。
- ちなみに、昨今のAPIでありがちな`*/something.xml`と`*/something.json`とを拡張子レベルで識別して、動的に返すデータを変える、みたいなことはできないようです。その辺できるrouterモジュール誰か知りませんかね？
- ルーティングを指定する際にGET/POSTなどのメソッドを明示する方式のモジュールもあります[^3]が、例示したように後からも拾えますので、これで良いんじゃないかと思う次第。
[^3]: [Router::Boom::Method](http://search.cpan.org/~tokuhirom/Router-Boom-1.03/lib/Router/Boom/Method.pm)など
- GET/POST以外のメソッドへの対応がよくわからないので、しれっと`405　Method Not Allowed`を投げるようにしてます。この辺はCGIではできないことだった[^4]のでよくわかりません。
- (2017/02/15:追記の追記)本コードにバグがあり、405ステータスがうまく飛んでませんでした。HEADメソッドが`200 OK`及び適正な値を返すように修正をいたしました。

[^4]: Apacheなどのサーバーソフトがやる仕事だった

この辺まで理解できればかつてのCGI使いならばWebゲームや掲示板くらいはなんとか作れますね。
**ね、簡単でしょう？**あなたも始めよう！PSGI！

## 次章
[PSGI入門第四章 Text::XslateでViewを分離](http://qiita.com/worthmine/items/f007541c992bad60a7a8)
# 宣伝
本記事は自前で有料WebサービスをPerlで書いてリリースするに辺り、つまづいた点や気づいたことを共有する目的で書き始めました。

![worthmine-qiita.png](https://qiita-image-store.s3.amazonaws.com/0/10766/370df067-1108-c7b8-2ea3-59ab11155660.png)こちらのQRコードをスマホで読み取り、
興味を持った方は<https://qrown.me>までぜひお立ち寄りください！