[Perl] PSGI入門第五章 Log::Dispatch::Configでデバッグログを取る

[LINE Bot AWARDS](https://botawards.line.me/ja/)に[エントリーしてた](https://t.co/zTFZ3J1BuP)ので更新が遅くなりました。しかし、このシリーズ、需要あんのかな…

# 本日のお題 [Log::Dispatch::Config](http://search.cpan.org/~miyagawa/Log-Dispatch-Config-1.04/lib/Log/Dispatch/Config.pm)でデバッグログを取る

## おさらい
1. [PSGI入門第一章 環境変数の一覧を出す](http://qiita.com/worthmine/items/96f36332e620aef34001)
2. [PSGI入門第二章 CGI::SessionをPSGIで無理やり使う](http://qiita.com/worthmine/items/987ac1e422348b9f0ea5)
3. [PSGI入門第三章 動的ルーティングを実装する](http://qiita.com/worthmine/items/9662ac8f30a30b167123)
4. [PSGI入門第四章 Text::XslateでViewを分離](http://qiita.com/worthmine/items/f007541c992bad60a7a8)

## 前提
- 本記事では[Log::Dispatch](https://github.com/houseabsolute/Log-Dispatch)のカスタマイズ方法は省略[^1]します。
- 今まで[CGI::Carp](http://search.cpan.org/~leejo/CGI-4.35/lib/CGI/Carp.pm)などにお世話になっていた人が主な対象です。

[^1]: [この辺に書いた](http://qiita.com/worthmine/items/e27570c36e65a3d49513)から
## CGI::Carpの良かったところ(信者目線)
- [carpout](http://search.cpan.org/~leejo/CGI-4.35/lib/CGI/Carp.pm#REDIRECTING_ERROR_MESSAGES)でログファイルに出力できた点
- [fatalsToBrowser](http://search.cpan.org/~leejo/CGI-4.35/lib/CGI/Carp.pm#MAKING_PERL_ERRORS_APPEAR_IN_THE_BROWSER_WINDOW)でログを見に行く手間を省けたところ
- 単純に`die`や`warn`を使うよりデバッグがしやすい点[^2]

[^2]: =[Carp](http://search.cpan.org/~rjbs/Carp-1.38/lib/Carp.pm)の利点

## PSGIではデフォルトの挙動で
- `croak`や`die`するとデバッグ画面をブラウザに表示→fatalsToBrowser相当以上
- `carp`と`warn`は事実上の無視[^3]→なんとかインチキできんのか？
- `$ plackup Myapp.pl -r`すると以後の挙動をターミナルに自動表示→じゃあ、そこにエラーやデバッグ吐いた方が楽

結論、Log::Dispatch使いましょう！[^4]

[^3]: 私の認識。どこにどう出るのか教えて欲しい。
[^4]: 正確には、その用途だけならば[Log::Dispatch::Screen](https://github.com/houseabsolute/Log-Dispatch/blob/master/lib/Log/Dispatch/Screen.pm)だけで足りるけど、便利なので[Log::Dispatch::File](https://github.com/houseabsolute/Log-Dispatch/blob/master/lib/Log/Dispatch/File.pm)も一括設定しちゃう。

## ま、やってみましょう。
```text:log.conf
dispatchers = file screen

file.class = Log::Dispatch::File
file.min_level = notice
file.filename = ./log/error_log         
file.mode = append
file.format = [%d] [%p] %m at %F line %L %n
file.binmode = :utf8

screen.class = Log::Dispatch::Screen
screen.min_level = debug
screen.stderr = 1
screen.format = [%p] %m %n
screen.utf8 = 1
```
このファイルをMyapp.plと同一ディレクトリに入れて`$ mkdir log`してください。[細かい解説は別記事](http://qiita.com/worthmine/items/e27570c36e65a3d49513)です。

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

use Plack::App::Path::Router::PSGI;
use Path::Router;
use Plack::Request;
use utf8;                 # 副作用をきちんと理解していない場合は入れない方が良い
use Encode;

use Log::Dispatch::Config;
Log::Dispatch::Config->configure('./log.conf');
my $dispatcher = Log::Dispatch::Config->instance();
$dispatcher->info("再起動");   # 本来はdecode_utf8()が必要だがlog.confの設定で回避できる

use Text::Xslate;
use Text::Xslate::Bridge::MultiMarkdown;
# ↑宣言しなくても下記の記述で読み込んでくれるが、plackupの時点でインストールを検知したいので明示する
my $tx = Text::Xslate->new(
    module => ['Text::Xslate::Bridge::MultiMarkdown'],
    syntax => 'Kolon',
    cache => 0,
    verbose => 1,
);

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() ) { # 期限切れを消して再発行
    $dispatcher->debug("regenerate expired session: $sid");
    $session->delete();
    $session = CGI::Session->new( undef, $sid, { Directory => './sessions' } );
}
$session->expire('+1d');

my $router = Path::Router->new;
$router->add_route( '/'         => target => \&root );
$router->add_route( '/empty'    => target => \&empty );
$router->add_route( '/markdown' => target => \&markdown );
$router->add_route( '/env'      => target => \&env );
$router->add_route( '/session'  => target => \&session );
$router->add_route( '/:action/:id' =>
    validations => {
        action  => qr/^\w[\w\-]{0,9}$/,
        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'};
    my $render = $tx->render( 'Templates/root.tx', {
        title => $title,
        description => 'ここはルートです。',
    } );
    $dispatcher->debug( $env->{PATH_INFO} . "が呼ばれました。" );
    # ソース中のマルチバイト文字列のdecodeは不要
    return response( $env, $render );
}

sub markdown {
    my $env = shift;
    my $req = Plack::Request->new($env);
    my $markdown = $req->body_parameters->{'markdown'};

    my $render = $tx->render( 'Templates/markdown.tx', {
        title => 'マークダウンのテスト',
        description => 'マークダウンのテストです。',
        markdown => decode_utf8($markdown), # 外部から来たマルチバイト文字列にはdecode_utf8()が必要
    } );
    $dispatcher->debug( $env->{PATH_INFO} . "が呼ばれました。" );
    return response( $env, $render );
}

sub action {
    my $env = shift;
    my ( $action, $id ) = @{ $env->{'plack.router.match.args'} };
    my $req = Plack::Request->new($env);
    my $method = $req->method;
    $dispatcher->debug( "$env->{PATH_INFO}が呼ばれました。" );
    # デリファレンスなどは""中に直接いてれも大丈夫。
    if( $method =~ /^(:?GET|HEAD)$/s ) {
        my $render = $tx->render( 'Templates/action.tx', {
            title   => '動的ルーティングしてみる',
            action  => $action,
            id      => $id,
            method  => $method,
        } );
        return response( $env, $render );
    }elsif( $method eq 'POST' ){
        $action = $req->body_parameters->{'action'};
        $id = $req->body_parameters->{'id'};
        my $render = $tx->render( 'Templates/action.tx', {
            title   => '動的ルーティングしてみる',
            action  => $action,
            id      => $id,
            method  => $method,
        } );
        return response( $env, $render );
    }
    my $render = $tx->render( 'Templates/405.tx', {
        title   => 'HTTPメソッドエラー',
        method  => $method,
    } );
    # use utf8すると変数名にもマルチバイト文字列の混入を許すようになるので
    $dispatcher->error("${\$method}には対応していません。");
    # のように、${\$scalar}のように変数名を表記しないとエラーになる
    return response( $env, $render, -status => 405 );
}

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', '' );
        $dispatcher->info("セッションに保存している文字列の消去");
    }elsif( exists $param{'str'} ){
        $session->param( 'str', $param{'str'} );
        $dispatcher->info( "セッションに保存している文字列の上書き:" . decode_utf8($param{'str'}) );
    }

    my $render = $tx->render( 'Templates/session.tx', {
        title   => 'セッション管理してみる',
        str     => $session->param('str') || '',
    } );
    $dispatcher->debug( "$env->{PATH_INFO}が呼ばれました。" );
    return response( $env, $render );
}

sub env {
    my $env = shift;
    my @str;
    while ( my ( $key, $value ) = each %$env ) {
        push @str, "$key = $value" unless ref $value;
    }
    my $render = $tx->render( 'Templates/env.tx', {
        title   => '環境変数一覧',
        list    => [sort @str],
    } );
    $dispatcher->debug( "$env->{PATH_INFO}が呼ばれました。" );
    return response( $env, $render );
}

sub empty {
    my $env = shift;
    my $render = ''; # わざと空のボディを投げる
    $dispatcher->debug( "$env->{PATH_INFO}が呼ばれました。" );
    return response( $env, $render );
}

# サブルーチン
sub response {
    my $env = shift;
    my $body = encode_utf8(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_length( length $body );
    $res->content_type($mime);
    $res->header(
        'Set-Cookie'    => $session->cookie,
        %$headers
    );
    $res->body($body) unless $req->method eq 'HEAD';
    $res->finalize;
}
```
`use utf8`の副作用に関する理解が進んだので、思い切って全体に`use utf8`しました。注意点は本文にある通り、スカラ名の挿入や外部／内部文字列の区別です。

---
以下は必要なテンプレートですが、[前回](http://qiita.com/worthmine/items/f007541c992bad60a7a8)と変更のないものは省いてます。

```html:Templates/base.tx
<!DOCTYPE html>
<html lang="ja-jp">
<head>
    <meta charset="utf-8">
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <meta http-equiv="X-UA-Compatible" content="IE=edge">
: if $description {
    <meta name="description" content="<: $description :>">
: }
: if $noindex {
    <meta name="robots" content="noindex,nofollow,noarchive,noodp,noydir">
: }
    <title><:$title:></title>
</head>

<body>

<div class="container">
<h1><: $title :></h1>

<hr>

: block main -> {}

<hr>

<footer class="col-sm-12">
<ul class="list-inline">
    <li><a href="/">トップへ戻る</a></li>
    <li><a href="/markdown">マークダウンのテストへ</a></li>
    <li><a href="/env">環境変数一覧へ</a></li>
    <li><a href="/empty">空のボディのテストへ</a></li>
    <li><a href="/session">セッションのテストへ</a></li>
    <li><a href="/action/1234567890">動的ルーティングのテストへ</a></li>
</ul>
</footer>
</div>

</body></html>
```
マークダウン記法のテストができるようになりました。

```html:Templates/root.tx
: cascade Templates::base
: around main -> {
<ul class="list-inline">
    <li><a href="/markdown">マークダウンのテストへ</a></li>
    <li><a href="/env">環境変数一覧へ</a></li>
    <li><a href="/empty">空のボディのテストへ</a></li>
    <li><a href="/session">セッションのテストへ</a></li>
    <li><a href="/action/1234567890">動的ルーティングのテストへ</a></li>
</ul>
: }
```
軽量化のため、マークダウン記法をやめてベタで[HTML5](https://www.w3.org/TR/html51/)書いてます。

```html:Templates/markdown.tx
: cascade Templates::base
: around main -> {
<form method="POST" action="/markdown" enctype="multipart/form-data"><p>
    マークダウンを含む記載:<br>
    <textarea name="markdown" rows="4" cols="30"><: $markdown :></textarea><br>
    <button type="submit">送信</button>
</p></form>

<hr>

<h2>プレビュー</h2>
<: $markdown | markdown | mark_raw :>
: }
```
テキストエリアにマークダウン記法で文章を打ち込んで、送信するとプレビュー以下に表示させるためのコストはこれだけです。

**ね、簡単でしょう？**あなたも始めよう！PSGI！

## 次回以降のお題
- サーバーエラー（500など）を意図的に投げる
- 未定だけどまだなんかあると思う

# 宣伝
本記事は自前で有料WebサービスをPerlで書いてリリースするに辺り、つまづいた点や気づいたことを共有する目的で書き始めました。

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