Class::DBIでComunをData::SerializerでSerializeして保存。
Class::DBIでobejctやreferenceを保存の続き。
どんぞこ日記さんのところで紹介されてるData::Serializerを採用した。ソースは追記に貼付けてます。
Data::Serializerを使ったので、Serializeに使うモジュールをいくつか選択できて、暗号化、圧縮、エンコード等ができるようになります。暗号化は便利かも。
使い方は前回と同じだけど、Data::Serializerのconfig用のserialize_configメソッドがついて
package Foo;
use base 'Class::DBI';
use Class::DBI::Plugin::SerializeColumn;
__PACKAGE__->columns(All => qw/id title props/);
__PACKAGE__->serialize_column('props');
__PACKAGE__->serialize_config(
serializer=>'Storable',
encoding=>'b64'
);
package main;
Foo->create({
id=>1,title=>'foo',
props=>{a=>1,b=>[qw/2 3 4/]}
})
my $foo=Foo->retirieve(1);
$foo->props->{a};#1
$foo->props->{b}->[0];#2
という感じ。
package Class::DBI::Plugin::SerializeColumn;
use 5.006;
use strict;
use warnings;
use Data::Serializer;
use vars qw($VERSION);
$VERSION='0.02';
sub import {
my $class = shift;
my $pkg = caller(0);
$pkg->mk_classdata('__serialize_config'=>{});
$pkg->mk_classdata('__serialize_column'=>[]);
my $before_create_update_callback=sub{
my $self = shift;
my $serializer = Data::Serializer->new(%{$self->serialize_config});
foreach my $column (@{$self->serialize_column}){
my $ref=$self->_attrs($column) || next;
my $freeze=$serializer->serialize($ref);
$self->_attribute_set($column,$freeze);
}
};
my $select_callback=sub{
my $self = shift;
my $serializer = Data::Serializer->new(%{$self->serialize_config});
foreach my $column (@{$self->serialize_column}){
my $freeze=$self->_attrs($column) || next;
my $ref=$serializer->deserialize($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\::serialize_config"} = \&serialize_config;
}
sub serialize_column{
my $class = shift;
if(@_ >0){
push(@{$class->__serialize_column},shift);
}
return $class->__serialize_column;
}
sub serialize_config{
my $class = shift;
my $config = $class->__serialize_config;
my %config = (%{$config},@_);
$class->__serialize_config(\%config);
}
1;