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;