comparison Lib/IMPL/Object/Serializable.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
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;