|
49
|
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 "\t".'$ctx->AddVar('.$_->Name.' => ' .
|
|
|
42 ((not ref $_->Mutators and $_->Mutators & prop_list) ? ('[$this->'.$_->Class.'::'.$_->Name.'()]') : ('$this->'.$_->Class.'::'.$_->Name.'()')) .
|
|
|
43 ') if defined ' . '$this->'.$_->Class.'::'.$_->Name.'()' . ';', grep $_->canGet, $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;
|
