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

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界隈のエロい方々のお知恵をお借りしたいところ。。初心者が無理矢理がんばるとこんな感じで残念なコードが盛りだくさんになってしまいます。。