annotate lib/IMPL/Object/Serializable.pm @ 408:5c80e33f1218 ref20150831

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