catalyst.perl.kmtz.net

Catalyst::Plugin::Authentication 0.10002 と Catalyst::Plugin::Session 0.17 にアップデートしたら、セッションIDをクッキーに保存したままブラウザを閉じて、しばらくたってからアクセスすると、$c->user_exists は1(真)を返すのに、$c->user が undefined になって取得できなくなる事象が頻発。一度ログアウトしてログインしなおさないと直らない。

再現条件すら確認中だから、本当にモジュールのせいか不明だけど致命的だ。。。

リクエスト毎に出力の文字コードを変換するプラグインを Catalyst::Plugin::Unicode::Encoding を元に作成してみた。下の例だと、shiftjis と utf8 のみに対応するが、$c->config から読み込むようにも簡単に変更可能。

package Catalyst::Plugin::Private::Unicode::Encoding;

use strict;
use warnings;
use Encode 2.10 ();
use Encode::Guess qw(utf8 shiftjis);

our $VERSION = 0.01;
our $CHECK   = Encode::FB_CROAK | Encode::LEAVE_SRC;

sub finalize {
    my $c = shift;

    unless ( $c->res->body ) {
        return $c->NEXT::finalize;
    }

    unless ( $c->res->content_type =~ /^text|xml$|javascript$/ ) {
        return $c->NEXT::finalize;
    }

    unless ( Encode::is_utf8( $c->res->body ) ) {
        return $c->NEXT::finalize;
    }

    unless ( ref $c->stash->{'encoding'} ) {
        unless ( $c->stash->{'encoding'} =
            Encode::find_encoding( $c->stash->{'encoding'} ) )
        {
            $c->stash->{'encoding'} = Encode::find_encoding('utf8');
        }
        $c->log->debug( 'changed:' . $c->stash->{'encoding'}->mime_name );
    }
    $c->log->debug( 'out:' . $c->stash->{'encoding'}->mime_name );
    $c->res->body( $c->stash->{'encoding'}->encode( $c->res->body, $CHECK ) );

    $c->NEXT::finalize;
}

sub prepare_parameters {
    my $c = shift;

    $c->NEXT::prepare_parameters;

    my $str;
    for my $value ( values %{ $c->req->params } ) {
        $str .= $_ for ( ref($value) ? @{$value} : $value );
    }
    my $decoder;
    if ($str) {
        eval {
            $decoder =
              Encode::Guess->guess_encoding( $str, qw(utf8 shiftjis) );
        };
        $decoder = Encode::find_encoding('utf8') unless ($decoder);
        for my $value ( values %{ $c->req->params } ) {
            next
              if ( ref $value && ref $value ne 'ARRAY' );
            for ( ref($value) ? @{$value} : $value ) {
                $_ = $decoder->decode( $_, $CHECK );
            }
        }
    }
    else {
        $decoder = Encode::find_encoding('utf8');
    }
    $c->stash->{'encoding'} = $decoder;
    $c->log->debug( 'in:' . $c->stash->{'encoding'}->mime_name );
}

1;

__END__

コントローラの中で、

$c->stash->{'encoding'} = 'shiftjis';
# or
$c->stash->{'encoding'} = 'utf8';

のように指定するとその文字コードで出力する。テンプレートは全て utf8 で記述することを想定。ちなみに、使用される文字コードのルールは下のような感じ。

１．リクエスト時にフォーム等でパラメータが渡されている場合は、パラメータの文字コードを自動判別して utf8 に変換してからコントローラに渡す。（コントローラでは従来どおり $c->req->param でアクセス）

２．レスポンスの内容を utf8 から指定の文字コードに変換して出力する。文字コードは $c->stash->{'encoding'} で指定されていればそれを使い、なければ１の処理に使った文字コードを使用し、１の際にパラメータがなく判別されなかった場合には utf8 が使用される。

携帯のキャリア判定を行って出力の文字エンコードを変更するなんてことはよくあるんじゃないかと思うけど、イマイチやり方がわからない。

最初はテンプレートは全て utf8 なので、Catalyst::Plugin::Unicode::Encoding でできるのかなと思った。このプラグインだと、myapp.yml の中に encoding を設定しておくと変換して出力してくれる。だが、コントローラで携帯のキャリア判定をして、そこで動的に文字コードを指定しようと思うとできなさげ。

実際に Catalyst::Plugin::Unicode::Encoding のソースコードを読むと、sub encoding の中で ref($c) で処理が分岐していて、MyApp->setup から sub setup 経由で呼ばれた場合と、Catalyst::Plugin::Unicode::Encoding->encoding と直接呼ばれた場合の両方に対応しようという意図が見える(気がする)。

前者と後者で $c が別物なのでわかりにくいが、前者ではエンコード情報を Catalyst->{'encoding'} に格納し、後者では Catalyst::Plugin::Unicode::Encoding::_encoding に格納しているように読める。しかし、sub finalize の中では Catalyst->{'encoding'} しか見ていない。だから、Catalyst::Plugin::Unicode::Encoding->encoding で設定しても無視されるようだ。

ためしに、sub finalize の中で

$c->log->debug(__PACKAGE__->_encoding->mime_name);

$c->log->debug($c->encoding->mime_name);

とやると、前者が Shift_JIS と表示しても、後者は UTF-8 だったりする。

そこで、下記のように変えてみた

     unless ( Encode::is_utf8( $c->response->body ) ) {
         return $c->NEXT::finalize;
     }
-    $c->response->body( $c->encoding->encode( $c->response->body, $CHECK ) );
+    my $encoding = __PACKAGE__->_encoding || $c->encoding;
+    $c->response->body( $encoding->encode( $c->response->body, $CHECK ) );
+    __PACKAGE__->_encoding('');

     $c->NEXT::finalize;
 }

これでうまくいったように一瞬思えた。

しかし、Catalyst::Plugin::Unicode::Encoding は sub prepare_parameters でも設定された文字コードとして、HTTPで渡されてたパラメータを utf8 フラグ付きの文字列に変換している。この部分は finalize と違ってコントローラが受け取る前に処理してしまうので、キャリア判定後なんてことは原理的に不可能に思える。そうなると文字コードを推測するようにするしかないのかな？

というわけで、同じような要件をクリアされた方がいらっしゃったら解決方法もしくはアドバイスをいただきたく。

全然勘違いなこと言っているよという指摘でもありがたいです。

ちなみに、上記 diff の最後の __PACKAGE__->_encoding(''); は mod_perl 環境下なので、Catalyst::Plugin::Unicode::Encoding->encoding を一度どれかのリクエストの際に呼び出すと、以降のリクエストでは、同様に上書きするまでデフォルトの設定ではなく Catalyst::Plugin::Unicode::Encoding->encoding の設定が共有されてしまうのを防ぐため。ただ、場合によっては初期化前に別のリクエストが finalize フェーズを通過する場合も考えられるので、そもそもクラス変数を使うことが間違い？(意図が違う？)

（追記5/19）とりあえず書いてみた。

http://catalyst.g.hatena.ne.jp/yosty/20070519

Catalyst::Model::CDBI::Sweet を使っていて、Class::DBI::utf8 を併用したら、Class::DBI::utf8 が Class::DBI::Search::Basic の _search_for を使うせいか、SQL::Abstract の -or 等を利用した複雑なクエリが書けなくなっている気がする。（詳細を確認しきれていないけど）

Catalyst - Caught exception in Calendar::Controller::Service->events "-or is not a column of Calendar::Model::CDBI::Events at /usr/lib/perl5/site_perl/5.8.5/Class/DBI/Search/Basic.pm line 115

というわけであとで調べるそろそろ本気でDBIC。

Catalyst::View::TT + Catalyst::Plugin::FillInForm + Catalyst::Plugin::FormValidator::Simple から、Catalyst::Controller::FormBuilder に乗り換えを検討してみたけど、下あたりを見てとりあえず延期ｗ

http://catalyst.g.hatena.ne.jp/tokuhirom/20061129/1164765429

http://catalyst.g.hatena.ne.jp/ikasam_a/20061130/1164842382

http://blog.hide-k.net/archives/2006/11/catalystplugins.php

Catalyst::Plugin::Authentication::Store::DBIC を利用して認証していて、ユーザのレコードが下みたいな感じだった場合、

{ 
  id   =>  1,
  name =>  'username',
  password => 'password',
  age  => 27,
  type =>  'a'
}

$user->age や $user->type とはできるが、$user->id ではなく $user->obj->id としないといけない。

ほげーと思って、Catalyst::Plugin::Authentication::Store::DBIC::User のソースを確認したところ、

sub new {
    my ( $class, $id, $config ) = @_;

    my $query = @{$config->{auth}{user_field}} > 1
        ? { -or => [ map { { $_ => $id } } @{$config->{auth}{user_field}} ] }
        : { $config->{auth}{user_field}[0] => $id };

    my $user_obj = $config->{auth}{user_class}->search($query)->first;
    return unless $user_obj;

    bless {
        id     => $id,
        config => $config,
        obj    => $user_obj,
    }, $class;
}

*user = \&obj;

ということは、id と config と obj だけが、obj を経由しなくても $user_obj のメソッドにアクセスできるってことかな。型グロブに代入しても上書きはされないのかな？このあたりの理解がたりないなー。ラクダ本。。。

Catalyst::Plugin::Dumper は $c->log->dumper で Data::Dumper::dumper を呼び出せるだけのシンプルなモジュールだけど、使いたいときに毎度 use しなくていいので開発中はだいたい組み込んでる。

でも、Catalyst::Plugin::Dumper は dumper メソッドを Catalyst::Log::dumper とハードコードしているので、Catalyst::Log::Log4perl を併用すると下記のようなエラーをはいてしまう。きっと Catalyst::Plugin::Log::Dispatch とか $c->log を置き換えるプラグインでも同じようなエラーになるはず。

Caught exception in MyApp::Controller::Member->main "Can't locate object method "dumper" via package "Catalyst::Log::Log4perl"

とりあえず、Catalyst::Log::dumper を Catalyst::Log::Log4perl::dumper に書き換えて使うと動作するが、もう少し汎用性を持たせるために 0.02 にパッチを書いてみた。

*** Dumper.pm   2006-01-16 20:46:36.000000000 +0900
--- Dumper.pm.new       2007-04-10 23:54:52.000000000 +0900
***************
*** 10,26 ****
  use Data::Dumper;
  $Data::Dumper::Sortkeys = 1;

! sub Catalyst::Log::dumper {
!   my ($self, $var, $label) = @_;

!   if (defined $label) {
!       # temporarily change the Varname that D::D uses
!       local $Data::Dumper::Varname = $label;
!       $self->debug( Dumper($var) );
!   }
!   else {
!       $self->debug( Dumper($var) );
!   }
  }

  1; # Magic true value required at end of module
--- 10,33 ----
  use Data::Dumper;
  $Data::Dumper::Sortkeys = 1;

! sub setup {
!     my $class = shift;

!     $class->NEXT::setup();
!     eval( sprintf( <<'    EOL', ref $class->log ) );
!         sub %s::dumper {
!             my ( $self, $var, $label ) = @_;
!
!             if ( defined $label ) {
!                 # temporarily change the Varname that D::D uses
!                 local $Data::Dumper::Varname = $label;
!                 $self->debug( Dumper($var) );
!             }
!             else {
!                 $self->debug( Dumper($var) );
!             }
!         }
!     EOL
  }

  1; # Magic true value required at end of module

ついでに、つたない英語で bug と patch を報告。

http://rt.cpan.org//Ticket/Display.html?id=26233

Catalyst::Log::Log4perl を使う場合には Catalyst->log() を Catalyst->setup() の前に呼ぶ必要がある。（そうじゃなくてもこの順番だけど）

他に、Catalyst::Plugin::Log::Dispatch を使う場合には use Catalyst qw/Log::Dispatch Dumper/; のように Dumper を後に記述する必要がある。

eval と sprintf なんて綺麗じゃない気もするけど...

JavaScript みたいに $class.prototype.dumper = function() {} ってプロトタイプベースで書く方法ってあるのかな？

Catalyst::Plugin::Email::Japanese を使っていると、経験上60%くらいの高確率でテンプレートファイルが見つからなくて Exception を吐いてしまう現象に困っていた。エラーページをよく見ると Catalyst::Plugin::Email::Japanese の config で INCLUDE_PATH が 空になっている。

モジュールの不具合なんじゃないかなと思いつつ追えていなかったけど、fix されました。

Catalyst::Plugin::Email::Japanese - Changes

http://search.cpan.org/src/TYPESTER/Catalyst-Plugin-Email-Japanese-0.07/Changes

Revision history for Perl module Catalyst::Plugin::Email::Japanese

0.07 2007-04-07T17:51:34+09:00
     - fixed a bug deleting original INCLUDE_PATH config

というわけで快調。