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 にあげませんが,ご自由にお使い下さい。