119行でPlack対応のWeb Application Framework を書いてみる

拡張性等を考慮しなければ、以下のように簡単にかくことができる。

View を XSlate きめうち。ルータは given-when で、設定ファイルは .pl という構成。だいたいのウェブアプリケーションは、これぐらいの機能の WAF で十分。ルーター部分は Router::Simple とかにさしかえた方がよいかもだけど。

5年前に Python で似たような記事をみたのだが、今はみんなのがんばりによって Perl でもおなじことができるようになった。

use strict;
use warnings;
use 5.10.1;

package MyWAF;
use parent qw/Class::Data::Inheritable/;
use Path::Class;
use Text::Xslate qw/mark_raw/;
use Encode;
use Time::Piece;

__PACKAGE__->mk_classdata(qw/config/);
__PACKAGE__->mk_classdata(qw/base_dir/);
__PACKAGE__->mk_classdata(qw/response_class/);
__PACKAGE__->mk_classdata(qw/request_class/);
__PACKAGE__->mk_classdata(qw/xslate/);

sub context { die "no context is awaked" }

sub init {
    my ($class) = @_;
    $class->init_base_dir();
    $class->init_config();
    $class->init_xslate();
    $class->response_class("MyWAF::Response");
    $class->request_class("MyWAF::Request");
}

sub init_base_dir {
    my ($class) = @_;
    $class->base_dir(file(__FILE__)->dir()->parent());
}

sub init_config {
    my ($class) = @_;

    my $env = $ENV{PLACK_ENV} || 'development';
    my $fname = $class->base_dir->file('conf', "$env.pl")->stringify;
    my $config = do $fname or die "cannot load configuration file: $fname";
    $class->config($config);
}

sub init_xslate {
    my ($class, ) = @_;
    my $xslate = Text::Xslate->new(
        syntax   => 'TTerse',
        path     => $class->base_dir->subdir('tmpl')->stringify,
        # cache => 0,
        function => {
        },
        module => [qw/URI::Escape/],
    );
    $class->xslate($xslate);
}

sub new {
    my $class = shift;
    my %args = @_==1 ? %{$_[0]} : @_;
    bless { %args }, $class;
}

sub DESTROY {
    my $self = shift;

    if ($self->{dbh}) {
        $self->{dbh}->disconnect;
    }
}

sub dbh {
    my $self = shift;
    $self->{dbh} //= DBI->connect(@{$self->config->{DB}}) or die "DBI connection failed";
}

sub render {
    my $self = shift;
    my $html = $self->xslate->render(@_);
    $html = Encode::encode_utf8 $html;
    $self->response_class->new(200, ['Content-Length' => length($html), 'Content-Type' => 'text/html; charset=utf-8'], [$html]);
}
sub return_404 {
    $self->response_class->new(404, ['Content-Type' => 'text/plain; charset=utf-8'], ['not found']);
}
sub redirect {
    my ($self, $location) = @_;
    my $res = $self->response_class->new();
    $res->redirect($location);
    $res;
}
sub show_error {
    my ($self, $msg) = @_;
    $self->response_class->new(500, ['Content-Type' => 'text/plain; charset=utf-8'], [$msg]);
}

sub req { $_[0]->{req} }

sub handler {
    my ($class) = @_;

    sub {
        my $env = shift;
        my $req = $class->request_class->new($env);

        my $c = $class->new(req => $req);
        local *MyWAF::context = sub { $c };

        my $res = $class->handle_request( $c, $req );

        return $res->finalize;
    };
};

package MyWAF::Request;
use parent qw/Plack::Request/;

package MyWAF::Response;
use parent qw/Plack::Response/;

1;

で、使用例は以下のようになる。

# sample code here.

package MyApp;
use 5.12.1;
use parent qw/MyWAF/;

__PACKAGE__->init();

sub handle_request {
    my ($class, $c, $req) = @_;
    given ($req->path_info) {
    when ('/') {
        return $c->render('/');
    }
    defualt {
        return $c->return_404();
    }
    }
}

# in your myapp.psgi
use 5.12.1;
use MyApp;

MyApp->handler;

なお、この記事は、WAF が簡単にかけるよってことぐらいがいいたいのであって、オレオレフレームワークを推奨しているというわけではない。