DBIx::Simple で UTF8Columns したい
しつこく DBIx::Simple を使っていきますが，使っていて困ることの一つは DB から取得したデータが octet stream のままであること。もちろんモデルクラス（DB へのアクセサ）で面倒をみてやればいいのですが，DBIC とかモダンなものだと DBIx::Class::UTF8Columns みたいに内部 Unicode にしてくれるヘルパがあったりします。
以前も思いましたがこの辺は DBD か DBI が面倒見るべきじゃないかな？でもそうしちゃうと既存のコードの互換性が保てないからアレなのかな？
ともかくルーズに utf8 したい。
ってことでコードをでっちあげてみました。DBIx::Simple のコードを読むと，
- DB に投げる際は必ず DBIx::Simple::query() を通るっぽい
- DBIx::Simple::query() が結果含むデータを DBIx::Simple::Result に bless
- DB から受け取ったものは DBIx::Simple::Result を経由してアクセス
だったので，Result クラスを継承して変換処理を加えつつ，query() 上書きして新しい Result クラスを返すようにしてます。同じような記述の繰り返しで格好悪いですが。
デフォルトで DB 側のコードは UTF-8 を仮定してますが，$db->encoding('euc-jp') とかすると変更できるようにしてます。また，DBIx::Simple::OO は DBIx::Simple::Result にメソッドを足してるだけなので，そのまま使えます。
use DBIx::Simple::UTF8Columns; use DBIx::Simple::OO; use utf8; my $db = DBIx::Simple::UTF8Columns->connect(...); $db->encoding('euc-jp'); my $book = $db->select( 'books', '*', { title => { 'LIKE' => 'はじめての%' }, }, )->object; if ($book->author =~ m/林/) { ... }
こんな感じで書ける，はず。こんなサンプルでは内部 Unicode にする旨みもなにもあったもんじゃないですけど。
ちなみにテーブル名やフィールド名は latin chars を仮定してます（変換してない）…とほほ
use strict; use warnings; use Carp (); use utf8; use Encode (); $Carp::Internal{$_} = 1 for qw( DBIx::Simple::UTF8Columns DBIx::Simple::UTF8Columns::Result ); package DBIx::Simple::UTF8Columns; use base qw( DBIx::Simple ); our $DEFAULT_ENCODING = 'utf8'; sub encoding { my $self = shift; if (! ref $self) { # class method if (@_) { $DEFAULT_ENCODING = shift; } return $DEFAULT_ENCODING; } else { # instance method if (@_) { $self->{_encoding} = shift; $self->{_encoder} = undef; } elsif (! defined $self->{_encoding}) { $self->{_encoding} = $DEFAULT_ENCODING; $self->{_encoder} = undef; } return $self->{_encoding}; } } sub _encoder { my $self = shift; if (! defined $self->{_encoder}) { $self->{_encoder} = Encode::find_encoding($self->encoding); } return $self->{_encoder}; } sub query { my ($self, $query, @binds) = @_; foreach my $data ($query, @binds) { if (! ref $data && utf8::is_utf8($data)) { $data = $self->_encoder->encode($data); } } my $result = $self->SUPER::query($query, @binds); if (defined $result) { bless $result, 'DBIx::Simple::UTF8Columns::Result'; $result->{_encoder} = $self->_encoder; } return $result; } package DBIx::Simple::UTF8Columns::Result; use base qw( DBIx::Simple::Result ); sub _encoder { return $_[0]->{_encoder}; } sub _decode { my ($self, $data) = @_; if (! utf8::is_utf8($data)) { $data = $self->_encoder->decode($data); } return $data; } sub _encode { my ($self, $data) = @_; if (utf8::is_utf8($data)) { $data = $self->_encoder->encode($data); } return $data; } # UNSUPPORTED: func, attr # UNTOUCH: columns # UNSUPPORTED: bind, fetch, into sub list { my $self = shift; my @results = $self->SUPER::list(@_); if (wantarray) { foreach my $result (@results) { $result = $self->_decode($result); } return @results; } else { return $self->_decode($results[-1]); } } sub array { my $self = shift; my $result = $self->SUPER::array(@_); if (defined $result) { my @results = @{ $self->SUPER::array(@_) }; foreach my $data (@results) { $data = $self->_decode($data); } $result = \@results; } return $result; } sub hash { my $self = shift; my $ref_results = $self->SUPER::hash(@_); if (defined $ref_results) { foreach my $result (values %$ref_results) { $result = $self->_decode($result); } } return $ref_results; } # UNTOUCH: flat sub arrays { my $self = shift; my @results = $self->SUPER::arrays(@_); foreach my $result (@results) { foreach my $column (@$result) { $column = $self->_decode($column); } } return wantarray ? @results : \@results; } # UNTOUCH: hashes, map_hashes, map_arrays, map, rows # UNSUPPORTED: xto, html, table 1;
追記 2007/01/10
sub arrays() の実装がおかしかったのでなおした
