Home » [Tech] » » [Perl] » [Catalyst]

2008.06.05

[ Catalyst]   Catalyst::Controller::RequestToken 0.01 release

あちこちで叫ばれている、むやみやたらに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.');
    }    
}
confirm.tt
<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されたのでご注意ください。

2008.04.23

[ Catalyst]   CatalystCon#1

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

おまけ - nothingmuchの名刺

nothingmuchの名刺

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

2008.02.14

[ Catalyst]   Catalyst::Model::AdaptorでTheSchwartzをModel化

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

HelperスクリプトでMyApp::Model::TheSchwartzを作成
script/myapp_create.pl model TheSchwartz Adaptor TheSchwartz
出来上がったMyApp::Model::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;
myapp.ymlに接続情報を追加
Model::TheSchwartz:
  databases:
    -
      dsn: dbi:mysql:theschwartz
      user: root
      pass:

コントローラとかで

jobを登録
$c->model('TheSchwartz')->insert($job);
jobのリストを取得
my @jobs = $c->model('TheSchwartz')->list_jobs({'funcname' => 'MyApp::Worker'});

楽勝。

2007.10.10

[ Catalyst]   Catalyst::Model::Adaptorを使ってみた

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

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

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

lib/MyApp/DateTime.pm
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 

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

lib/MyApp/Model/DateTime.pm
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 [使うクラス名] [コンストラクタ名]

みたいな感じ

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

lib/MyApp/Controller/Root.pm

-snip-

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

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

-snip-

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

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

lib/MyApp/Model/DateTime.pm
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));

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

2007.08.21

[ Catalyst]   Catalyst::Plugin::RequestToken 0.05リリース

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

2007.07.05

[ Catalyst]   Catalyst Tシャツ

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

2007070401.jpg

2007070402.jpg

だそうです。

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

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

今回の教訓です。

2007.05.23

[ Catalyst]   C::P::FillInForm::ForceUTF8 updated to 0.02

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

0.02 Wed May  23 2007
    - implemented finalize method

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

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

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

2007.05.22

[ Catalyst]   TTでDBICのmany_to_manyなメソッドを使う

[% WHILE %] の中のこと その後 (日々のこと)
と、思っていたら、多対多のときには _rs ではできないね。

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

DBIx::Class::Relationship - Inter-table relationships - search.cpan.org
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;
};

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

2007.05.21

[ Catalyst]   TTでDBICのhas_manyなメソッドを使う

よくわからない表題ですが要は・・・

MyApp::Schema::TopicsとMyApp::Schema::Commentsが1:nの関係にあるとして

package MyApp::Schema::Topics;

use strict;

__PACKAGE__->has_many('comments' => 'MyApp::Schema::Comments');

1;

こんなアクションで

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

	my $topics = $c->model('Topics')->search({});
    $c->stash->{topics} = $topics;
    $c->stash->{template} = 'list.tt';
}

TTで素でやる場合

<html>
<body>
<ul>
[% WHILE (topic = topics.next) %]
    <li>
	[% topic.title %]
	: comments([% topic.comments.size ? topic.comments.size : 0 %])
    </li>
[% END %]
</ul>
</body>
</html>

とかするのかなぁと。

何を言いたいかというと、TTでhas_manyで定義した子オブジェクトの結果一覧を取得するメソッド(ここではcomments)にアクセスするとイテレーターではなく配列のリファレンスとして扱われるので大変面倒。

で、こうするといい感じ。

<html>
<body>
<ul>
[% WHILE (topic = topics.next) %]
    <li>
	[% topic.title %]
	: comments([% topic.comments_rs.count %])
    </li>
[% END %]
</ul>
</body>
</html>

search_rs同様、_rsをつけるだけで強制的にイテレーター(ResultSet)を返すことができる。
ぶっちゃけしらんかったです。

発行されるSQLもこんなに親切
SELECT COUNT( * ) FROM comments me WHERE ( me.topic_id = ? )

しかも、こんなこともできちゃう。

<html>
<body>
<ul>
[% WHILE (topic = topics.next) %]
    <li>[% topic.title %]</li>
	: comments([% topic.comments_rs.count %])
    <ul>
    [% SET comments = topic.comments_rs.search_rs({}{rows => 5}) %]
    [% WHILE (comment = comments.next) %]
    <li> [% comment.title %]</li>
    [% END %]
    </ul>
[% END %]
</ul>
</body>
</html>

とっても便利・・・かな。

2007.04.23

[ Catalyst]   Catalyst::Plugin::FillInForm::ForceUTF8

Unknown::Programming - Catalyst::Plugin::FillInFormで文字が二重に化ける
でもこれ実はid:hide-Kさんも同じ名前のモジュールを作ってるみたいで(hide-k.net#blog: 使ってるCatalystのPlugins/Components)そうなるとこのモジュールCPANにあった方がいいんじゃないかとか思うんだけど。

というわけで、僭越ながら先ほどCPANにあげておきました

Catalyst::Plugin::FillInFormとpodもほとんどそのままですが、評判の悪いFormValidatorがエラーを返すと勝手にfillformする機能をオフにするオプション付き。本当はこっちの動作をデフォルトにしたいのですが、本家との挙動が変わってしまうのでやめておきました。どっちがいいんでしょうね。

2007.03.26

[ Catalyst]   Catalystでマルチバイトを取り扱うときのまとめ

#前に社内wikiに書いておいたのを公開してみるテスト。

Catalystでマルチバイトを扱う機会があるのは主に
  • ユーザーがフォームで入力する値 ($c->req->param())
  • データベースからの入出力 (DBIx::Class)
  • それ以外の文字列の評価
  • View::TTによる出力の生成
  • FillInFormによるフォームの埋め込み
  • HTTPレスポンス
です。 ここでは以下の条件でまとめてみました。
  • 文字コードはUTF8に統一
  • データベースにはmysqlを使用

下準備

テンプレート、perlのコードは全てUTF8で書きます。

mysqlの文字コードの指定は/etc/my.cnfに

[mysqld]
default-character-set = utf8
skip-character-set-client-handshake
[mysql]
default-character-set = utf8
[mysqldump]
default-character-set = utf8

を書いてから起動して、create databaseします。

ユーザーがフォームで入力する値 ($c->req->param())

Catalyst::Plugin::Unicodeを使う。 prepare_parameters時に$c->req->paramsの値にutf8フラグを立ててfinalize時に$c->res->bodyからutf8フラグを落としてくれる。

ただしfinalizeメソッドをオーバーライドしているのでFillInFormなどを使う場合には

use Catalyst qw/
	...
	FillInForm
	...
	Unicode
/;

とかして最後にロードするようにする。
(via http://unknownplace.org/memo/2006/03/09#e004)

データベースからの入出力 (DBIx::Class)

DBIx::Class::UTF8Columnsを使う。 $row->get_column/get_columnsでutf8フラグを立てて返す。
__PACKAGE__->load_components(qw/UTF8Columns Core/);
__PACKAGE__->utf8_columns(qw/name description/);

とかするとutf8_columnsで指定した$row->nameや$row->descriptionにutf8フラグが立つ。
指定していないものにはutf8フラグは立っていないのでマルチバイトコードを扱いそうなカラムは全部指定した方が良いかも。

それ以外の文字列の評価

常にutf8フラグを立てて評価する。
utf8::decode($str);

View::TTによる出力の生成

Catalyst::View::TT::ForceUTF8を使う。 テンプレートをutf8フラグを立てて処理する。
script/create.pl view TT TT::ForceUTF8

でViewクラスを作るか

すでにあるMyApp::View::TTを

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

として継承関係を変ればOK。

FillInFormによるフォームの埋め込み

通常は上記のことだけでOKなのですが、まれに
$c->req->param->{name} = 'ほげ';

というような処理をする場合、当然この文字列にはutf8フラグが立っていないのにView::TT::ForceUTF8でレンダリングされたutf8フラグ付きの文字列にfillformしようとするため文字化けします。

対処方法としては、"・それ以外の文字列の評価"で説明したとおり、常にutf8フラグを立てて取り扱えばいいのですが、面倒なときもあるのでHTML::FillInForm::ForceUTF8を使ったCatalyst::Plugin::FillInForm::ForceUTF8ってのを作りました。これだとfillform時に全てutf8フラグを立てるので文字化けは起こらなくなります。
ついでにFV::Sとか使ってると勝手にfillinするおせっかいな処理を抑制するオプション付き。

MyApp->config->(
    fillinform->{
        auto => 0
    }
);

HTTPレスポンス

HTTPレスポンスのcontent-typeはCatalystではデフォルトでutf8が設定されるけど、明示的に指定したい場合はMyApp::Controller::Rootで
sub render : ActionClass('RenderView'){}

sub end : Private{
	my ($self, $c) = @_;

	$c->forward('render');
	$c->res->content_type("text/html; charset=utf8");
}

とかしておけばOK。

2006.12.22

[ Catalyst]   Catalyst::Model::DBIC::Schemaでのトランザクション管理

以前

Catalyst::Model::DBIC::Plainでのトランザクション管理

というエントリーを書きました。
Catalyst::Model::DBIC::Plainってあたりが時代を感じさせます。

Cookbokにもありますが現在のDBIx::Classでトランザクションを管理する場合には$schema->txn_do($coderef)を使うとトランザクションの開始からコミット、ロールバックまでやってくれます。

my $schema = CD::Schema->connect(...);
$txn = sub {
    my $artist = $schema->resultset('Artists')->create(
        {
            name => $name,
        }
    );
    my $album = $schema->resultset('Albums')->create(
        {
            title => $title,
            artist => $artist->id,
        }
    );
}

eval { $schema->txn_do($txn); };

if ($@) {
    if ($@ =~ /Rollback failed/) {
        die "rollback failed: $@"
    }
    else {
        die "rollbacked: $@"
    }
}

Catalyst::Model::DBIC::Schemaで使うときには

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

    ...

    my $txn = sub {
        my $artist = $c->model('CD::Artists')->create(
            {
                name => $c->req->param('name'),
            }
        );
        my $album = $c->model('CD::Albums')->create(
            {
                title  => $c->req->param('title'),
                artist => $artist->id
            }
        );
    };
    $c->do_txn($c->model('CD'), $txn );

    eval { $c->model('CD')->schema->txn_do($txn); };
    if ($@) {
        if ( $@ =~ /rollback failed/ ) {
            $c->error("rollback failed: $@");
        }
        else {
            $c->error("rollbacked: $@");
        }
    }

    ...
}

これを毎回やるのは面倒です。

で、MLを見てたらMST曰く

[Catalyst] Best practice for using transactions?
You could always subclass Catalyst::Controller's _DISPATCH private  
action like

sub _DISPATCH {
   my $self = shift;
   my ($c) = @_;
   $c->model('DB')->schema->txn_do(
     sub {
       $self->next::method(@_);
     }
   );
}

つまり_DISPATCHメソッドをオーバーライドしたMyApp::Base::Controllerとか継承して全てのディスパッチに対してトランザクションを組んじゃえ・・・というとっても豪快な解がありました。

ボクの場合は局所的に使いたいのでプラグインを作ってこんな感じにしてます。

package MyApp::Plugin::Utils;

use strict;
use warnings;

sub do_txn {
    my ( $c, $model, $txn ) = @_;

    eval { $model->schema->txn_do($txn); };
    if ($@) {
        if ( $@ =~ /rollback failed/ ) {
            $c->error("rollback failed: $@");
        }
        else {
            $c->error("rollbacked: $@");
        }
    }
}

で、MyApp.pmでロード

package MyApp;

use strict;
use warnings;

use Catalyst::Runtime '5.70';

use Catalyst qw/
    -Debug
    Dumper
    StackTrace
    ConfigLoader
    Static::Simple
    +MyApp::Plugin::Utils
/;

...

で、コントローラでこんな感じ

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

    ...

    my $txn = sub {
        my $artist = $c->model('CD::Artists')->create(
            {
                name => $c->req->param('name'),
            }
        );
        my $album = $c->model('CD::Albums')->create(
            {
                title  => $c->req->param('title'),
                artist => $artist->id
            }
        );
    };
    $c->do_txn($c->model('CD'), $txn );

    ...
}

・・・あまり短くなってない orz
・・・けどエラー処理は一箇所にまとめられます。

もちろんInnoDBなどのトランザクション対応なデータベースエンジンを使わなければ意味はありません。

2006.12.06

[ Catalyst]   Chained ActionでスマートなURL

Chained Actionを使った例でこんな記事がありました。

/user/
    ユーザー一覧
/user/add
    ユーザー追加
/user/[ユーザー名]
    [ユーザー名]の詳細
/user/[ユーザー名]/edit
    [ユーザー名]の編集
/user/[ユーザー名]/delete
    [ユーザー名]の削除

というURL構成を再現するのに

package MyApp::Controller::User;

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

sub _parse_PathPrefix_attr {
    my ( $self, $c, $name, $value ) = @_;
    return PathPart => $self->path_prefix;
}

sub root : Chained('/') PathPrefix CaptureArgs(0) {
    my ( $self, $c ) = @_;
}

sub instance : Chained('root') PathPart('') CaptureArgs(1) {
    my ( $self, $c ) = @_;

    $c->stash->{user} = $c->req->captures->[0];
}

sub list : Chained('root') PathPart('') Args(0) {
    my ( $self, $c ) = @_;

    $c->res->body( ref($self) . '->list' );
}

sub add : Chained('root') PathPart Args(0) {
    my ( $self, $c ) = @_;

    $c->res->body( ref($self) . '->add' );
}

sub view : Chained('instance') PathPart('') Args(0) {
    my ( $self, $c ) = @_;

    my $user = $c->stash->{user};
    $c->res->body( ref($self) . "->view $user" );
}

sub edit : Chained('instance') PathPart Args(0) {
    my ( $self, $c ) = @_;

    my $user = $c->stash->{user};
    $c->res->body( ref($self) . "->edit $user" );
}

sub delete : Chained('instance') PathPart Args(0) {
    my ( $self, $c ) = @_;

    my $user = $c->stash->{user};
    $c->res->body( ref($self) . "->delete $user" );
}

1;

非常に便利。
肝は_parse_PathPrefix_attrでPathPrefixという独自アトリビュートを作ってpath_prefixにディスパッチするところ。

さらにこんなことをしたい場合は

/user/[ユーザー名]/bookmark
    [ユーザー名]のブックマーク一覧
/user/[ユーザー名]/bookmark/add
    [ユーザー名]のブックマーク追加
/user/[ユーザー名]/bookmark/[ブックマーク]
    [ユーザー名]のブックマーク[ブックマーク]の詳細
/user/[ユーザー名]/bookmark/[ブックマーク]/edit
    [ユーザー名]のブックマーク[ブックマーク]の編集
/user/[ユーザー名]/bookmark/[ブックマーク]/delete
    [ユーザー名]のブックマーク[ブックマーク]の削除

こうすればいいかと。

package MyApp::Controller::User::Bookmark;

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

sub root : Chained('/user/instance') PathPart('bookmark') CaptureArgs(0) {
    my ( $self, $c ) = @_;
}

sub instance : Chained('root') PathPart('') CaptureArgs(1) {
    my ( $self, $c ) = @_;

    $c->stash->{bookmark} = $c->req->captures->[1];
}

sub list : Chained('root') PathPart('') Args(0) {
    my ( $self, $c ) = @_;

    $c->res->body( ref($self) . '->list' );
}

sub add : Chained('root') PathPart Args(0) {
    my ( $self, $c ) = @_;

    $c->res->body( ref($self) . '->add' );
}

sub view : Chained('instance') PathPart('') Args(0) {
    my ( $self, $c ) = @_;

    my $user     = $c->stash->{user};
    my $bookmark = $c->stash->{bookmark};

    $c->res->body( ref($self) . "->view $user / $bookmark" );
}

sub edit : Chained('instance') PathPart Args(0) {
    my ( $self, $c ) = @_;

    my $user     = $c->stash->{user};
    my $bookmark = $c->stash->{bookmark};

    $c->res->body( ref($self) . "->edit $user / $bookmark" );
}

sub delete : Chained('instance') PathPart Args(0) {
    my ( $self, $c ) = @_;

    my $user     = $c->stash->{user};
    my $bookmark = $c->stash->{bookmark};

    $c->res->body( ref($self) . "->delete $user / $bookmark" );
}

1;

追記: typo訂正

2006.11.29

[ Catalyst]   使ってるCatalystのPlugins/Components

こんなエントリーがあったので進行中のプロジェクトで今のところ使ってるのを晒してみる。

Catalyst::Action::RenderView
Catalyst::Model::DBIC::Schema
Catalyst::View::TT::ForceUTF8
Catalyst::View::JSON
Catalyst::Plugin::Static::Simple
Catalyst::Plugin::ConfigLoader
Catalyst::Plugin::Dumper
Catalyst::Plugin::StackTrace
Catalyst::Plugin::Session::*
Catalyst::Plugin::Authentication::*
Catalyst::Plugin::FormValidator::Simple
Catalyst::Plugin::FormValidator::Simple::Auto
Catalyst::Plugin::RequestToken
Catalyst::Plugin::Unicode
Catalyst::Plugin::Captcha
Catalyst::Plugin::Email::Japanese

あと、オレオレだけど汎用的っぽいので
Catalyst::Plugin::FillInForm::ForceUTF8
Catalyst::Plugin::Session::DynamicExpiry::Cookie

C::P::FillInForm::ForceUTF8はHTML::FillInForm::ForceUTF8のラッパーかつ勝手にfillformしないやつ。
C::P::Session::DynamicExpiry::CookieはC::P::S::DynamicExpiryがcookieをうまく扱ってくれなかったので継承して実装。

てな感じです。

2006.11.16

[ Catalyst]   続 C::P::Email::Japaneseの文字化け対処

hide-k.net#blog: C::P::Email::Japaneseの文字化け対処
でWAVE DASH問題に何とか対応しようとしてMIME::TT::Lite::Japaneseに手を加えるというトンチンカンなことをやっていましたが、subtech - Bulknews::Subtech - cp932 vs. shift_jisEncode::Aliasを使えばいいんじゃないかというお話があったのでEncode::Unicode::Japaneseとからめて試してみました。

sub send : Private {
    use Encode::Alias;
    use Encode::Unicode::Japanese;

    define_alias( qr/jis$/i => '"unijp-jis"' );

    $c->email(
        Template => 'email.tt',
        To => $c->req->param('to'),
        From => $c->req->param('from'),
        Subject => $subject,
    );
}

でけた。
Encode::Alias知りませんでした。
これが正解な気がします。

2006.11.14

[ Catalyst]   C::P::Email::Japaneseの文字化け対処

正確には文字化けではないですね。
Catalyst::Plugin::Email::Japaneseを便利に使わせていただいていますが、~が\x{FF5E}で表示されるという報告があがりました。
いわゆるWIDE DASH - FULLWIDTH TILDE問題で、UTF8->ISO-2022-JPでマッピングないというやつです。

正直perl newbieで正解がよくわからんので、MIME::Lite::TT::Japaneseに手を入れるという暴挙にでました。
Lingua::JA::Mailのソースを参考に

sub remove_utf8_flag {
    my $str = shift;

    utf8::decode($str);
    $str =~ tr/\x{005C}\x{00A5}\x{2014}\x{203E}\x{2225}\x{FF0D}\x{FF5E}\x{FFE0}\x{FFE1}\x{
FFE2}/\x{FF3C}\x{FFE5}\x{2015}\x{FFE3}\x{2016}\x{2212}\x{301C}\x{00A2}\x{00A3}\x{00AC}/;

    return $str;
}

一応動くんだけど、正解はどーすればいいんだろか?

追記:
こんな正規表現使うよりもEncode::Unicode::Japanese使った方がよさげです。

追記:
Encode::Aliasを使ってMIME::Lite::TTに手を加えないもうちょっとましな方法があります。

2006.11.02

[ Catalyst]   C::P::ConfigLoaderでpath_toを指定する

C::P::FV::Simpleをmod_perlで動かすときの注意

これだとCatalystビルトインのサーバーで動かす分にはいいのですが、mod_perlで動かす場合にはフルパスで指定する必要があります。

とか言ってたのですがtypesterさんに

validator:
  profiles: __path_to(profiles.yml)__
  messages: __path_to(messages.yml)__

って書き方ができるというのを教えていただきました。
C::P::ConfigLoader->finalize_configで

s{__path_to\((.+)\)__}{ $c->path_to( split( '/', $1 ) ) }e;

って置き換えやってるんですね。
知りませんでした。

不勉強で大騒ぎしてごめんなさい。

2006.10.31

[ Catalyst]   C::P::FV::Simpleをmod_perlで動かすときの注意

Catalyst::Plugin::FormValidator::SimpleでmessagesのYAMLを指定する時やCatalyst::Plugin::FormValidator::Simple::AutoでprofilesのYAMLを指定するときに

__PACKAGE__->config(
	validator => {
    	messages => 'messages.yml',
	    profiles => 'profiles.yml',
},
);

てな風にします。

これだとCatalystビルトインのサーバーで動かす分にはいいのですが、mod_perlで動かす場合にはフルパスで指定する必要があります。

いちいち指定するのも面倒だしポータビリティもよろしくない気がするので

C::P::FV::Simpleは

if ( $setting && exists $setting->{messages} ) {
	FormValidator::Simple->set_messages( $self->path_to($setting->{messages}) );
}

C::P::FV::Simple::Autoは

my $profiles = eval {
	YAML::LoadFile( $c->path_to($c->config->{validator}->{profiles}) );
};

みたいに変更するといいかと思いますがいかがでしょう?
ただ、フルパスは指定できなくなりますね。

一応パッチ作っておきました。
Catalyst-Plugin-FormValidator-Simple.patch
Catalyst-Plugin-FormValidator-Simple-Auto.patch

追記:
C::P::FV::Sは0.11でパッチが採用されました。

追記:
typesterさんのコメントにあるとおり、これだとまずいのでここを参照してください。
ご迷惑をおかけしました。>lyokatoさん

2006.08.12

[ Catalyst]   C::P::Session::DynamicExpiryを使ってremember me

CatalystでSessionを使うときexpireが動的に変えれないのがナニなので、Catalyst::Plugin::Session::DynamicExpiryを無理やり最近のバージョンのC::P::Sessionで使えるよう実装しなおしてMLにポストしたらYavalがC::P::Sessionを書き直してまで実装してくれました。

Catalyst::Plugin::Session::DynamicExpiry 0.02

C::P::Session 0.11以上と一緒に動作します。"remember me"なんかでお得です。

使い方はMyAppで

use Catalyst  qw/
    Session::Dynamic::Expiry
    Session
    Session::Store::FastMmap
    Session::State::Cookie
    /;

として

sub foo {
	my ($self, $c) = @_;
	...
	if ($c->req->param('remeber')) {
		$c->session_time_to_live( 604800 );
	}
	...
}

とかすればOK。

ただ、cookieと一緒に使うときにconfigでcookie_expiresを直接設定してるとcookieのexpireだけ変更されません。

C::P::Session::State::Cookieのcalculate_session_cookie_expiresをオーバーライドしちゃダメ?と提案したのですが本人がcookie_expiresの実装が気に入ってないらしくあえなく却下されました。食い下がろうと思ったのですが、英語が苦手なのでスゴスゴ引き下がった次第です。

で、ボクなりの解決策としてはC::P::Session::DynamicExpiryを継承して

sub calculate_session_cookie_expires {
    my $c = shift;

    if ( defined(my $ttl = $c->session_time_to_live) ) {
        $c->log->debug("Overridden cookie time to live: $ttl") if $c->debug;
        return time() + $ttl;
    }

    return $c->NEXT::calculate_session_cookie_expires( @_ );
}

でオーバーライドしたのを使えばいいかなと。

ただ、expireを延長するときはいいのですが逆の場合、例えばsession cookie(ブラウザを閉じるまでのみ有効なcookie、つまりexpires = 0)に変更したい場合はダメですね。

$c->config->{session} = {
	expires			=> 3600,
	cookie_expires  => 0
}

とかしておいてsession_time_to_liveで延長する分には問題ないかと思われます。

2006.07.09

[ Catalyst]   Catalyst 5.7のインストール

Catalyst 5.7をまっさらなFedora 5にインストールしたのでその顛末をメモ。

通常のFedora 5に開発パッケージを追加した程度ではこんな感じにCPANモジュールがプリインストールされていました。

で、ここを見ながら以下の手順でCatalystの開発環境を簡単にインストールできました。

Bundle::CPAN' でBundle::CPANをインストール
perl -MCPAN -e 'install Bundle::CPAN'
ここからcat-installスクリプトを持ってきて実行
wget http://www.shadowcatsystems.co.uk/static/cat-install
perl cat-install
Module::Pluggable::Fastを入れておかないとCatalyst::Plugin::ConfigLoaderのテストでこけるのでいれておく
perl -MCPAN -e 'install Module::Pluggable::Fast'
最後にCatalyst::Develのインストール
perl -MCPAN -e 'install Catalyst::Devel'

途中の質問には全てyで答えて、とりあえず動くようにはなりました。

とはいえこれだけだと最低限の環境なのでC::V::TTやC::M::DBIC::SchemaやC::P::Sessionなんかの他のプラグインはそれぞれ別にインストールする必要があります。

[ Catalyst]   Catalyst 5.7000 is released

Catalyst 5.7000がリリースされました。

Catalyst 5.7000 release announcement - Random thoughts from the mind of Marcus Ramberg
The Catalyst Core Team is proud to announce that we've just shipped the next major release of the Catalyst framework, version 5.7000. This release is the result of the helpful contributions of a large number of people, both on the documentation and people submitting patches and ideas for improvements. We would like to use this opportunity to thank them for their great work. Catalyst would be much worse of without you guys. Hope you will continue to make us great.

便利そうな追加機能は
Catalyst::Action
Catalyst::DispatchType::Chained

また、パッケージ構成もCatalyst::RuntimeCatalyst::Develに分けられました。JavaでいうとこのJREとJDKの関係を目指してるのでしょうか。
ぱっと見ですが、今のところはCatalyst::RuntimeにCatalystが含まれてCatalyst::HelperなんかだけがCatalyst::Develに移されているようです。

あと、ドキュメントがものすごい勢いで充実してるので是非一読あれ。

2006.05.17

[ Catalyst]   C::V::GD::Barcode::QRcodeリリース

CatalystでQRコードを生成するCatalyst::View::GD::Barcode::QRcodeを作ったのでCPANにあげておきました。

名前が長いのがアレですね。

要はGD::Barcode::QRcodeに処理を渡しているだけです。

./script/myapp_create.pl view QRcode GD::Barcode::QRcode

とかやってViewを作ってコントローラで

sub qrcode : Private {
    my ( $self, $c 0 = @_;
    my $url = $c->req->param('url')
    $c->stash(qrcode => $url);
    $c->forward( $c->view( 'QRcode' ) );
}

とかやってサーバーあげてブラウザから

http://localhost:3000/qrcode?url=http://blog.hide-k.net/

にアクセスすればQRコードが見れます。

ところで、まともなHelperを初めて書いたんだけどPODがおかしいですね。
どこがおかしいんだべさ・・・

2006.05.12

[ Catalyst]   C::P::DefaultEndとC::P::FillInFormの共存

Catalyst::Plugin::DefaultEndを使ってみる - hide-k.net#blog
Catalyst::Response->redirect()のメモで$c->redirectが呼ばれた後もend : Privateが実行されるため、templateが指定されていないと怒られることへの対処を書いたのですが、MLでDefaultEndプラグインを使うといいよとあったので使ってみました。

と、とってもお手軽なCatalyst::Plugin::DefaultEndですが、Catalyst::Plugin::FillInFormと同時に使おうとすると問題があります。

Catalyst::Plugin::FillInFormを使うときの注意点 - hide-k.net#blog
$c->forward('CD::V::TT')の後に呼ぶ必要があるみたいです。

つまりDefaultEndを使っているときに明示的にfillformメソッドを呼びたい時に

sub hoge : Local {
    my ( $self, $c ) = @_;
    
    $c->stash( template => 'hoge.tt');
    $c->fillform;
}

としてもfillformしてくれません。

なのでMyApp.pmで

use Catalyst qw/FillForm DefaultEnd/;
...
sub end : Private {
    my ( $self, $c ) = @_;

    $self->NEXT::end($c);
    $c->fillform if $c->stash->{fillform};
}

として明示的にfillformしたいところで

sub hoge : Local {
    my ( $self, $c ) = @_;
    
    $c->stash ( template => 'hoge.tt', fillform => 1 );
}

とするといい感じです。

気をつける点はMyApp::Controller::RootのendではなくMyAppのendに実装しなければ動かないです。
かなりはまりました。

2006.05.02

[ Catalyst]   Catalyst開発チームの再編成

ここんとこ多忙でMLを追っていなかったのですが、Catalystの開発チームの再編成が行われたようです。

[ANNOUNCE] Changes to the Catalyst Project

気になったのは

Sebastian Riedel has chosen to step down from the core development team,
and will no longer be involved in the development of the Catalyst
core distribution, or in the general technical planning for the
Catalyst Web Framework.

While a few specific plugins will be passed to the core team, he has a
number of plugins he will continue to maintain and develop. He will still
be around in IRC and on the mailing lists, and will continue to remain
involved with Catalyst generally.

Sebastian will be creating a new separate framework, currently codenamed
"Woodstock", which will be a ground-up reimplementation of a Catalyst-like
framework. He will use Woodstock to explore new concepts relating to web
MVC-style systems.

Woodstock will be announced properly on this list by Sebastian in a few
weeks.

ということで、Sebastian Riedel氏がコア開発メンバーから抜けて新しくWoodstockなるフレームワークをリリースするということらしいです。

またフレームワークですか・・・追っかけるの大変・・・orz

2006.04.21

[ Catalyst]   Root controllerで/アクション

何気なくCatalystを更新して新しくアプリケーションを書こうとしたんですけど、MyApp.pmに default アクションを追加しても反映されないのでなんでかなと。

よくよく見てみるとMyApp::Controller::Rootなるコントローラが生成されていて、どうやらここに書くように変わったようです。

Changes
5.66 2006-03-10 17:48:00
- Added Test::WWW::Mechanize::Catalyst support
- Cleaned generated tests
- Added Root controller concept
- Updated ConfigLoader plugin to version 0.04

ちなみにMyAppとMyApp::Controller::Root両方に hoge : Local アクションがあった場合はMyApp::Controller::Rootが優先されるようです。

CatalystもDBIx::Classも便利なのですが、ころころ仕様が変わるのでキャッチアップが大変です。

Catalyst再入門でも書こうかしらと思う今日この頃。

2006.02.18

[ Catalyst]   Catalyst::Plugin::Dumper

Catalystでアプリケーションを作っている時にdebugで

use Data::Dumper;
...

$c->log->debug(Dumper($hoge)) if $c->debug;

なんてことをやってるわけですが、非常に面倒です。
どうにかならんかねと思ってて見つけたのがCatalyst::Plugin::Dumperです。

MyApp.pmで
use Catalyst qw/-Debug Dumper/

としておいて使う時には

$c->log->dumper($hoge) if $c->debug;

でOK。大変便利です。

[ Catalyst]   C::P::Authentication::Store::DBICをSchemaベースに対応してみる

ここでも書いたとおり、Catalyst::Plugin::Authentication::Store::DBICCatalyst::Model::DBIC::SchemaのSchmaに対応してません。パッチをつくり中ってことなんですが、ボランティアの人が忙しいらしく一向に公開されません。

というわけで、お手軽対応してみました。(Role関係は個人的に使ってないので動かないかもです。)

__PACKAGE__->config->{authentication}->{dbic} = {
  user_class         => 'MyApp::Model::Account::User',
  user_field         => 'username',
  password_field     => 'password',
  password_type      => 'hashed',
  password_hash_type => 'SHA-1',
};

の場合

__PACKAGE__->config->{authentication}->{dbic} = {
  schema_class       => 'Account',
  user_class         => 'User',
  user_field         => 'username',
  password_field     => 'password',
  password_type      => 'hashed',
  password_hash_type => 'SHA-1',
};

な感じで動いてます。

要はUser.pmで
    my $user_class = $config->{auth}->{schema_class}
    ? $c->model($config->{auth}->{schema_class})->resultset($config->{auth}->{user_class})
    : $config->{auth}->{user_class};

にしてるだけで、そのためにcontextをBackend.pmから渡すようにしてあげてるだけです。

手抜きです。

2006.02.14

[ Catalyst]   Catalyst::Model::DBIC::Schemaを使ってみた

Catalyst::Model::DBIC::Schemaを使ってみました。
DBIx::Classで新しくなったSchemaモデルをCatalystのModelとして使うクラスなのですが、今までのModelと大きく違うのはモデルをアプリケーションの外に追い出すことが出来る点です。
例えば、複数のアプリケーションで認証情報を使いまわしたい時には便利かと思われます。

まずはスキーマを作ります。(Perl/DBIC - Nekokak's core dumpに大変わかりやすい説明があります。)

Schema/
	Account.pm
	Account/
		Users.pm
Schema/Account.pm
package Schema::Account;

use strict;
use warnings;
use base 'DBIx::Class::Schema';

__PACKAGE__->load_classes();

1;
Schema/Account/Users.pm
package Schema::Account::Users;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components(qw/ PK::Auto::MySQL Core/);
__PACKAGE__->table('users');
__PACKAGE__->add_columns(qw/id username password email/);
__PACKAGE__->set_primary_key('id');

1;

このスキーマをMyApp1とMyApp2で使いまわすことにします。

MyApp1
	Contoller
	Model
		Account.pm
	View

MyApp1
	Contoller
	Model
		Account.pm
	View

MyApp1とMyApp2でModelクラスを作ります。

# script/myapp1_create.pl model Account DBIC::Schema Schema::Account dbi:mysq:account user passwd

Account - クラス名
DBIC::Schema - Modelの指定
Schema::Account - Schemaクラス

以下のようなクラスが生成されます。

MyApp1/Model/Account.pm
package MyApp1::Model::Account;

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config(
    schema_class => 'Schema::Account',
    
    connect_info => [ 'dbi:mysql:account',
                      'user',
                      'passwd',
                      {
                          RaiseError         => 1,
                          PrintError         => 0,
                          ShowErrorStatement => 1,
                          TraceLevel         => 0,
                          AutoCommit         => 1,
                      }
                    ],
    
);
1;

使うときは

$c->model('Account')->resultset('Users')

さらに便利なのは

$c->mode('Account::Users')

でSchemaモデルが使えます。

もちろん実際に動かす時にはSchemaクラスはクラスパスが通るところにある必要があります。

と、とっても便利なC::M::DBIC::Schemaなんですが、既存のプラグインとあまり相性がよくありません。
特にC::P::Authentication::Store::DBICは全く動かなくなるので注意です。(今、パッチが作られているみたいです。)

2006.01.25

[ Catalyst]   Catalyst::Plugin::DefaultEndを使ってみる

Catalyst::Response->redirect()のメモで$c->redirectが呼ばれた後もend : Privateが実行されるため、templateが指定されていないと怒られることへの対処を書いたのですが、MLでDefaultEndプラグインを使うといいよとあったので使ってみました。

package MyApp;

use strict;
use warnings;

use Catalyst qw/
    -Debug
    DefaultEnd
/;

our $VERSION = '0.01';

__PACKAGE__->config->{view} = 'TT';
__PACKAGE__->setup;

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

    $c->response->redirect('http://www.yahoo.co.jp/');
}

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

    $c->stash->{template} = 'templates/hello.html';
}

1;
これだけで
  1. debugモードかつrequestにdump_infoが設定されていない
  2. エラーがない
  3. Statusが3xx(リダイレクト)が指定されていない
  4. $c->response->bodyに何も書かれていない
  5. $c->config->{view}が指定されている
場合にのみtemplateがレンダリングされます。

前から知ってたけどいざ使ってみるとお手軽で便利なプラグインです。

2006.01.20

[ Catalyst]   Catalyst::Response->redirect()のメモ

Catalyst::Response->redirect()でちょっとはまったのでメモ。

response->redirectの時点でクライアントにredirectレスポンスが帰って処理が終わると勝手に解釈してたためにはまりました。

例えば

a : Global {
    my ( $self, $c ) = @_;

    $c->res->redirect($c->uri_for('/'));
    $c->log->debug('after redirect'); #ここも実行される
}

さらに end : Privateまで呼ばれるため

sub end : Private {
    my ( $self, $c ) = @_;
    
    $c->forward( $c->view('TT') ) 
    	unless ($c->response->body);
}

なんてやってたらtemplateが指定されてないよ、と起こられてしまいます。

なので

a : Global {
    my ( $self, $c ) = @_;
	
    $c->res->redirect($c->uri_for('/'));
    return;
    $c->log->debug('after redirect'); #ここは実行されない
}

sub end : Private {
    my ( $self, $c ) = @_;
    $c->forward( $c->view('TT') ) 
    	unless ($c->response->body || !$c->stash->{template});
}

としておく必要があるみたいです。

2005.11.22

[ Catalyst]   CatalystのテストサーバーでIEを使ってテストするときの注意

最近猛烈な勢いでアップデートされているCatalystですが、いつのバージョンの頃からかCatalystのテストHTTPDにIEでPOSTアクセスすると何も表示されないという不具合があって困ってました。Fire Foxでは問題ないけどなぜかIEでPOSTの時だけダメだったんですね。

が、5.57で取りあえず解決してるみたいです。

[Catalyst] Catalyst/Internet Explorer strangeness
> I&#