diff lib/IMPL/Object/Serializable.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Object/Serializable.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -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 "    ".'$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;