annotate Lib/IMPL/Object/Serializable.pm @ 24:7f00786f8210

Первая рабочая реазизация схемы и навигаторов
author Sergey
date Mon, 05 Oct 2009 00:48:49 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Object::Serializable;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use warnings;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 require IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 sub restore {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 my ($class,$data,$refSurrogate) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 if ($refSurrogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 $refSurrogate->callCTOR(@$data);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 return $refSurrogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 return $class->new(@$data);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 sub save {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 my ($this,$ctx,$predicate) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 ($this->_get_save_method)->($this,$ctx);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 sub _get_save_method {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my ($class) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 $class = ref $class || $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 if (my $method = *{"${class}::_impl_auto_save"}{CODE}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 return $method;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 my $code = <<SAVE_METHOD;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 package $class;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 sub _impl_auto_save {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 my (\$this,\$ctx) = \@_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 SAVE_METHOD
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 $code .=
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 join "\n", map "\t".'$ctx->AddVar('.$_->Name.' => ' .
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 ((not ref $_->Mutators and $_->Mutators & prop_list) ? ('[$this->'.$_->Class.'::'.$_->Name.'()]') : ('$this->'.$_->Class.'::'.$_->Name.'()')) .
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 ') if defined ' . '$this->'.$_->Class.'::'.$_->Name.'()' . ';', grep $_->canGet, $class->get_meta('IMPL::Class::PropertyInfo',undef,1);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 $code .= <<SAVE_METHOD;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 \\\&_impl_auto_save;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 SAVE_METHOD
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 return (eval $code || die new IMPL::Exception("Failed to generate serialization method",$class,$@));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 1;