DBIx::Class 次の一歩（←いまココ）
DBIx::Class にはいくつか興味深いモジュールがあります。
DBIx::Class::PK::Auto
標準で添付されているモジュールです。これについては以前書きました。
DBIx::Class::InflateColumn
標準で添付されているモジュールです。カラムデータとオブジェクト（たとえば DateTime クラスとか）を相互変換できるモジュールです。これを使うと CDBI の has_a で外部クラスを指定した時のようなことができるのかな？
DBIx::Class::WebForm
Data::FormValidator 等の結果をもとに，レコードを作成したり更新したり（CRUD）することができるモジュールみたいです。でも，実際にはフォームとテーブルが一対一対応してることなんて少ないと思います。ドキュメントも全然書いてないし。なので自分では使わないと思います。
DBIx::Class::FormTools
↑よりちょっとましかな？と思うフォームと O/R をつなげるモジュール。フォームのフィールド名とかも生成してくれるので楽そうです。でも，これも自分では使わないでしょうねぇ。
DBIx::Class::UTF8Columns
標準で添付されているモジュールです。typester さん作。これは，指定したフィールドに対して，DB から取り出した後に値の utf8 フラグをたてたり，DB に戻す前に utf8 フラグをおとしたり，してくれます。アプリの内部を utf8 で統一しているときに，Template::Provider::Encoding と組み合わせて使います（utf8 のオクテットストリームとみなしてるんだい，という人は使わなくてよい）。
ですが，バグがありまして。DBIx::Class のレコードオブジェクトに値をセットするときに，本来は同じ値なら dirty_flag をセットしない（それによって不必要な UPDATE を避けることができる）のですが，utf8 フラグを扱っている副作用で，非 latin の値をセットすると，同じ値だったとしても dirty になってしまいます。
綺麗なロジックではないですが，
--- UTF8Columns.pm.orig 2006-06-09 14:24:20.000000000 +0900
+++ UTF8Columns.pm 2006-06-09 14:28:48.000000000 +0900
@@ -84,7 +84,12 @@
my ( $self, $column, $value ) = @_;
if ( { map { $_ => 1 } @{ $self->force_utf8_columns } }->{$column} ) {
- Encode::_utf8_off($value) if Encode::is_utf8($value);
+ if (Encode::is_utf8($value)) {
+ my $v2 = $value;
+ Encode::_utf8_off($value);
+ $self->next::method( $column, $value );
+ return $v2;
+ }
}
$self->next::method( $column, $value );のようなパッチをあてると改善します。
このモジュールは便利なのではありますが，フィールド単位で指定するのが面倒くさい＆どちらかというと，DB のエンコーディングを指定できたほうが便利じゃない？と思ったので，DBIx::Class::Encoding なる拡張モジュールをでっちあげてみました。
package DBIx::Class::Encoding;
use strict;
use warnings;
use base qw/DBIx::Class/;
use Encode ();
__PACKAGE__->mk_classdata( encoding => 'utf8' );
sub get_column {
my ($self, $column) = @_;
my $value = $self->next::method($column);
my $encoding = $self->encoding || 'utf8';
return $value if Encode::is_utf8($value);
Encode::decode($encoding, $value)
}
sub get_columns {
my $self = shift;
my %data = $self->next::method(@_);
my $encoding = $self->encoding || 'utf8';
foreach my $value (values %data) {
next if Encode::is_utf8($value);
$value = Encode::decode($encoding, $value)
}
%data;
}
sub store_column {
my ($self, $column, $value) = @_;
my $encoding = $self->encoding || 'utf8';
if (Encode::is_utf8($value)) {
$self->next::method($column, Encode::encode($encoding, $value));
return $value;
} else {
$self->next::method($column, $value);
return Encode::decode($encoding, $value);
}
}
1;なんだかんだいって typester さんのコードをかなりひきずっています。ついでに SYNOPSIS もパクると，
package Artist;
__PACKAGE__->load_components(qw/Encoding Core/);
__PACKAGE__->encoding('CP51932');
my $artist = $schema->resultset('Artist')->first;
$artist->name; # in UTF-8
$artist->description('あああ'); # store to DB in CP51932 (eucJP-ms)こんな感じでかけます。pod もテストスクリプトも書いていないですし，せっかく様々な DB に対して透過的に扱える DBIC なのにアプローチが間違っている気がする*1ので CPAN にあげませんが，ご自由にお使い下さい。
