Plack+CatalystでWebアプリ（とCLI）を作ってみる

Jun 14, 2010

1 年間インフラ修行ばっかりやってて、カタムースとかプラック企業の流れに乗り切れなかったので一念発起して最近趣味で Plack と Catalyst で Web アプリを書こうとしています。ただ、アプリのロジックに入る前に、そもそもモジュールの構造をどうしようかと試行錯誤するだけで数週。。。一旦ここまでのまとめをしておきたいと思いました。

Perl 界隈の方々は本当にエロくてすばらしいなと改めて感じました。自分のプログラムセンスの無さをひしひしと感じてますが、今回のアプリの開発を通じて何か CPAN に上げて、僕もエロくなれたらいいなぁとか密かに思ってたりしてます。

それは MyApp::Web から始まった

とりあえずモダン Perl 入門にあるように、以下の様なコマンドで Catalyst 用のモジュールを一段名前を掘って作りました。

catalyst MyApp::Web

こうしておくと、Catalyst とそれ以外(script とか CLI とか)で共通的に使うモジュールを Catalyst から名前空間的に分離して置けるのですっきり！とのことでしたので倣いました。ただ、自分の実力不足の故、それを実現するためには長い道のりが必要でした。。。

Plack すげーよ！miyagawa さん++

続いて、最近流行りの Plack を使ってみようと思いました。Catalyst で書いたアプリも簡単にインタフェースを PSGI にできるとのことでしたので、さっそくやってみてあまりにもあっさりだったので拍子抜け。

script/myapp_create.pl PSGI
plackup -E product -R ./root -R ./lib -r script/myapp.psgi

Plack/PSGI が何なのか、についてはこの辺を見てもらうと良いですが、実際に mod_perl で動かすのか fastcgi で動かすのかといった選択を後回しにできるのは非常に気持ちよいですね。

ちなみに plackup で-E productとしているのは、Catalyst の debug 画面を出すため。 Plack 側で何か作ったりする予定は今は無いので。。

このアプリでは試しに Plack::MiddleWare::Session を使ってみてます。Catalyst で管理しても良かったのですが、せっかくなので Plack 側で。非常にらくちんです。Sesion にひもづけて key/value を保存して使うならこんな感じで Catalyst 側で使えるようです。詳細な使い方は POD をご覧下さい。

my $session = Plack::Session->new($c->req->env);
$session->set('hoge', 'fuga'); #hogeというkeyでfugaという値をセット

別のサブルーチンで
$hoge = $session->get('hoge') #セッション毎に保存されたhogeの値がgetできる

Plack::Builder というやつで MiddleWare をいくつもいくつもタマネギみたいに付けて行くことができて、今のアプリではこんな感じで PSGI を psgi ファイルから外だししていて、テストなどでも使えるようにしています。

package MyApp::Web::PSGI;
sub app {
        MyApp::Web->setup_engine('PSGI');
        my $app = sub { MyApp::Web->run(@_) };
        $app = builder {
                enable 'Session',
                        store => Plack::Session::Store::File->new(
                                dir => '/tmp/mysqpp_session/',
                        );
                enable 'Debug';
                $app;
        };

        return $app;
}

Debug 挟んでおくと、Web の画面に JS で Plack 側の Debug 情報が表示できるようになります。先程の Session の情報とかも表示されて便利ですね。

Twitter の OAuth やってみた

作ろうとしてるアプリが Twitter との連携が必要で、ユーザ毎に token を取得してもらってさらに保存する(バックエンドの daemon 等でアクセスするため)必要がありましたので、その辺の一連の動きだけ試しに作り込みました。 Plack の Session を使ってあとは Net::Twitter を普通に使うだけでお k でした。以下、MyApp::Web::Controller::Root でとりあえず実装。

sub login :Local {
        my ($self, $c) = @_;

        my $session = Plack::Session->new($c->req->env);
        my $nt = Net::Twitter->new(traits => [qw/API::REST OAuth/], %{$c->config->{oauth}->{param}});
        my $url = $nt->get_authorization_url(callback => $c->config->{oauth}->{callbackurl});

        $session->set('token', $nt->request_token);
        $session->set('token_secret', $nt->request_token_secret);

        $c->response->redirect($url);
}

sub oauth_callback :Local {
        my ($self, $c) = @_;
        my $session = Plack::Session->new($c->req->env);

        my $token = $c->req->params->{oauth_token};
        my $verifier = $c->req->params->{oauth_verifier};

        my $nt = Net::Twitter->new(traits => [qw/API::REST OAuth/], %{$c->config->{oauth}->{param}});
        $nt->request_token($session->get('token'));
        $nt->request_token_secret($session->get('token_secret'));

        my ($access_token, $access_token_secret, $twitter_id, $screen_name)
                = $nt->request_access_token(token => $token, verifier => $verifier);

        # $access_tokenと$access_token_secretをMySQLに保存
}

Config を Catalyst から分離するにはどうすればよいか

さて、上の例で$c->configとかあるんですが、これをどうやって Catalyst から分離するかということが最初に頭を悩ませた点でした。Catalyst 側では Catalyst::Plugin::ConfigLoader がうまい事設定ファイルを探して読んで来てくれていますが、CLI 側とどうやって共通化するか。

結論としては、以下の様なモジュールを作って(というかコピって)、CLI 側でも ConfigLoad する仕組みを作りました。これで(今のアプリの場合)MyApp-Web/etc/conf/配下に myapp.yaml とか myapp_local.yaml とかで作ったものは、MyApp::CLI::Common のインスタンスにもロードされるようになりました。

MyApp::CLI

CLI 用の base モジュール path_to が使いたいだけ。。。

package MyApp::CLI;
use strict;
use warnings;

use MyApp::Utils;

sub new {
        my $class = shift;
        my $self = {};
        $self->{config} = $class->setup_home;
        bless $self, $class;
        $self;
}

sub path_to {
        my ( $self, @path ) = @_;
        my $path = Path::Class::Dir->new( $self->{config}->{home}, @path );
        if ( -d $path ) { return $path }
        else { return Path::Class::File->new( $self->{config}->{home}, @path ) }
}

sub setup_home {
    my ( $class, $home ) = @_;

    if ( my $env = MyApp::Utils::env_value( $class, 'HOME' ) ) {
        $home = $env;
    }

    $home ||= MyApp::Utils::home($class);
    if ($home) {
        #I remember recently being scolded for assigning config values like this
#        $class->{config}->{home} ||= $home;
#        $class->{config}->{root} ||= Path::Class::Dir->new($home)->subdir('root');
        my $config;
        $config->{home} ||= $home;
        $config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
        return $config;
    }
}
1;

MyApp::Utils

これはほぼ Catalyst::Utils をコピー。省略

MyApp::CLI::ConfigLoader

Catalyst::Plugin::ConfigLoader をコピー。Catalyst っぽいところを外しつつ MyApp::CLI を base にして path_to を使えるようにしておいた。あとは setup を new に適当に作り替えただけ。

package MyApp::CLI::ConfigLoader;

use strict;
use warnings;

use Config::Any;
use MRO::Compat;
use Data::Visitor::Callback;
#use Catalyst::Utils ();
use MyApp::Utils ();
use Path::Class;

use base qw(MyApp::CLI);

use parent qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(config));

sub new {
    my ($class, $config) = @_;
    my $self = $class->SUPER::new();
#    $self->config($config);
    while (my ($key, $value) = each %{$config}){
        $self->config->{$key} = $value;
    }

    my @files = $self->find_files;
    my $cfg   = Config::Any->load_files(
        {   files       => \@files,
            filter      => \&_fix_syntax,
            use_ext     => 1,
            driver_args => $self->config->{ 'CLI::ConfigLoader' }->{ driver }
                || {},
        }
    );
    # map the array of hashrefs to a simple hash
    my %configs = map { %$_ } @$cfg;

    # split the responses into normal and local cfg
    my $local_suffix = $self->get_config_local_suffix;
    my ( @main, @locals );
    for ( sort keys %configs ) {
        if ( m{$local_suffix\.}ms ) {
            push @locals, $_;
        }
        else {
            push @main, $_;
        }
    }

    # load all the normal cfgs, then the local cfgs last so they can override
    # normal cfgs
    $self->load_config( { $_ => $configs{ $_ } } ) for @main, @locals;

    $self->finalize_config;

#    $self->next::method( @_ );
    $self;
}
# 以下省略

MyApp::CLI::Common

script などで必ずこいつのインスタンスを作る様にする。config 以外に schema も持たせてる。

package MyApp::CLI::Common;
use strict;
use warnings;

use MyApp::CLI::ConfigLoader;
use MyApp::Schema;

use base qw(MyApp::CLI);
use parent qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(config schema));

sub new {
        my $class = shift;
        my $self = $class->SUPER::new();
        $self->setup_config;
        $self;
}

sub setup_config {
        my $self = shift;
        $self->config(MyApp::CLI::ConfigLoader->new({
                'CLI::ConfigLoader' => {
                        file =>   $self->path_to('etc/conf/myapp'),
                },
        })->config);
}

sub schema {
        my $self = shift;
        $self->{schema} = MyApp::Schema->connect( $self->config->{'Model::DBIC'}{'connect_info'} );
        return $self->{schema};
}

1;

CLI から使ってみる

こんな感じで config が読める。

use MyApp::CLI::Common;

my $cli = MyApp::CLI::Common->new;
my $hoge = $cli->config->{'hoge'};

DB 操作も Catalyst から外だししよう

MyApp::CLI::Common の最後の方にある様に、ここにだけModel::DBICという記述を許せば、Catalyst と CLI で schema 用の config も共通化出来ました。ちなみに MyApp::Schema 自体は以下の様に既に作成済み。

script/myapp_create.pl model DBIC DBIC::Schema MyApp::Schema create=static dbi:mysql:[db_name] [user] [pass]

後は Catalyst の Model をモダン Perl 入門よろしく、MyApp::API に書いたモジュールに Catalyst::Model::Adaptor とかで繋いじゃえばいいんじゃないかな、と思ったのですが、ここでなんかモヤモヤしてます。

うーん、なんかまだ自分がやりたいこともよくわかって無いのでアレですが、イメージ的には DB アクセスも含めて MyApp::API に実装したいなと。

でも Schema を API の方で毎回作るのもイマイチなので、基本的には Catalyst や CLI の方から API に Schema を投げる形にしようと。

ただ、Catalyst::Model::Adaptor で constractor にオブジェクトを渡す方法がよく分からず、今は何か下の様にかっこわるい実装に。。。

package MyApp::API::APITest;
use strict;
use warnings;

sub new {
        my $class = shift;
        my $self = {};
        bless $self, $class;
        return $self;
}

sub init {
        my ($self, $schema) = @_;
        $self->{schema} = $schema;
        return $self;
}

sub get_hoge_data {
        my ($self, $value) = @_;

        my $hoge_data = $self->{schema}->resultset('HogeData');
        return $hoge_data->search({fuga => "$value"})->first->hoge;
}

1;

使う側はこちら。もうちょっときれいにしたい or そもそも model の constractor に何か渡す方法はあるのだろうか。

# CLIから使う
my $cli = MyApp::CLI::Common->new;
my $test = MyApp::API::APITest->new->init($cli->schema);
my $hoge_data = $test->get_hoge_data('hogehoge');

# Catalystから使う
my $hoge_data = $c->model('APITest')->init($c->model('DBIC')->schema)->get_hoge_data('hogehoge');

おまけ：Master/Slave とか Master 分割とか

こういう場合には、種類別に Schema と Model::DBIC を用意することになるんだろうか。たとえば DB2 系統で、それぞれ Master と Slave がある場合、

Schema
- Schema::DB1
- Schema::DB2
Model::DBIC
- Model::DBIC::DB1::Master
- Model::DBIC::DB1::Slave
- Model::DBIC::DB2::Master
- Model::DBIC::DB2::Slave

こんな感じになるのかな。まぁこの辺がダイナミックに変化することはないだろうからこれでも良さそうだけど。

テストについて

Test::mysqld なるものがあるらしいので、Catalyst のテストの際に、Plack 経由で起動してテスト用の mysqld を立ててテストデータ突っ込んでほげほげできるようにしました。基本、牧さんのこちらのエントリをパクっただけです。牧さん＋＋ただし僕はまだ Moose の使い方を知らないので、古めかしく。

Test::mysqld とかでテスト走らせる際に行ったいろんな事。

Makefile.PL

エントリほぼそのまま。ただし、CentOS に rpm で mysql 入れたら微妙にバイナリの場所が違うっぽかったので、適当に指示。

if (-f 'Makefile') {
    open (my $fh, '<', 'Makefile') or die "Could not open Makefile: $!";
    my $makefile = do { local $/; <$fh> };
    close $fh or die $!;

    $makefile =~ s/"-e" "(test_harness\(\$\(TEST_VERBOSE\), )/"-It\/lib" "-MTest::mysqld" "-e" "\\\$\$SIG{INT} = sub { CORE::exit(1) }; my \\\$\$m = Test::mysqld->new(mysql_install_db => '\/usr\/bin\/mysql_install_db', mysqld => '\/usr\/sbin\/mysqld', my_cnf => { 'skip-networking' => '' },); \\\$\$ENV{TEST_DSN} = \\\$\$m->dsn(); $1't\/lib', /;

    open (my $fh, '>', 'Makefile') or die "Could not open Makefile: $!";
    print $fh $makefile;
    close $fh or die $!;
}

MyApp::Test

テストスクリプトの中で必ず作っておく。もし既に Test::mysqld が起動していればその dsn を使い、無ければ自分で立ち上げて deploy してしまう。

package MyApp::Test;
use strict;
use warnings;

use Test::mysqld;
use MyApp::Schema;

sub new {
        my $class = shift;
        my $self = {};
        bless $self, $class;
        $self;
}

sub schema {
        my ($self, $dsn) = @_;

        $dsn = $ENV{TEST_DSN} unless($dsn);
        my $deploy = 0;
        if(!$dsn){
                my $mysqld = Test::mysqld->new(
                        mysql_install_db => '/usr/bin/mysql_install_db',
                        mysqld => '/usr/sbin/mysqld',
                        my_cnf => { 'skip-networking' => '' },
                ) or return "Could not start mysqld: $Test::mysqld::errstr";
                $self->{mysql} = $mysqld;
                $dsn = $mysqld->dsn;
                $deploy = 1;
                $ENV{TEST_DSN} = $dsn;
        }

        my $schema = MyApp::Schema->connect($dsn);
        if($deploy){
                $self->deploy;
        }
        return $schema;
}


sub deploy {
        my $self = shift;
        $self->schema->deploy;
}

sub init_data {
        my ($self, $data) = @_;

        $data = $self->_test_data unless($data);
        my $schema = $self->schema;

        while (my($table, $lows) = each %{$data}){
                my $rs = $schema->resultset($table);
                $rs->create($_) for (@{$lows});
        }
}

sub _test_data {
        return {
                HogeData => [
                        {
                                hoge_id => 1,
                                hoge => 'fuga',
                        },
                ],
        };
}

1;

t/00_mysql.t

make test した時に最初に起動するようにしておく。なんかオブジェクト指向とかへたくそで、こちら側でかっこわるい条件分岐してる気がする。。

#!/usr/bin/env perl
use strict;
use warnings;

use Test::More;
use MyApp::Test;

my $deploy;
$deploy = 1 if($ENV{TEST_DSN});
my $test = MyApp::Test->new;
$test->deploy if($deploy);
my $schema = $test->schema;
$test->init_data;

is $schema->resultset('HogeData')->search({hoge_id => 1})->first->hoge, 'fuga';

done_testing;

その他

あとは、そもそも Catalyst とかは local::lib 的な感じのディレクトリに root 以外で cpanm を使っていれてます。そんで、local::lib とアプリのコードをまとめて git に突っ込んでます。この辺はまた長くなるので省略。

というわけで準備完了？

API への Schema の渡し方はもうちょっと調整する必要がありそうな気はしますが、とりあえず当初の目標であった Catalyst と CLI 等で諸々共通な感じにできたと思います。

お気づきの通り、MyApp::APITest というどう考えても必要ないモジュール以外、まだ API を一つも書いていない状況であり、一体何のアプリを作るのかすでに忘れてしまいそうですが、そろそろアプリの本格的な開発に移っていきたいところです。

あ、View の部分はとりあえず TT:Site を使ってますが、TT 周辺は何にも調べてないのでそのうちやります。。。

ただ、全体的にツッコミ募集中。Perl 界隈のエロい方々のお知恵をお借りしたいところ。。初心者が無理矢理がんばるとこんな感じで残念なコードが盛りだくさんになってしまいます。。