Catalystの最近のブログ記事

YAPC::Asia 2009でmodern Catalystと称してトークをしてきました。

多分Perl史上良くも悪くも最も多くの人が開発、利用に携わったWeb Application Frameworkで、未だに現場で多く使われているCatalystがメジャーバージョンアップをしたのでその辺を話してきました。

Moose-ified = modernという訳ではないし、自分はMoose廚ではないのですが多くの時間を割く結果になりました。本当は抽象化やTest周りやおすすめのPlugin/ComponentとかTipsとかDBIC周りにも触れたかったのですが20分では無理だったので、またの機会に。最後の方でちらっとだけPSGIにも触れさせてもらいました。

最近Catalystをご無沙汰してたのでリハビリがてらJPA セミナーでも紹介されていたCatalyst::Controller::ActionRoleを触ってみました。

要はこのコントローラを継承することでMoose::Roleで書いた機能をメソッド attributeで呼べるようになります。

package MyApp::ActionRole::Bar;

use Moose::Role;

after execute => sub {
    my ($self, $controller, $c) = @_;

    my $body = $c->response->body || '';
    $c->response->body($body . 'Bar');
};

1;

package MyApp::Controller::Foo;

use strict;
use warnings;

use parent 'Catalyst::Controller::ActionRole';

sub bar : Local Does('Bar') { }

1;

で、http://localhost:3000/foo/barにアクセスするとBarと表示されます。

さらに

package MyApp::ActionRole::Baz;

use Moose::Role;

before execute => sub {
    my ($self, $controller, $c) = @_;

    my $body = $c->response->body || '';
    $c->response->body($body . 'Baz');
};

1;

を追加して

-- snip --

sub bar : Local Does('Bar') Does('Baz') { }

-- snip--

とかして、アクセスするとBazBarと表示されます。
このようにMoose::Roleとmethod modifiersを利用して実装を切り離して再利用することができます。
ActionClassより大分エレガントです。

例えば

sub confirm : Local Does('Validate') { .. }
sub submit : Local Does('Validate') { .. }
 

とか使い方がありそうです。

JPAセミナー#1でJay Shirley氏が絶賛していたlocal::libですが、その際に「異なるバージョンのモジュールをテストするのにも便利ですね」とか言っていた気がするので、早速やってみました。

お題は、Catalystで先日公開されたMoose版の5.8と旧5.7をベンチマーク比較してみます。

まずはCatalyst::Runtime 5.71001を$HOME/cat5.7にインストールします。

$ cd
$ perl -MCPAN -Mlocal::lib=cat5.7 -e 'CPAN::install("M/MR/MRAMBERG/Catalyst-Runtime-5.71001.tar.gz")'

次にCatalyst::Runtime 5.8(この時点での最新版は5.8001でした)を$HOME/cat5.8にインストールします。

$ cd
$ perl -MCPAN -Mlocal::lib=cat5.8 -e 'CPAN::install(Catalyst::Runtime)'

$HOME/MyAppに新しいCatalystアプリケーションを作ります。

$ cd
$ catalyst.pl MyApp
$ cd MyApp

後は

$ perl -Mlocal::lib=~/cat5.8 script/myapp_server.pl  

とやればテストサーバーがCatalyst 5.8で起動するし

$ perl -Mlocal::lib=~/cat5.7 script/myapp_server.pl  

とやれば5.7で起動します。

で、参考までにベンチ結果ですがベンチ用に最小構成にした以下のアプリケーションをテストサーバーで立ち上げてとってみました。

package MyApp;

use strict;
use warnings;

use Catalyst::Runtime;
use parent qw/Catalyst/;
__PACKAGE__->config( name => 'MyApp' );
__PACKAGE__->setup();

1;

package MyApp::Controller::Root;

use strict;
use warnings;
use parent 'Catalyst::Controller';

__PACKAGE__->config->{namespace} = '';
sub index :Path :Args(0) {
    my ( $self, $c ) = @_;

    $c->response->body( $Catalyst::VERSION );
}

1;

ab -n 1000 -c 10 http://localhost:3000/の結果は

Requests per second:    164.87 [#/sec] (mean)
Time per request:       60.653 [ms] (mean)
Time per request:       6.065 [ms] (mean, across all concurrent requests)
Transfer rate:          18.30 [Kbytes/sec] received

Requests per second:    156.48 [#/sec] (mean)
Time per request:       63.907 [ms] (mean)
Time per request:       6.391 [ms] (mean, across all concurrent requests)
Transfer rate:          17.37 [Kbytes/sec] received

でした。
この辺は参考程度にしかなりませんが、そこそこいい線行ってると思います。

Catalyst 5.8系、通称catamooseの最初のリリースバージョンであるCatalyst::Runtime 5. 80001がCPANにアップされました。

The Catalyst Core Team is proud to announce that we've just shipped  
the next major release of the Catalyst framework, version 5.8001.  
This release is the result of the helpful contributions of a large  
number of people, comprising documentation, new features, bug fixes  
and entire branches of refactoring, and has taken over twelve months  
work.

5.8系の大きな変更はcatamooseの通称どおりMooseの採用にあります。ただし、5.8系ではインターフェースとしては5.7系との後方互換があるので多くのケースではそのまま移行できるとのことです。

また、MROとしてNEXTからC3への移行や、古いM|V|Cのネームスペースの廃止、setupフェーズのhook pointの追加、細かなバグフィックスなどが含まれています。

この辺の情報はすでにドキュメント化されておりCPANに上がっています。

• Delta changes from 5.7 to 5.8 (5.7と5.8の差分情報)
• Upgrading to Catalyst 5.80 (5.8へアップグレードする際の注意点)

まだCatalyst::DevelやCatalyst::Manualのほうは更新されていませんが、この辺も徐々に追い付くと思われます。

追記 (2009/02/09):
Using Unicode in Catalyst Applicationsを参考に一部改変しました。

以前、Catalystでマルチバイトを取り扱うときのまとめという記事を書いたのですが、情報が少し古いので、最近僕がやっている方法を紹介します。

• Catalyst 5.7015
• Catalyst::View::TT 0.27
• Catalyst::Plugin::ConfigLoader 0.22
• Catalyst::Plugin::FillInForm 0.10
• Catalyst::Plugin::Static::Simple 0.20
• Catalyst::Plugin::Unicode 0.8

また、基本的にDBICに関しては以前の記事の通りDBIx::Class::UTF8Columnsを使うという感じです。

追記:
Using Unicode in Catalyst ApplicationsによるとDBDのオプションで指定する方法が紹介されています。ここに補足記事を書きました。

まず、こんな感じのアプリケーションを用意します。

package MyApp;

use strict;
use warnings;

use Catalyst::Runtime '5.70';

use parent qw/Catalyst/;
use Catalyst qw/
                ConfigLoader
                Static::Simple
                FillInForm
                /;
our $VERSION = '0.01';
__PACKAGE__->config( name => 'MyApp' );
__PACKAGE__->setup();

1;

package MyApp::View::TT;

use strict;
use base 'Catalyst::View::TT';

__PACKAGE__->config(TEMPLATE_EXTENSION => '.tt');

1;

package MyApp::Controller::Root;

use strict;
use warnings;

use parent 'Catalyst::Controller';

__PACKAGE__->config(namespace => '');

sub index : Path : Args(0) {
    my ($self, $c) = @_;

    my $foo = $c->req->param('foo');
    $c->stash->{foo} = $foo;
    $c->stash->{length} = length $foo;

    $c->stash->{template} = 'index.tt';
    $c->forward($c->view('TT'));
    $c->fillform;
}

1;

<html>
<body>
<h1>日本語テスト</h1>
<form method="post">
<input type="text" name="foo" />
<input type="submit" name="submit" />
</form>
<hr/>
[% foo %] ([% length %])
</body>
</html>

このまま立ち上げてブラウザでアクセスしても特に文字化けすることはありません。フォームにマルチバイト文字を入力しても化けません。が、$lengthの値が意図しない値になってます。これは、デフォルトではリクエストパラメータにUTF8フラグが立っていないためバイト数になっていることが原因です。

都度decodeしてUTF8フラグを立てるのもいいですが、僕は面倒なのでCatalyst::Plugin::Unicodeを使っています。

-- snip --

use Catalyst qw/
                ConfigLoader
                Static::Simple
                FillInForm
                Unicode
                /;

-- snip --

これによって$c->req->paramで取れる値には全てUTF8フラグが立ちます。これでいちいちdecodeする手間が省けて、$c->stash->{length}にも文字数が入るようになりました。が、実行するとわかる通り、フォームにマルチバイト文字を入力すると「日本語テスト」の部分が文字化けします。TTで読み込まれた文字列にはUTF8フラグが立っていないのにUTF8フラグが立っている[% foo %]を評価したためです。

これを回避するために以前ではCatalyst::View::TT::ForceUTF8を使っていましたが、Catalyst::View::TT 0.21からTemplate::Providerをサポートするようになったのでこれを利用します。この設定にはTemplate::Provider::Encodingのインストールが必要です。

-- snip --

__PACKAGE__->config(
    TEMPLATE_EXTENSION => '.tt',
    DEFAULT_ENCODING   => 'utf8',
    PROVIDERS          => [
        {
            name        => 'Encoding',
            copy_config => [qw(DEFAULT_ENCODING INCLUDE_PATH PRE_CHOMP POST_CHOMP)]
        }
    ],
);

-- snip --

追記:
Using Unicode in Catalyst ApplicationsによるとTTのENCODINGオプションを指定するだけで良いみたいです。seems to be undocumentedとありますが、TTのFAQに書いてありました。

__PACKAGE__->config(
    TEMPLATE_EXTENSION => '.tt',
    ENCODING   => 'utf8',
);

これで解消されます。

今度はMyApp::Controller::Rootで明示的に$c->stash->{foo}にマルチバイト文字を指定してみます。

-- snip --

sub index : Path : Args(0) {
    my ($self, $c) = @_;

    my $foo = 'ほげ';
    $c->stash->{foo} = $foo;
    $c->stash->{length} = length $foo;

-- snip --

化けます。

MyApp::Controller::Root
package MyApp::Controller::Root;

use strict;
use warnings;

use utf8;

use parent 'Catalyst::Controller';

-- snip --

これで回避できます。ちなみにこうすることによって

$c->req->params->{foo} = 'ほげ';

のように、Controll内で直接リクエストパラメータを指定してFillInFormしても化けないのでCatalyst::Plugin::FillInForm::ForceUTF8などは必要なくなります。

また、Catalyst::Plugin::ConfigLoaderを使っていてconfigファイルにマルチバイト文字を使用している場合、$c->config->{'bar}で取れる値にはUTF8フラグは立っていないため、TTで表示しようとすると文字化けします。

$c->stash->{'bar'} = $c->config->{bar};

これを回避するにはConfig::Generalベースのconfigの場合は

-- snip --

__PACKAGE__->config(
    name => 'MyApp' ,
    'Plugin::ConfigLoader' => {
        driver => {
            'General' => { -UTF8 => 1 },
        }
    },
);

-- snip --

とします。

YAMLベースの場合はYAML::Syck 0.70以上があればYAML::Syck、なければYAMLが使われます。YAML::Syckが入っている場合は

-- snip --

$YAML::Syck::ImplicitUnicode = 1;
__PACKAGE__->config( name => 'MyApp' );

-- snip --

とします。

YAML::Syckが入っていなくてYAMLを使う場合は

-- snip --

use YAML;

__PACKAGE__->config(
    'name' => 'MyApp',
);
__PACKAGE__->setup();

sub finalize_config {
    my $c = shift;

    my $yaml = YAML::Dump($c->config);
    utf8::decode($yaml);
    $c->config(YAML::Load($yaml));
    $c->next::method(@_);
}

-- snip --

のようにすると文字化けしません。

Speak up for Catalyst - Perlbuzz

Matt TroutとKieren DimentがCatalystに関する本を出版する上で、出版社から市場規模を図る上でのデータを求められているそうです。

• What country are you in?
  (どの国に住んでいますか？)
• How many people are on your team?
  (あなたのチームは何人ですか？)
• How many of those people are writing code with Catalyst? If there are non Catalyst coders on your team, how many of the whole team would you like to be writing Catalyst code?
  (その中で何人の人がCatalystを使ってコードを書いていますか？もしチームにCatalystを使っている人がいないのであれば、何人くらいCatalystでコードを書いてみようと思っている人がいますか？)
• How many people using Catalyst on your team are subscribers to the Catalyst mailing list?
  (チームの中でCatalystを使っている人の何人くらいがCatalystのメーリングリスト購読者ですか？)
• How many people writing Catalyst code on your team use the #catalyst IRC channel on irc.perl.org?
  (チームの中でCatalystを使っている人の何人くらいが#catalystのIRCチャンネルに参加していますか？)
• What do you see as potential for growth of Catalyst in your organisation? How many people do you think will be using Catalyst in your organisation in 12 months? In 2 years?
  (あなたの組織内でCatalystはどのくらい成長する可能性があると思いますか？あなたの組織内で何人くらいの人がCatalystを使うと思いますか？12ヶ月、2年で答えてください。)

回答をkdiment@uow.edu.auに送って欲しいとのことです。

100回答あればいいそうですが、日本の反応も貴重だと思うので、数字だけを答えればいい単純な質問ばかりだし答えてあげてください。

自分でも地味によく使うC::C::RequestTokenを0.03にしてreleaseしました。(0.02はミスったのでなかったことに)

全体的にリファクタリングしたくらいで機能は基本的に変わってません。
一つはcontextをweakenしなきゃいけないのを大昔にtypesterさんに言われたまま放置してたのを実装しました。
これはCatalyst::Component::ACCEPT_CONTEXTを使えば気にしなくていいんですけど、とりあえず自前でweakenしてます。
あと、ikasam_aさんに指摘されてた__PACKAGE__->configが効かなかったのを直してます。

あちこちで叫ばれている、むやみやたらにCatalystのPluginを作るべきではない運動。(この辺はトクヒロムさんがキャンペーンを張ってるので一読して方がいいです。)
まー言われていることはもっともで、ComponentでできることはComponentにすべきなわけです。
で、拙作のCatalyst::Plugin::RequestTokenなる代物も一部finilizeを使っているものの、明らかにControllerにするべきなので、C::P::RequestTokenをdeprecateさせてCatalyst::Controller::ReqeustTokenってのをとりあえず作ってCPANでリリースしました。

package MyApp::Controller::Foo;
use base qw(Catalyst::Controller::RequestToken);

sub form :Local {
    my ($self, $c) = @_;
    $c->stash->{template} = 'form.tt';
    $c->forward($c->view('TT'));
}

sub confirm :Local :CreateToken {
    my ($self, $c) = @_;
    $c->stash->{template} = 'confirm.tt';
    $c->forward($c->view('TT'));
}

sub complete :Local :ValidateToken {
    my ($self, $c) = @_;
    if ($self->validate_token) {
        $c->response->body('complete.');
    } eles {
        $c->response->body('invalid operation.');
    }    
}

<html>
<body>
<form action="complete" method="post">
<input type="hidden" name="_token" values="[% c.req.param('_token') %]"/>
<input type="submit" name="submit" value="complete"/>
</form>
</body>
</html>

とかすると、トークンにより/foo/confirm -> /foo/complete のトランザクションが保証され、/foo/completeの二重サブミットやCSRF攻撃を防ぐことができます。

Controllerにすることによってfinilizeのフックが出来なくなってprepare_tokenが再現できないのですが、その他はほぼ同じ動きをするし、見た目こっちの方がわかりやすいと思います。

これに伴いCatalyst::Plugin::RequestTokenはdeprecateされたのでご注意ください。

CatalystCon#1に行って来たよ。
一応スピーカーとして話してきたよ。

• MVC論 - dann
  • とってもJava的で懐かしかった。
• Controller::Resouces - ikasam_a
  • 出て意外と早く触ってたけど、やっぱ便利
  • ROAって妙に説得力がある
• $c <3 C - charsbar
  • Catalystの歴史の話が面白かった
  • Pluginはなるべく作らない方向で
  • やっぱり時間足りなくて途中で加速装置が働いてた
• コピペをしないための10の方法 - typester
  • catalyst.plを最初に否定した人なので説得力あった
  • 最後のほうは苦しかった
• Model::Apadtor - hide-k
  • ここにあげておいた
• Catalyst☆Complex - tokuhirom
  • Sledge::Request::Catalyst
  • どっちがウケか結論が出てなかったので気持ち悪い
• HTTP::Server::Wrapper - Yappo
  • Okinaはこれで完成したも同然だね☆

Twitter使ったデモをしようと思ったら寸前でタイムラインがぐちゃぐちゃになってるのに気がついてあわててWassrに切り替えようとNet::Wassrをインストールしようとしたら、autoboxとかModule::Compile::TTとか作りたての環境にあるわけもないモジュールを要求されて冷や汗が出ました。
ま、そんな思いをして作ったデモも時間切れでスルーだったんですけどね。

• nothingmuchはゴミみたいなインターフェースのモジュールばっか作ってごめんなさいってひたすら謝ってた
• そのくせ、作りたいと思ったから作ってると開き直ってた
• 帰り道のtypesterさんとの野球談義が楽しかった
• tokuhiromさんにはいい加減顔を覚えてもらったと思う

おまけ - nothingmuchの名刺

箸の切れ端で現地大量生産してたよ。

今さらTheSchwartzを使い始めました。
で、jobの状態を監視するWebインターフェースをCatalystで作ることになったのですが、いちいちTheSchwartzのインスタンスを作るのが面倒くさい。
でもそのためにModel作るのもアホらしい。
で、Catalyst::Model::Adaptorを使ってMyApp::Model::TheSchwartzを作ってモデルとして使うのをやってみたのでメモ。

script/myapp_create.pl model TheSchwartz Adaptor TheSchwartz

package MyApp::Model::TheSchwartz;
use strict;
use warnings;
use base 'Catalyst::Model::Adaptor';

__PACKAGE__->config(
    class       => 'TheSchwartz',
    constructor => 'new',
);

sub prepare_arguments {
    my ( $self, $app ) = @_;

    my $args = $app->config->{"Model::TheSchwartz"};
    return $args;
}

sub mangle_arguments {
    my ( $self, $args ) = @_;

    return %$args;
}

1;

Model::TheSchwartz:
  databases:
    -
      dsn: dbi:mysql:theschwartz
      user: root
      pass:

コントローラとかで

$c->model('TheSchwartz')->insert($job);

my @jobs = $c->model('TheSchwartz')->list_jobs({'funcname' => 'MyApp::Worker'});

楽勝。

Catalyst::Model::Adaptor - use a plain class as a Catalyst model

要はどんなクラスでもCatalystのモデルにしてくれるクラスです。

たとえばこんなクラスを作って

package MyApp::DateTime;

use strict;
use warnings;

use base qw/DateTime/;
use DateTime::Format::W3CDTF;

sub now {
    my ($class, $args) = @_;

    $args->{time_zone} = 'local' unless $args->{time_zone};
    return $class->SUPER::now(%$args);
}

sub parse {
    my ( $class, $str ) = @_;

    my $dt = DateTime::Format::W3CDTF->parse_datetime($str);
    bless $dt, $class;
}

sub format {
    my $self = shift;

    return DateTime::Format::W3CDTF->format_datetime($self);
}

で、ヘルパーを使うと

script/myapp_create.pl model DateTime Adaptor MyApp::DateTime now 

こんなクラスを作ってくれます。

MyApp::Model::DateTime

package Test::Model::DateTime;
use strict;
use warnings;
use base 'Catalyst::Model::Adaptor';

__PACKAGE__->config(
    class       => 'Test::DateTime',
    constructor => 'now',
);

1;

ヘルパーの使い方は

script/myapp_create.pl model [Modelクラスの名前] Adaptor [使うクラス名] [コンストラクタ名]

みたいな感じ

で、コントローラにこんな感じのを書いて

-snip-

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

    my $model = $c->model('DateTime');
    $c->res->body($model->format);
}

-snip-

サーバーをあげて/nowにアクセスすると現在の時間をW3CDTFな書式で表示してくれます。
便利！

・・・ですがリロードしても時間が変わりません。
で、M::DateTimeを変更します。

MyApp::Model::DateTime

- snip -

use base 'Catalyst::Model::Factory';

- snip -

で、あげなおしてリロードしたらちゃんと現在の日時を返してくれます。

Catalyst::Model::Adaptorのパッケージには

Catalyst::Model::Adaptor - アプリケーションの起動時にインスタンスを生成
Catalyst::Model::Factory::PerRequest - リクエストごとにインスタンスを生成
Catalyst::Model::Factory - $c->model()で呼ばれるたびにインスタンスを生成

が入ってるのでそれぞれの用途で使い分けるといいです。

また、コンストラクタの引数を設定ファイルに指定する場合は

---
name: Test
Model::DateTime:
  args:
    time_zone: UTC

な感じでargs:の下に書くとよろし。

ただし、注意しなければいけないのはC::M::Adaptorからクラスのコンストラクタに渡る引数はハッシュリファレンスになります。今回はクラスのほうでDateTimeクラスに渡すときに変換していますが、C::M::Adaptorのprepare_argumentsとmangle_argumentsをオーバーライドすることで行うこともできます。

MyApp::DateTimeからnow()を削って、MyApp::Model::DateTimeに

sub prepare_arguments {
    my ( $self, $app ) = @_;

    my $args = $self->{args};
    $args->{time_zone} =  'local' unless $args->{time_zone};
    return $args;
}

sub mangle_arguments {
    my ( $self, $args ) = @_;

    return %$args;
}

を追加する感じ。

ドキュメントにありますが要は内部的に

my $args = $self->prepare_arguments($app);
$adapted_class->$constructor($self->mangle_args($args));

みたいな処理をしてアプリケーションからクラスのコンストラクタに渡してるのでそれぞれフックしてやる感じです。

二重リクエスト防止やCSRF対策にも使える・・・はずのCatalyst::Plugin::RequestTokenをアップデートしました。
内容はC::P::FormValidator::Simpleと強調するはずが、しないという致命的なバグ。
こんな短いコードでよくもまぁ気づかずに放置してたもんだと、我ながら恥ずかしい始末。
今作ってるプロダクトで気づきました。ゴメンナサイ。

というわけで、ずいぶん前に注文したやつが届きました。

だそうです。

当時はネタで買ったつもりが、いざ届いてみると・・・
普通の人から見たら、ただのTシャツなのでいいんだけど・・・
これで2千なんぼの出費をどう考えるか・・・
でも、コミュニティに貢献できてよかったじゃないかっ・・・
と自分に言い聞かせてる次第です。

「ネット通販はすぐ届かないと熱が冷める」

今回の教訓です。

Catalyst::Plugin::FillInForm::ForceUTF8 をアップデートしました。そのうちインデックスされると思います。

0.02 Wed May  23 2007

    - implemented finalize method

そう。どこでソースが入れ替わったのか知りませんが、finalizeを実装してないのをあげちゃったのでデフォルトでFormValidatorがエラーを返してもfillformしてなかったんですね。てへ。

自分の環境では常に明示的にfillformしてるので、同僚のAさんに言われるまで気づかなかったです。

てか、Catalystのプラグインのテスト書くのすんごい面倒なのでテストを書いてないのばればれです。この辺のBP欲しかったりする。

と、思っていたら、多対多のときには _rs ではできないね。

そうそう。忘れてました。many-to-manyではできないんですね。
これはドキュメントにもちゃんと書いてあって

Many_to_many is not strictly a relationship in its own right. Instead, it is a bridge between two resultsets which provide the same kind of convenience accessors as true relationships provide. Although the accessor will return a resultset or collection of objects just like has_many does, you cannot call $related_resultset and similar methods which operate on true relationships.

つまりhas_manyと同じようにアクセサを使えるけど、$related_resultsetなメソッドは使えないので下の例だとentries_rsなんてメソッドは使えないと。

package MT::Schema::Category;

use strict;

__PACKAGE__->has_many(
    placement => 'MT::Schema::Placement',
    'placement_category_id',
);
__PACKAGE__->many_to_many(
    entries => 'placement',
    'entry',
);

1;

ちなみに

$category->search_related('entries', {})

とか*_related関連メソッドも、そんなリレーション知らんと、怒られます。

なので、面倒だけど僕はmany-to-manyな関係を持つテーブルには

sub entries_rs { 
    my $rs = shift->entries->count
    return $rs;
}

なんてメソッドくっつけてます。

またはDBIx::Class::Relationship::ManyToManyをhackして

*{"${class}::${meth}_rs"} = sub {
  my $self = shift;

  my $rs = $self->${meth}(@_);
  return $rs;
};

ってメソッドをつけるのもありかもですね。