1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2017-03-14

LINE Bot AWARDSエントリーしてたので更新が遅くなりました。しかし、このシリーズ、需要あんのかな…

本日のお題 Log::Dispatch::Configでデバッグログを取る

おさらい

  1. PSGI入門第一章 環境変数の一覧を出す
  2. PSGI入門第二章 CGI::SessionをPSGIで無理やり使う
  3. PSGI入門第三章 動的ルーティングを実装する
  4. PSGI入門第四章 Text::XslateでViewを分離

前提

  • 本記事ではLog::Dispatchのカスタマイズ方法は省略1します。
  • 今までCGI::Carpなどにお世話になっていた人が主な対象です。

CGI::Carpの良かったところ(信者目線)

  • carpoutでログファイルに出力できた点
  • fatalsToBrowserでログを見に行く手間を省けたところ
  • 単純にdiewarnを使うよりデバッグがしやすい点2

PSGIではデフォルトの挙動で

  • croakdieするとデバッグ画面をブラウザに表示→fatalsToBrowser相当以上
  • carpwarnは事実上の無視3→なんとかインチキできんのか?
  • $ plackup Myapp.pl -rすると以後の挙動をターミナルに自動表示→じゃあ、そこにエラーやデバッグ吐いた方が楽

結論、Log::Dispatch使いましょう!4

ま、やってみましょう。

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してください。細かい解説は別記事です。

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しました。注意点は本文にある通り、スカラ名の挿入や外部/内部文字列の区別です。


以下は必要なテンプレートですが、前回と変更のないものは省いてます。

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>

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

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書いてます。

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こちらのQRコードをスマホで読み取り、
興味を持った方はhttps://qrown.meまでぜひお立ち寄りください!

  1. この辺に書いたから

  2. =Carpの利点

  3. 私の認識。どこにどう出るのか教えて欲しい。

  4. 正確には、その用途だけならばLog::Dispatch::Screenだけで足りるけど、便利なのでLog::Dispatch::Fileも一括設定しちゃう。

1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?