Mercurial > pub > Impl
view Lib/IMPL/Object/Serializable.pm @ 239:23daf2fae33a
*security subsytem bugfixes
*HttpResponse: cookies which values are set to undefined will be deleted from browser
author | sergey |
---|---|
date | Tue, 16 Oct 2012 20:14:11 +0400 |
parents | c8fe3f84feba |
children | 4ddb27ff4a0b |
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.' => ' . ((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;