Mercurial > pub > Impl
diff Lib/IMPL/Object/Serializable.pm @ 0:03e58a454b20
Создан репозитарий
author | Sergey |
---|---|
date | Tue, 14 Jul 2009 12:54:37 +0400 |
parents | |
children | 16ada169ca75 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Object/Serializable.pm Tue Jul 14 12:54:37 2009 +0400 @@ -0,0 +1,54 @@ +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;