Class::DBIでobejctやreferenceを保存
「Class::DBI で疑似的カラム」をちょっと機能強化で書いたモジュールをもとにClass::DBI でobejctやreferenceをシームレスに保存できるプラグインを書いてみた。
使い方
package My::Film;
use base 'Class::DBI';
use Class::DBI::Plugin::SerializeColumn;
__PACKAGE__->columns(All => qw/id title props/);
__PACKAGE__->serialize_column('props');
などとクラスを書いて、
My::Film->create({
id=>1,
title=>'四月物語',
props =>{year=> 1998,director=>'岩井俊二'}
});
とできるし、
my $film = My::Film->retrieve(1);
$film->props->{director};#岩井俊二
$film->props->{cast}=[qw/松たか子 田辺誠一 加藤和彦 藤井かほり/];
$film->update;
こういうこともできると思う。
もうすこし方法ないのか探しているんだけど、↓追記にソース貼付け
package Class::DBI::Plugin::SerializeColumn;
use 5.006;
use strict;
use warnings;
use UNIVERSAL::require;
use vars qw($VERSION);
$VERSION='0.01';
sub import {
my $class = shift;
my $pkg = caller(0);
$pkg->mk_classdata('column_serializer'=>'Storable');
$pkg->mk_classdata('__serialize_column'=>[]);
my $before_create_update_callback=sub{
my $self = shift;
foreach my $column (@{$self->serialize_column}){
my $ref=$self->_attrs($column) || next;
my $freeze=$self->_serialize_column_freeze($ref);
$self->_attribute_set($column,$freeze);
}
};
my $select_callback=sub{
my $self = shift;
foreach my $column (@{$self->serialize_column}){
my $freeze=$self->_attrs($column) || next;
my $ref=$self->_serialize_column_thaw($freeze);
$self->_attribute_store($column,$ref);
}
};
$pkg->add_trigger('before_create',$before_create_update_callback);
$pkg->add_trigger('before_update',$before_create_update_callback);
$pkg->add_trigger('select',$select_callback);
no strict 'refs';
*{"$pkg\::serialize_column"} = \&serialize_column;
*{"$pkg\::_column_serializer"} = \&_column_serializer;
*{"$pkg\::_serialize_column_freeze"} = \&_serialize_column_freeze;
*{"$pkg\::_serialize_column_thaw"} = \&_serialize_column_thaw;
}
sub serialize_column{
my $class = shift;
if(@_ >0){
push(@{$class->__serialize_column},shift);
}
return $class->__serialize_column;
}
sub _column_serializer{
my $self = shift;
my $serializer = "Class::DBI::Plugin::SerializeColumn::" . $self->column_serializer;
$serializer->require;
return $self->_croak(qq(couldn't load serializer "$serializer" : ) . $@) if $@;
return $serializer;
}
sub _serialize_column_freeze{
my($self, $var) = @_;
my $serializer = $self->_column_serializer;
my $freeze;
eval{
$freeze=$serializer->freeze($var);
};
return $self->_croak(qq(couldn't freeze data : ) . $@) if $@;
return $freeze;
}
sub _serialize_column_thaw{
my($self, $freeze) = @_;
my $serializer = $self->_column_serializer;
my $thaw;
eval{
$thaw=$serializer->thaw($freeze);
};
return $self->_croak(qq(couldn't thaw data $freeze: ) . $@) if $@;
return $thaw;
}
1;