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

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Object::Serializable;
2 use strict;
3 use warnings;
4
5 require IMPL::Exception;
6 use IMPL::Class::Property;
7
8 sub restore {
9 my ($class,$data,$refSurrogate) = @_;
10
11 if ($refSurrogate) {
12 $refSurrogate->callCTOR(@$data);
13 return $refSurrogate;
14 } else {
15 return $class->new(@$data);
16 }
17 }
18
19 sub save {
20 my ($this,$ctx,$predicate) = @_;
21
22 ($this->_get_save_method)->($this,$ctx);
23 }
24
25 sub _get_save_method {
26 my ($class) = @_;
27
28 $class = ref $class || $class;
29
30 no strict 'refs';
31 if (my $method = *{"${class}::_impl_auto_save"}{CODE}) {
32 return $method;
33 } else {
34 my $code = <<SAVE_METHOD;
35 package $class;
36 sub _impl_auto_save {
37 my (\$this,\$ctx) = \@_;
38 SAVE_METHOD
39
40 $code .=
41 join "\n", map " ".'$ctx->AddVar('.$_->name.' => ' .
42 ($_->isList ? ('[$this->'.$_->class.'::'.$_->name.'()]') : ('$this->'.$_->class.'::'.$_->name.'()')) .
43 ') if defined ' . '$this->'.$_->class.'::'.$_->name.'()' . ';', grep $_->setter, $class->get_meta('IMPL::Class::PropertyInfo',undef,1);
44 $code .= <<SAVE_METHOD;
45
46 }
47 \\\&_impl_auto_save;
48 SAVE_METHOD
49
50 return (eval $code || die new IMPL::Exception("Failed to generate serialization method",$class,$@));
51 }
52 }
53
54 1;