2008-03-05 22:25:06

Catalyst::Plugin::Authentication 新版

[ Catalyst ]

知らなかった
ex) http://catalyst.g.hatena.ne.jp/lapis25/20070806
ex) http://search.cpan.org/~jayk/Catalyst-Plugin-Authentication/
試してみる
$ vim lib/MyApp.pm

use Catalyst qw/
       (略)
       Authentication
       Authentication::Store::DBIC
       Authentication::Credential::Password
       /;

use Catalyst qw/
        (略)
        Authentication
        /;

$ vim myapp.yml

authentication:
  dbic:
    user_class: MyAppDB::User
    user_field: email
    password_field: password

authentication:
  default_realm: members
  realms:
    members:
      credential:
        class: Password
        password_field: password
        password_type: clear
      store:
        class: DBIx::Class
        user_class: MyAppDB::User
        id_field: email

$ vim lib/MyApp/Controller/Auth.pm

if ($c->login($c->stash->{email}, $password)) {
    $c->res->redirect( $c->req->{uri} );
}

if ($c->authenticate({email => $c->stash->{email}, password => $password})) {
    $c->res->redirect( $c->req->{uri} );
}

嬉しいこと。
こういうテーブルの時

+------------------+--------------+------+-----+-------------------+----------------+
| Field            | Type         | Null | Key | Default           | Extra          |
+------------------+--------------+------+-----+-------------------+----------------+
| id               | int(11)      | NO   | PRI | NULL              | auto_increment |
| email            | varchar(255) | NO   |     |                   |                |
| password         | varchar(255) | NO   |     |                   |                |
+------------------+--------------+------+-----+-------------------+----------------+
email と password で認証すると、以前は Catalyst::Plugin::Authentication::User の為 $c->user->id に email の値が入ってしまっていて不便だった。

今はテーブルの id が入るようになった!

同一アプリケーションで認証を複数別々に使う場合
$ vim myapp.yml

authentication:
  default_realm: bluegroup
  realms:
    bluegroup:
      credential:
        class: Password
        password_field: password
        password_type: clear
      store:
        class: DBIx::Class
        user_class: MyAppDB::Blue
        id_field: email
    redgroup:
      credential:    #bluegroupとは異なるcredentialと内容が使える
        class: Password
        password_field: password
        password_type: clear
      store:    #bluegroupとは異なるstoreと内容が使える
        class: DBIx::Class
        user_class: MyAppDB::Red
        id_field: nickname

$ vim lib/MyApp/Controller/Auth.pm
#デフォルト(bluegroup)の場合は
if ($c->authenticate({email => $c->stash->{email}, password => $password})) {
    $c->res->redirect( $c->req->{uri} );
}
#デフォルトじゃない(redgroup)場合は
if ($c->authenticate({nickname => $c->stash->{nickname}, password => $password},'redgroup')) {
    $c->res->redirect( $c->req->{uri} );
}

if (!$c->user_exists or ( $c->user->get('hoge') ne $c->stash->{hoge}) ) {
    $c->detach('login');
}
のように $c->user_exists プラスアルファで認証確認

2008-03-05 22:21:07

取得してないフォームパラメータを追加する

[ Catalyst ]

ex) http://search.cpan.org/~mramberg/Catalyst-Runtime-5.7012/lib/Catalyst/Request.pm#$req->param
$c->request->parameters->{name} = 'hoge';
or
$c->req->params->{name} = 'hoge';
or
$c->req->param('name','hoge');

2008-03-05 22:19:57

Catalyst::Plugin::Unicode の中身

[ Catalyst ]

フォーム入力時、UTF8フラグをつける(utf8::decode)
HTML出力時、UTF8フラグを全て落とす(utf8::encode)

package Catalyst::Plugin::Unicode;
use strict;
our $VERSION = '0.8';
sub finalize {
    my $c = shift; 
    if ( $c->response->{body} && utf8::is_utf8($c->response->{body}) ){
        utf8::encode( $c->response->{body} );
    }
    return $c->NEXT::finalize;
}
sub prepare_parameters {
    my $c = shift;
    $c->NEXT::prepare_parameters;
    for my $value ( values %{ $c->request->{parameters} } ) {
        if ( ref $value && ref $value ne 'ARRAY' ) {
            next;
        }
        utf8::decode($_) for ( ref($value) ? @{$value} : $value );
    }
}
1;

2008-03-05 22:12:08

Perl5.10 で Catalyst

[ Catalyst ]

Fedora7(i386)環境

Catalyst::Plugin::FormValidator::Simple
絡みの
FormValidator::Simple::Plugin::Japanese
から
Unicode-RecursiveDowngrade-0.03
を入れるときにエラーとなる

パッチあてる
--- Unicode-RecursiveDowngrade-0.03/lib/Unicode/RecursiveDowngrade.pm
+++ Unicode-RecursiveDowngrade-new/lib/Unicode/RecursiveDowngrade.pm
@@ -2,6 +2,7 @@
 
 use strict;
 use Carp;
+use bytes;
 use vars qw($DowngradeFunc $VERSION);
 $VERSION = 0.03;

2008-03-07 0:16追記
作者の方にお送りした patch を適用していただいた → Unicode-RecursiveDowngrade-0.04
よって今後、上記記述は無視


FormValidator-Simple-Plugin-Number-Phone-JP
は結構前(Number-Phone-JP-0.10 ~)からエラーとなる
テストパターンが古いためなので気にせずforce install
or
パッチあてる
--- FormValidator-Simple-Plugin-Number-Phone-JP-0.02/t/01_number_phone_jp.t
+++ FormValidator-Simple-Plugin-Number-Phone-JP-new/t/01_number_phone_jp.t
@@ -28,29 +28,29 @@
 }
 
 __DATA__
-011 1234567
-0164 123456
-01646 12345
-01652 12345
-016528 1234
-01653 12345
-016532 1234
-016534 1234
-03 12345678
-04 12345678
-06 12345678
-0460 12345
-0578 12345
-011 123456
-0164 12345
-01646 1234
-01652 1234
-016528 123
-01653 1234
-016532 123
-016534 123
-03 1234567
-04 1234567
-06 1234567
-0460 123456
-0578 123456
+001 12345678
+009120 12345678
+0120 000123
+011 2001234
+050 10001234
+080 10012345
+020 46012345
+070 50112345
+0990 500123
+0570 000123
+060 33001234
+0255 731234
+096 3471234
+00299 12345678
+009197 12345678
+0800 9231234
+0997 711234
+050 99991234
+080 99912345
+020 49812345
+070 68912345
+0570 998123
+060 49991234
+06 43391234
+0778 891234
+0997 381234

2008-03-10 0:00追記
作者の方にお送りした patch を適用していただいた → FormValidator-Simple-Plugin-Number-Phone-JP-0.03
よって今後、上記記述は無視

他は普通に入った。

2008-03-05 22:07:23

CatalystアプリケーションのUnicode化2

[ Catalyst ] [ DBIx::Class ] [ MySQL ]

・FillInForm安全対策

cpan[1]> install Catalyst::Plugin::FillInForm::ForceUTF8
ex) http://blog.hide-k.net/archives/2007/03/catalyst_2.php
※Catalyst::Plugin::FillInForm だと Catalyst::Plugin::Unicode の前にロードする必要があり、多分いつかハマるのでNG

・DBIx::Class で mysql 使う時

方法1 - DBD::mysql のオプションを使う
(http://search.cpan.org/~capttofu/DBD-mysql-4.006/lib/DBD/mysql.pm)
$ vim lib/MyApp/Model/MyAppDB.pm

package MyApp::Model::MyAppDB;
use strict;
use base 'Catalyst::Model::DBIC::Schema';
__PACKAGE__->config(
    schema_class => 'MyApp::Schema',
    connect_info => [
        'dbi:mysql:myappdb',
        'user',
        'password',
        {
            mysql_enable_utf8 => 1
        }
    ],
);
1;

方法2 - DBIx::Class::UTF8Columns を使う
(http://search.cpan.org/~jrobinson/DBIx-Class-0.08009/lib/DBIx/Class/UTF8Columns.pm)
$ vim lib/MyApp/Schema/Hoge.pm

package MyApp::Schema::Hoge;
use strict;
use warnings;
use base 'DBIx::Class';
__PACKAGE__->load_components(qw/UTF8Columns Core/);
__PACKAGE__->table("tag");
__PACKAGE__->add_columns(
  "shop",
  { data_type => "INT", default_value => "", is_nullable => 0, size => 11 },
  "id",
  { data_type => "SMALLINT", default_value => "", is_nullable => 0, size => 5 },
  "name",
  { data_type => "VARCHAR", default_value => "", is_nullable => 0, size => 255 },
);
__PACKAGE__->set_primary_key("shop", "id");
__PACKAGE__->utf8_columns(qw/name/);    #static で作った場合、add_columns の後に記述すること
1;

どちらでもフラグ付きで放り込んで、フラグ付きで取り出せる。
もちろんmysqlでも普通に見える。
備考:方法1のほうが便利・・・しかし
This option is experimental and may change in future versions.
ex) http://search.cpan.org/~capttofu/DBD-mysql-4.006/lib/DBD/mysql.pm

さらに参考
http://search.cpan.org/~cfranks/HTML-FormFu-0.02004/lib/HTML/FormFu/Manual/Unicode.pod

2008-03-05 22:00:31

DBICでMySQLのtimestamp

[ Catalyst ] [ DBIx::Class ] [ MySQL ]

TIMESTAMP型のカラムは CatalystのHelperでスキーマを作ると

  "time",
  {
    data_type => "TIMESTAMP",
    default_value => "CURRENT_TIMESTAMP",
    is_nullable => 0,
    size => 14,
  },

こんなのができる。
insert や他のカラムをupdateすると現在時刻が入る。

意識的に入れるときは undef を入れる。
$c->model('MyAppDB::Hoge')->update_or_create({
    time => undef,
});

Fedora-7,MySQL-5.0.41,DBIC-0.08009,Perl-5.10.0

2008-03-05 21:48:44

Catalystテストサーバでの DBICのSQLログ表示

[ Catalyst ] [ DBIx::Class ]

一時的には
環境変数をenvセットでテストサーバ駆動
$ env DBIC_TRACE=1 ./script/myapp_server.pl -r

いつも出す時は
MyApp.pm に
$ENV{'DBIC_TRACE'} = 1;
と書き込んでおく。

Apache等の本番環境に移した後は気になるところだけ
$c->model('DBIC')->storage->debug(1);
$c->model('DBIC')->storage->debugfh(IO::File->new('/log/DBIC.log', 'w'));

通常のDBIC(non Catalyst)では
my $schema = DB::Hoge->connect('dbi:mysql:dbname;localhost','ID','PW');

$schema->storage->debug(1);
$schema->storage->debugfh(IO::File->new('/log/DBIC.log', 'w'));

2008-01-05 12:29:29

Catalyst で FastCGI

[ Catalyst ]

Fedora7で。

yum install mod_fcgid

vim /etc/httpd/conf/httpd.conf

Listen 8086
NameVirtualHost 192.168.0.1:8086
<VirtualHost 192.168.0.1:8086>
    Alias /static /home/user/www/MyApp/root/static
    <Location /static>
        SetHandler default-handler
    </Location>
    Alias / /home/user/www/MyApp/script/myapp_fastcgi.pl
    <Location />
        Options All
        Order allow,deny
        Allow from all
        AddHandler fcgid-script .pl
    </Location>
    ErrorLog logs/8086-error_log
    CustomLog logs/8086-access_log combined
</VirtualHost>

2008-01-05 12:26:31

CatalystアプリケーションでのUnicode化

[ Catalyst ]

cpan[1]> install Catalyst::Pligin::Unicode
cpan[2]> install Catalyst::View::TT::ForceUTF8

vim lib/MyApp.pm

use Catalyst qw/
 Unicode ←追加
/;

vim lib/MyApp/View/TT.pm

use base 'Catalyst::View::TT';
↓変更
use base 'Catalyst::View::TT::ForceUTF8';

__PACKAGE__->config({
 DEFAULT_ENCODING => 'utf-8', ←追加
});

内部はフラグ付、外部出力時はフラグ無しのUTF8となる。

2007-07-25 23:57:20

MeCab-Senna-TritonnのRPMインストールとCatalystでのSearch

[ Catalyst ] [ DBIx::Class ] [ MySQL ]

※Fedora7を使用

[mecab導入]
楽だ。
yum -y mecab mecab-devel mecab-ipadic perl-mecab


[senna導入]
cd /home/hoge/rpmbuild/SOURCES
wget http://iij.dl.sourceforge.jp/senna/25607/senna-1.0.7.tar.gz
tar xzvf senna-1.0.7.tar.gz
SPEC発見。
cp senna-1.0.7/senna.spec /home/hoge/rpmbuild/SPECS/.
cd ../
rpmbuild -bb SPECS/senna.spec

あら、エラーが出た。
error: File /usr/src/redhat/SOURCES/libsenna-1.0.7.tar.gz: No such file or directory

SPEC修正。
vi SPECS/senna.spec

@@ -2,7 +2,7 @@
 %define release 1

 Summary: An Embeddable Fulltext Search Engine
-Name: libsenna
+Name: senna
 Version: %{version}
 Release: %{release}
 License: LGPL

再度ビルド。
rpmbuild -bb SPECS/senna.spec

以下のメッセージが出てRPMができた。
Wrote: /home/hoge/rpmbuild/RPMS/i386/senna-1.0.7-1.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/senna-devel-1.0.7-1.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/senna-debuginfo-1.0.7-1.i386.rpm

インストール
cd RPMS/i386/
rpm -ivh senna-1.0.7-1.i386.rpm senna-debuginfo-1.0.7-1.i386.rpm senna-devel-1.0.7-1.i386.rpm


[Tritonn + MySQL導入]
SennaのMySQLバインディングパッチが Tritonn という名の別プロジェクトになったらしい。
ex) http://qwik.jp/tritonn/about.html

cd SOURCES/
wget http://iij.dl.sourceforge.jp/tritonn/26391/mysql-5.0.41-tritonn-1.0.3.tar.gz
tar xzvf mysql-5.0.41-tritonn-1.0.3.tar.gz
現在使用中のディストリ版MySQLを上書きして使いたいので、RPM化する際に mysql-5.0.41 になってもらうことにする。
mv mysql-5.0.41-tritonn-1.0.3 mysql-5.0.41

Fedoraのtestにmysql-5.0.45-1があがっていたのでSRPMをもらう。
cd ../SRPMS/
wget ftp://ftp.riken.jp/Linux/fedora/updates/testing/7/SRPMS/mysql-5.0.45-1.fc7.src.rpm
rpm -ivh mysql-5.0.45-1.fc7.src.rpm
SPECを流用。
cd ../SPECS/
cp mysql.spec mysql-tritonn.spec
vi mysql-tritonn.spec

以下のように変更。
make testは通らないのでコメントアウトした(普通に./configureしても make test はエラーになったのであきらめた)。
--- mysql.spec  2007-07-23 07:16:27.000000000 +0900
+++ mysql-tritonn.spec  2007-07-25 10:31:57.000000000 +0900
@@ -1,15 +1,15 @@
 Name: mysql
-Version: 5.0.45
+Version: 5.0.41
 Release: 1%{?dist}
-Summary: MySQL client programs and shared libraries
+Summary: MySQL client programs and shared libraries and tritonn
 License: GPL
 Group: Applications/Databases
 URL: http://www.mysql.com

 # Regression tests take a long time, you can skip 'em with this
 %{!?runselftest:%define runselftest 1}

-Source0: http://dev.mysql.com/get/Downloads/MySQL-5.0/mysql-%{version}.tar.gz
+Source0: mysql-5.0.41.tar.gz
 Source1: mysql.init
 Source3: my.cnf
 Source4: scriptstub.c
@@ -153,6 +153,8 @@
 export CFLAGS CXXFLAGS

 %configure \
+       --with-senna=/usr \
+       --with-mecab=/usr \
        --with-readline \
        --with-openssl \
        --without-debug \
@@ -189,7 +191,7 @@
   esac
   export MTR_BUILD_THREAD

-  make test
+#  make test
 %endif

 %install


必要なファイルをコピーする(このままではman 関連が無くてエラーになる - 2007.7.26 0:16追記 mysql-5.0.41-tritonn-1.0.3.tar.gz のソース修正されてman入ったかも~未確認)。
cd ../SOURCES/
tar xzvf mysql-5.0.45.tar.gz
cp mysql-5.0.45/man/* mysql-5.0.41/man/.

mysql-5.041(Tritonn内蔵版)のtarボール作成する。
tar czvf mysql-5.0.41.tar.gz mysql-5.0.41

Build時必要なものをインストール。
yum install gperf readline-devel ncurses-devel

ビルド開始。
cd ../SPECS/
rpmbuild -ba mysql-tritonn.spec

できた。
Wrote: /home/hoge/rpmbuild/SRPMS/mysql-5.0.41-1.fc7.src.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-libs-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-server-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-devel-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-bench-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-test-5.0.41-1.fc7.i386.rpm
Wrote: /home/hoge/rpmbuild/RPMS/i386/mysql-debuginfo-5.0.41-1.fc7.i386.rpm

ここに置いておきます。
mysql-5.0.41-1.fc7.src.rpm
mysql-5.0.41-1.fc7.i386.rpm
mysql-bench-5.0.41-1.fc7.i386.rpm
mysql-debuginfo-5.0.41-1.fc7.i386.rpm
mysql-devel-5.0.41-1.fc7.i386.rpm
mysql-libs-5.0.41-1.fc7.i386.rpm
mysql-server-5.0.41-1.fc7.i386.rpm
mysql-test-5.0.41-1.fc7.i386.rpm

インストールする。
cd /home/hoge/rpmbuild/RPMS/i386/
rpm -Uvh mysql-*

以下URL参照に動作確認した。
http://qwik.jp/senna/check_install.html

念のためyumで上書きされないように yum.conf を編集。
vi /etc/yum.conf
exclude=mysql*


[Catalystで使ってみる]
FULLTEXTインデックスを作る。
mysql> CREATE FULLTEXT INDEX review_index ON goods_att(review);

カラムが text 型の場合、最大値255以下で指定
mysql> drop index review_index on goods_att;
mysql> CREATE FULLTEXT INDEX review_index ON goods_att(review(255));

以下の2パターンが使えるようだ。
ex1) http://asakura.g.hatena.ne.jp/asakura-t/comment?date=20070405
use SQL::Abstract::Fulltext::MySQL;
my $rs = $c->model('GoodsDB::GoodsAtt')->search({
    -fulltext => {
        -match   => 'review',
        -against => $q,
        -boolean => 1,
    },
});

ex2) http://blog.hide-k.net/archives/2006/08/dbixclassfullte.php
my $rs = $c->model('GoodsDB::GoodsAtt')->search({
})->search_literal('match(review) against(?)', $q);

ex1を使うことにする。
SQL::Abstract::Fulltext::MySQLを use して使用することにする。

Bench Mark してみる(マシンスペック - Celeron2.5GHz, Memory 384MB)。
Records: 121141

まずは普通に mysql クライアントから。
mysql> select count(*) from goods_att where match(review) against('強力');
+----------+
| count(*) |
+----------+
|     1492 |
+----------+
1 row in set (0.01 sec)

like 検索と比べる。
mysql> select count(*) from goods_att where review LIKE "%強力%";;
+----------+
| count(*) |
+----------+
|     1492 |
+----------+
1 row in set (0.62 sec)

次にCatalystで比較。4ワードで試した。
senna
0.339656s
0.840683s
6.052170s
0.880074s

like
2.199280s
1.740971s
12.650366s
1.220464s

2007-05-10 16:08:26

Catalyst::Engineでバグ?2

[ Catalyst ]

"Catalyst::Engineでバグ?"のつづき。

別のマシン(仮称:test2 - Fedora Core 6 i386 perl5.8.8)で実行すると普通に動く。しかも廻さず一回。
$maxlengthは ①65536
$remainingは ①6809
$self->read_positionは ①6809
$rcは ①6809

大きなサイズ104052バイトもテスト。こちらは二回り。
$maxlengthは ①65536 ②65536
$remainingは ①104052 ②43154
$self->read_positionは ①60898 ②104052
$rcは ①60898 ②43154
60708バイトもテスト。一回り。
$maxlengthは ①65536
$remainingは ①60708
$self->read_positionは ①60708
$rcは ①60708

Catalyst::Engineの readメソッドで
my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
my $rc = $self->read_chunk( $c, my $buffer, $readlen );
のようにあるから、6809バイトならば一気に読めてよいはず。

Catalyst::Engine::CGIの read_chunkは以下。
sub read_chunk { shift; shift; *STDIN->sysread(@_); }

STDINが気になった。
perlのテスト。下のスクリプトを実行してみる。

#!/usr/bin/perl
print "input long length\n";
$string = <STDIN>;
my $length = length($string);
print "$length\n";

test2のターミナルで4100バイトの文字列を入れようとしても、4095バイトで入力受付終了。
Enterキー押下で普通にprintされる。Enterキー込みで4096バイト。
Catalyst::Engineで悩んでいるマシン(CentOS4.4 Server x86_64 perl5.8.8-x86_64)でも4095バイトで入力受付終了。
・・・なのだが、Enterキーを受け付けない。
4094バイトにすると、Enterキーが押せてprintされる。Enterキー込みで4095バイト。
泥沼の予感。

IO::HandleでCatalyst::Engine::CGIっぽく。

#!/usr/bin/perl
use strict;
use warnings;
use IO::Handle;
my $stlen = 40960;
print "input long length\n";
my $length = read_chunk(my $buffer, $stlen);
print "$length\n";
sub read_chunk {
        *STDIN->sysread(@_);
}

やはりマシンによって受けられるデータ量が4096バイトと4095バイトで違いが出る。
4095バイトでEnter出来ないのも同じ。

Cでも試す。

#include <stdio.h>
#include <string.h>
main(void) {
    char string[4100];
    int i;
    printf("input long length\n");
    fgets(string, 4100, stdin);
    i = strlen(string);
    printf("%d\n", i);
    return 0;
}

同じくマシンによって受けられるデータ量が4096バイトと4095バイトで違いが出る。
性質が悪いのが、4095バイトまでコンソール上は受け入れておいてEnterキーが押せないこと。

さらに別マシン(Fedora Core 6 i386)でもテストする。4096バイト。問題なし。
泥沼だ orz
STDINを追うのは中断。

次はsysreadを考える。
test2で以下のCGIを実行する。

#!/usr/bin/perl
use strict;
use CGI;
sysread( STDIN, my $string, $ENV{'CONTENT_LENGTH'} );
my $c_length = $ENV{'CONTENT_LENGTH'};
my $length = length($string);
my $cgi = new CGI;
#(余談)STDINをreadする前に new CGIするとSTDINの中身を先にインスタンスにとられる。
print $cgi->header,
    $cgi->start_html,
    $cgi->p($c_length),
    $cgi->p($length),
    $cgi->start_form(-method=>'post', -enctype=>'application/x-www-form-urlencoded'),
    $cgi->textarea('str', '', 10, 100),
    $cgi->submit,
    $cgi->end_form,
    $cgi->end_html;

4100バイトの文字列をフォームに入力する。
$c_length = 4141
$length = 4141
と確認できた。

問題のマシンで実行して、同様の文字列を入力した。
$c_length = 4141
$length = 1387

sysread が1387バイトしか読んでいない・・・悲しくなった。
sysread を read に変えると、$length = 4141 となった。

sysread参考
http://www2u.biglobe.ne.jp/~MAS/perl/ref/sysread.html
http://perldoc.perl.org/functions/sysread.html
(perldoc perlfunc)

Catalyst::Engine::CGIの read_chunk の sysread を read に変更。
一度の読み込みバイト数は Catalyst::Engine の $maxlength で指定しているので問題なし。
何故 sysread だったのか疑問。うちの環境がダメってのはあるが・・・。
Catalyst-MLに以下パッチを送る。

--- lib/Catalyst/Engine/CGI.pm    (revision 6278)
+++ lib/Catalyst/Engine/CGI.pm    (local)
@@ -211,7 +211,7 @@

 =cut

-sub read_chunk { shift; shift; *STDIN->sysread(@_); }
+sub read_chunk { shift; shift; *STDIN->read(@_); }

 =head2 $self->run

※2007.05.07の Test::Controller::Root(同一環境の別アプリケーション)がsysreadのまま普通に動作したのが納得できなくて気持ち悪い。。。


2007.05.11追記
パッチはNG。sysread で期待値(LENGTH)が帰ってこない事は折込済のようだ。
Catalyst::Engineの prepare_body
while ( my $buffer = $self->read($c) ) {
     $c->prepare_body_chunk($buffer);
}
でバッファが返ってくる限り処理を続けることはわかっていたけど、戻り値等全く検証してなくてダメダメ。説明さえ出来ない。
原因を完全特定できるようにもっとがんばることにすべし!
STDIN->sysread を STDIN->read にすると問題は再発しない・・・何故だ?
とは言ってもSTDINを追うのはやめたいなぁ。環境を作り直すことは現状不可能。STDINは今のままは確定。

英語は全く駄目 orz 書きたいことが書けない。勉強することにする(関係代名詞を今日生まれて初めて理解できた)。

2007-04-26 00:08:35

ViewのconfigもYAML化

[ Catalyst ] [ YAML ]

便利かは微妙。

[View](lib/MyApp/View/TT.pm)の以下削除

__PACKAGE__->config({
       CATALYST_VAR => 'Catalyst',
       INCLUDE_PATH => [
               MyApp->path_to( 'root', 'src' ),
               MyApp->path_to( 'root', 'lib' )
       ],
       PRE_PROCESS  => 'config/main',
       WRAPPER      => 'site/wrapper',
       ERROR        => 'error.tt2',
       TIMER        => 0
});

[myapp.yml]に以下追加

View::TT:
  CATALYST_VAR: Catalyst
  INCLUDE_PATH:
    - /home/path/MyApp/root/src
    - /home/path/MyApp/root/lib
  PRE_PROCESS: config/main
  WRAPPER: site/wrapper
  ERROR: error.tt2
  TIMER: 0

2007-04-26 00:07:13

ModelのconfigもYAML化

[ Catalyst ] [ YAML ]

便利。

[Model](lib/MyApp/Model/MyAppDB.pm)の以下削除

__PACKAGE__->config(
       schema_class => 'MyAppDB',
       connect_info => [
               'dbi:mysql:DBNAME:192.168.0.1:3306',
               'ID',
               'PW',
       ],
);

[myapp.yml]に以下追加

Model::MyAppDB:
  schema_class: MyAppDB
  connect_info:
    - dbi:mysql:DBNAME:192.168.0.1:3306
    - ID
    - PW

ex)http://search.cpan.org/~bricas/Catalyst-Plugin-ConfigLoader-0.14/lib/Catalyst/Plugin/ConfigLoader/Manual.pod
読むまで YAML::Syck 使ってたorz

2007-04-06 16:28:23

Catalyst::Plugin::Cache::Memcached

[ Catalyst ]

Catalyst::Plugin::Cache::FileCache の config 設定がそのまま使えそうで、使えない。

Catalyst::Plugin::Cache::FileCache ならば
__PACKAGE__->config(
        name => 'MyApp',
        cache => {
                storage => '/tmp',
                expires => 3600,
        },
);

Catalyst::Plugin::Cache::Memcached の場合
__PACKAGE__->config(
        name => 'MyApp',
        cache => {
                servers => ['192.168.10.123:11211'],
        },
);

となって、時間設定は config ではなく、使用時に
$c->cache->set('data', $data, 120)
とする。

2007-03-06 15:52:15

Catalyst::Plugin::I18N::DBIC

[ Catalyst ]

使おうとしたら、ちょっとハマった。
データベーススキーマが 'DBIC::Lexicon' 決めウチされていた。
加えて使われていない変数 $obj が作られている。
※パッチを書いて作者に送った。

For Catalyst-Plugin-I18N-DBIC/DBIC.pm(0.03)

@@ -11,7 +11,6 @@
     my ($c, @paths) = @_;
 
     my $class = ref $c || $c;
-    my $obj = "$class\::I18N"->get_handle(@{$c->languages});
     my $lang = $c->language;
 
     my $where = {
@@ -19,7 +18,8 @@
         path        => [@paths],
     };
 
-    my $lexicons_rc = $c->model('DBIC::Lexicon')->search($where);
+    my $lexicon_model = ( $c->config->{lexicon} || 'DBIC::Lexicon' );
+    my $lexicons_rc = $c->model($lexicon_model)->search($where);
     while (my $lex = $lexicons_rc->next) {
         my $message = $lex->message;
         my $value = $lex->value;

あと忘れそうなのが MyApp::I18N::ja を必ず作ること。
package MyApp::I18N::ja;
use base qw(MyApp::I18N);
our %Lexicon = (
    '_AUTO' => 1,
);
1;

2004-04-02追記
2004/03/25にアップデート(Catalyst-Plugin-I18N-DBIC-0.04)したとメールがきた。
喜んでインストールしたけど、POD or Method の typoで動かない。再メール。

2007-02-28 15:12:10

Catalyst::Engineでバグ?

[ Catalyst ]

CGIにて使用。
<form action="" method="post">
<textarea name="comment" rows="4" cols="40"></textarea>
</form>

以下のようなエラーが出てしまう。
[error] Caught exception in engine "Wrong Content-Length value: 4387 at /usr/lib/perl5/site_perl/5.8.8/Catalyst.pm line 1584"

メーリングリストにも同様の事柄が載っているが、行番号が違う。バージョンが違うのだろうか?
入力データ量を減らすと問題が発生しない。
Catalystのバージョンは5.7006。
時間が有れば原因究明したいところ。


2007.05.07追記
5.7007でも
[error] Caught exception in engine "Wrong Content-Length value: 5908 at /usr/lib/perl5/site_perl/5.8.8/Catalyst.pm line 1611"
と出た。
Catalyst.pm 1611行目 $c->engine->prepare_body( $c, @_ ); としている部分。
つまり
Catalyst::Engine 313行目からのprepare_bodyメソッドで止まっている。

sub prepare_body {
    my ( $self, $c ) = @_; 
    my $length = $c->request->header('Content-Length') || 0;
    $self->read_length( $length );
    if ( $length > 0 ) {
        (略)
        while ( my $buffer = $self->read($c) ) {
            $c->prepare_body_chunk($buffer);
        }
        # paranoia against wrong Content-Length header
        my $remaining = $length - $self->read_position;
        if ( $remaining > 0 ) {
            $self->finalize_read($c);
            Catalyst::Exception->throw(
                "Wrong Content-Length value: $length" );
        }
    }
    (略)
}

データ量が多くなると、$length と $self->read_position の数が合わなくなる。
ログに書き出すと、$length=7687 $self->read_position=4096。
4096とはキリが良過ぎる・・・。
Catalystのテストサーバでは発生しないのに、CGI環境で発生する・・・。

$self->read_position を追う。
Catalyst::Engine 内で最初に0がセットされ、read メソッドで読み込んだサイズ分加算される。

Catalyst::Engine に以下の説明がある
=head2 $self->read_chunk($c, $buffer, $length)
Each engine inplements read_chunk as its preferred way of reading a chunk
of data.
=cut

Catalyst::Engine::CGI に
sub read_chunk { shift; shift; *STDIN->sysread(@_); }
がある。

Catalyst::Engineの readメソッド を以下のように書き換えてdump

sub read {
    my ( $self, $c, $maxlength ) = @_;
    unless ( $self->{_prepared_read} ) {
        $self->prepare_read($c);
        $self->{_prepared_read} = 1;
    }
    my $remaining = $self->read_length - $self->read_position;
    $maxlength ||= $CHUNKSIZE;
    # Are we done reading?
    if ( $remaining <= 0 ) {
        $self->finalize_read($c);
        return;
    }
    my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
    my $rc = $self->read_chunk( $c, my $buffer, $readlen );
    if ( defined $rc ) {
        $self->read_position( $self->read_position + $rc );
$c->log->dumper( $maxlength );
$c->log->dumper( $remaining );
$c->log->dumper( $self->read_position );
$c->log->dumper( $rc );
$c->log->dumper( $buffer );
        return $buffer;
    }
    else {
        Catalyst::Exception->throw(
            message => "Unknown error reading input: $!" );
    }
}

readメソッドは、Catalyst::Engine の prepare_body メソッドでwhileで廻されている。
今回は二回呼ばれた。
$maxlengthは ①65536 ②65536
$remainingは ①6809 ②2713
$self->read_positionは ①4096 ②4096
$rcは ①4096 ②0
$bufferは ①4096byteURLエンコード済文字列 ②0byte

readが間に合わない??
同一環境の別アプリケーションでは再現しない。

package Test::Controller::Root;
use strict;
use warnings;
use base 'Catalyst::Controller';
__PACKAGE__->config->{namespace} = '';
sub default : Private {
    my ( $self, $c ) = @_;
    $c->stash->{str} = $c->req->param('str') || '';
    $c->stash->{template} = 'temp.tt2';
}
sub end : ActionClass('RenderView') {}
1;

$maxlengthは ①65536 ②65536
$remainingは ①6809 ②2713
$self->read_positionは ①4096 ②6809
$rcは ①4096 ②2713

普通だ・・・デバッグ断念。

悩んだ末、フォームでenctype="multipart/form-data"を指定した。
<form method="post" action="" enctype="multipart/form-data">
エラーは発生しなくなった。嫌な解決。

2007-02-10 12:20:51

Modelヘルパー使用法

[ Catalyst ]

よく忘れる。

script/myapp_create.pl model MyAppDB DBIC::Schema MyAppDB create=static dbi:mysql:DBNAME:192.168.0.1:3306 'ID' 'PW'
or
script/myapp_create.pl model MyAppDB DBIC::Schema MyAppDB create=dynamic dbi:mysql:DBNAME:192.168.0.1:3306 'ID' 'PW'

ex)Catalyst::Helper::Model::DBIC::Schema

2007-01-12 19:11:30

CatalystでXML出力

[ Catalyst ] [ XML ]

[Catalyst::View::REST::XML]
$c->response->headers->content_type('text/xml');
$c->response->output( XMLout $c->stash, RootName => 'response' );

[Catalyst::View::Atom::XML]
$c->response->content_type('application/atom+xml');
$c->response->body($obj->as_xml);

Viewを自作してもよし。
Catalyst::Response はShortcut、Aliasが多くて、混乱しやすい。

2007-01-02 20:30:18

CGI環境設置

[ Catalyst ]

httpd.confに
Alias /script/ "/home/path/www/MyApp/script/"
<Directory "/home/path/www/MyApp/script">
    Options All
    AllowOverride All
    Order allow,deny
    Allow from all
</Directory>

手抜きだけど。

2007-01-02 20:20:42

Apache2 + mod_perl2環境設置

[ Catalyst ]

FedoraCore6の場合
vi /etc/httpd/conf.d/perl.conf
LoadModule perl_module modules/mod_perl.so

#エイリアスにする場合
#Alias /myapp/ /home/path/www/www.domain.com/MyApp/

PerlSwitches -I/home/path/www/www.domain.com/MyApp/lib
PerlLoadModule MyApp

#エイリアスにする場合
#<Location /myapp>
<Location />
    SetHandler perl-script
    PerlResponseHandler MyApp
</Location>


あとSQLiteをローカルで使用している場合はModelをフルパスに書き換えること
__PACKAGE__->config(
    schema_class => 'MyAppDB',
    connect_info => [
        #(old)'dbi:SQLite:myapp.db',
        'dbi:SQLite:/home/path/www/MyApp/myapp.db',
        '',
        '',
        {AutoCommit => 1 },
    ],
);

2007-01-02 20:15:44

インストール

[ Catalyst ]

perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
 ↑既存モジュールの全アップデート
perl -MCPAN -e shell
install Catalyst
↑まずはCatalyst-Runtime
install Catalyst::Devel
install Task::Catalyst
↑追加モジュールをインストール