Mercurial > pub > Impl
view Lib/IMPL/Object/Serializable.pm @ 379:a471e8b77544
sync
author | cin |
---|---|
date | Thu, 16 Jan 2014 18:10:50 +0400 |
parents | 4ddb27ff4a0b |
children |
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 " ".'$ctx->AddVar('.$_->name.' => ' . ($_->isList ? ('[$this->'.$_->class.'::'.$_->name.'()]') : ('$this->'.$_->class.'::'.$_->name.'()')) . ') if defined ' . '$this->'.$_->class.'::'.$_->name.'()' . ';', grep $_->setter, $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;