Mercurial > pub > Impl
view Lib/IMPL/Object/Serializable.pm @ 101:d8dc6cad3f55
Schema in progress
author | wizard |
---|---|
date | Thu, 06 May 2010 17:55:59 +0400 |
parents | 16ada169ca75 |
children | c8fe3f84feba |
line wrap: on
line source
package IMPL::Object::Serializable; use strict; use warnings; require IMPL::Exception; use IMPL::Class::Property; sub restore { my ($class,$data,$refSurrogate) = @_; if ($refSurrogate) { $refSurrogate->callCTOR(@$data); return $refSurrogate; } else { return $class->new(@$data); } } sub save { my ($this,$ctx,$predicate) = @_; ($this->_get_save_method)->($this,$ctx); } sub _get_save_method { my ($class) = @_; $class = ref $class || $class; no strict 'refs'; if (my $method = *{"${class}::_impl_auto_save"}{CODE}) { return $method; } else { my $code = <<SAVE_METHOD; package $class; sub _impl_auto_save { my (\$this,\$ctx) = \@_; SAVE_METHOD $code .= join "\n", map "\t".'$ctx->AddVar('.$_->Name.' => ' . ((not ref $_->Mutators and $_->Mutators & prop_list) ? ('[$this->'.$_->Class.'::'.$_->Name.'()]') : ('$this->'.$_->Class.'::'.$_->Name.'()')) . ') if defined ' . '$this->'.$_->Class.'::'.$_->Name.'()' . ';', grep $_->canGet, $class->get_meta('IMPL::Class::PropertyInfo',undef,1); $code .= <<SAVE_METHOD; } \\\&_impl_auto_save; SAVE_METHOD return (eval $code || die new IMPL::Exception("Failed to generate serialization method",$class,$@)); } } 1;