annotate Lib/IMPL/Serialization.pm @ 159:f8de52d3c112

IMPL::Test::Unit minor changes
author wizard
date Mon, 27 Dec 2010 01:37:44 +0300
parents fb896377389f
children 4267a2ac3d46
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package IMPL::Serialization;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2 use strict;
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 # 20060222
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
5 # ������ ��� ������������ �������� ������
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
6 # (�) Sourcer, cin.sourcer@gmail.com
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 # revision 3 (20090517)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 package IMPL::Serialization::Context;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 use Scalar::Util qw(refaddr);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 BEGIN {
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
19 private _direct property ObjectWriter => prop_all; # ������, ������������ ������ � �����
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
20 private _direct property Context => prop_all; # �������� (������� ������� ��� �������������, �� ��������������)
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
21 private _direct property NextID => prop_all;# ��������� ������������� ��� �������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
23 # ���������, ������� �����, ��� ��������������� ������������ ����. ������ ����������
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
24 # �������� ������ �� IMPL::Serialization::Context, ������ ���������� ������ �� ������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 public _direct property Serializer => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
27 private _direct property State => prop_all; # ��������� ��������� ������������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
30 # �������� ������, �.�. ������� ������ �� �����
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 sub STATE_CLOSED () { 0 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
32 # �������� ������, �.�. ������ �����, �� � ��� ��� ������ �� �����
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 sub STATE_OPENED () { 1 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
34 # �������� ������ � � ���� ����� ���� ��������� ������ ����������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 sub STATE_COMPLEX () { 2 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
36 # �������� ������ � � ���� ��� ������ �� ����� ���� ���������, ��� ����� ������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 sub STATE_DATA () { 3 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 $this->{$ObjectWriter} = $args{'ObjectWriter'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 #$this->{$Context} = {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 $this->{$NextID} = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 $this->{$Serializer} = ($args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 $this->{$State} = STATE_CLOSED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 sub AddVar {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 my ($this,$sName,$Var) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 if (not ref $Var) {
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
57 # ������� ����������� ��, ��� �����, �� ��� ���� ����, ����� �������, ������� ����
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
58 # �� �� ������, �� �������� ��������������, �� �� �� �����
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 my $prevState = $this->{$State};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 $this->{$State} = STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 $this->{$Serializer}->($this,\$Var);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 if ($prevState == STATE_OPENED) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 $this->{$State} = STATE_COMPLEX;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 $this->{$State} = $prevState;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 return 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 my $PrevState = $this->{$State};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78 my $ObjID = $this->{$Context}->{refaddr $Var};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79 if ($ObjID) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 $this->{$ObjectWriter}->BeginObject(name => $sName, refid => $ObjID);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 return $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 $ObjID = $this->{$NextID};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 $this->{$NextID} = $ObjID + 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88 $this->{$Context}->{refaddr $Var} = $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90 $this->{$ObjectWriter}->BeginObject(name => $sName, type => ref($Var), id => $ObjID);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 $this->{$State} = STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93 $this->{$Serializer}->($this,$Var);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 if ($PrevState == STATE_OPENED) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98 $this->{$State} = STATE_COMPLEX;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 $this->{$State} = $PrevState;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 return $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 sub SetData {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 my ($this,$Data,$Type) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109 die new Exception ('The object should be a scalar value') if ref $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 die new Exception ('Invalid operation') if $this->{$State} != STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112 $this->{$ObjectWriter}->SetData($Data,$Type);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114 $this->{$State} = STATE_DATA;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119 sub DefaultSerializer {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120 my ($Context, $refObj) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122 if (ref($refObj) eq 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123 $Context->SetData($$refObj, 'SCALAR');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 } elsif (ref($refObj) eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125 $Context->AddVar('item',$_) foreach @$refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126 } elsif (ref($refObj) eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127 while (my ($key,$value) = each %$refObj) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 $Context->AddVar($key,$value);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 } elsif (ref($refObj) eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 $Context->AddVar('ref',$$refObj);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133 if (ref $refObj and $refObj->UNIVARSAL::can('save')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 $refObj->save($Context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136 die new Exception('Cant serialize the object of the type: '.ref($refObj));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143 package IMPL::Deserialization::Context;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
148 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
149
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
150 BEGIN {
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
151 # ��� ����������������� �������, ���, ���� - �������������, �������� - ������.
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
152 private _direct property Context => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
153
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
154 # ������� ������. ���������� ��� ��������������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
155 # {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
156 # Type => 'typename',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
157 # Name => 'object_name',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
158 # Data => $Data,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
159 # Id => 'object_id'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
160 # }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
161 private _direct property CurrentObject => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
162
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
163 # ���� ��������. ���� ����������� �������� �������� �� ���� ���������� ����� ��������.
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 private _direct property ObjectsPath => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
166 # ���� ������� ������ ����� ��������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
167 public _direct property Root => prop_get;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
168
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
169 # ������� ������ � ���������� �� ���� ������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
170 # ObjectFactory($Type,$DeserializationData,$refSurogate)
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
171 # $Type - ��� ���� ������
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
172 # $DeserializationData - ���� ������ �� ������ � ������� ��� �������������� �����,
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
173 # ���� ������ ���������� ������.
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
174 # $refSurogate - ������ �� �������������� ���������, �� ������������������ ������.
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
175 # ����� ��������� �������� undef
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
176 private _direct property ObjectFactory => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
177
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
178 # ������� �������������������� �������.
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
179 # SurogateHelper($Type)
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
180 # $Type ��� �����, ��� ������� ����� �������.
115
5edc2ac5231c minor fix to the serialization mechanism
wizard
parents: 60
diff changeset
181 private _direct property SurrogateHelper => prop_all;
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
182 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
183
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
184 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
185 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
186 $this->{$CurrentObject} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
187 $this->{$Root} = undef;
115
5edc2ac5231c minor fix to the serialization mechanism
wizard
parents: 60
diff changeset
188 $this->{$ObjectFactory} = $args{ObjectFactory} if $args{ObjectFactory};
5edc2ac5231c minor fix to the serialization mechanism
wizard
parents: 60
diff changeset
189 $this->{$SurrogateHelper} = $args{SurrogateHelper} if $args{SurrogateHelper};
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
190 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
191
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
192 sub OnObjectBegin {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
193 my ($this,$name,$rhProps) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
194
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
195 die new Exception("Invalid data from an ObjectReader","An object reader should pass a referense to a hash which contains attributes of an object") if (ref $rhProps ne 'HASH');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
196 die new Exception("Trying to create second root object") if not $this->{$CurrentObject} and $this->{$Root};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
197
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
198 if ($rhProps->{'refid'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
199 my $refObj = $this->{$Context}->{$rhProps->{'refid'}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
200 die new Exception("A reference to a not existing object found") if not $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
201 my $rhCurrentObj = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
202
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
203 die new Exception("Found a reference to an object as a root of an object's graph") if not $rhCurrentObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
204
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
205 if ($rhCurrentObj->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
206 die new Exception("Invalid serializaed data","Plain deserialization data for an object already exist") if not ref $rhCurrentObj->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
207 push @{$rhCurrentObj->{'Data'}}, $name,$refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
208 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
209 $rhCurrentObj->{'Data'} = [$name,$refObj];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
210 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
211
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
212 # ��� �����, ��� ����� ������ OnObjectEnd ��� �������, ������� ��� ������� �������. �.�. �� �� ������� ����
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
213 push @{$this->{$ObjectsPath}},$rhCurrentObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
214 $this->{$CurrentObject} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
215
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
216 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
217 push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
218
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
219 $this->{$CurrentObject} = {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
220 Name => $name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
221 Type => $rhProps->{'type'} || 'SCALAR',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
222 Id => $rhProps->{'id'},
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
223 refId => $rhProps->{'refid'}
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
224 };
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
225
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
226 if (defined $rhProps->{'id'}) {
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
227 die new IMPL::Exception("Trying to create a simple object instead of a reference, type is missing.",$name,$rhProps->{id}) unless $rhProps->{'type'} ;
115
5edc2ac5231c minor fix to the serialization mechanism
wizard
parents: 60
diff changeset
228 $this->{$Context}->{$rhProps->{'id'}} = $this->{$SurrogateHelper} ? $this->{$SurrogateHelper}->($rhProps->{'type'}) : DefaultSurrogateHelper($rhProps->{'type'});
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
229 }
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
230 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
231
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
232 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
233 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
234
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
235 sub OnObjectData {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
236 my ($this,$data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
237
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
238 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
239
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
240 die new Exception("Trying to set data for an object which not exists") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
241
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
242 die new Exception("Deserialization data already exists for a current object", "ObjectName= $rhObject->{'Name'}") if $rhObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
243
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
244 $rhObject->{'Data'} = $data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
245
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
246 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
247 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
248 {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
249 my $AutoId = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
250 sub OnObjectEnd {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
251 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
252
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
253 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
254 my $rhPrevObject = pop @{$this->{$ObjectsPath}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
255
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
256 # ���� ������� ������ �� ���������, � ���������� - ���������, ������ ������� - ��� ������
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
257 # ������ ��������������� ���������� � ������� � ������ ����� �� ������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
258 if ((not defined($rhObject)) && $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
259 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
260 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
261 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
262
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
263 my $refObj = $this->{$ObjectFactory} ?$this->{$ObjectFactory}->($rhObject->{'Type'},$rhObject->{'Data'},$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef) : DefaultFactory($rhObject->{'Type'},$rhObject->{'Data'},$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
264
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
265 die new Exception("Trying to close a non existing oject") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
266
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
267 my $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
268
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
269 if ($rhObject->{'Id'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
270 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
271 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
272 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
273 if (ref $refObj ne 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
274 $rhObject->{Id} = "auto$AutoId";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
275 $AutoId ++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
276 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
277 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
278 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
279 $Data = ${$refObj};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
280 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
281 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
282
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
283 if (not $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
284 $this->{$Root} = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
285 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
286 if ($rhPrevObject->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
287 die new Exception("Trying append a reference to an object to the plain data") if not ref $rhPrevObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
288 push @{$rhPrevObject->{'Data'}},$rhObject->{'Name'},$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
289 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
290 $rhPrevObject->{'Data'} = [$rhObject->{'Name'},$Data];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
291 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
292 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
293
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
294 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
295
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
296 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
297 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
298 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
299
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
300 sub _is_class {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
301 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
302 scalar keys %{"$_[0]::"} ? 1 : 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
303 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
304
115
5edc2ac5231c minor fix to the serialization mechanism
wizard
parents: 60
diff changeset
305 sub DefaultSurrogateHelper {
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
306 my ($Type) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
307
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
308 if ($Type eq 'SCALAR' or $Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
309 my $var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
310 return \$var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
311 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
312 return [];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
313 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
314 return {};
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
315 } elsif ($Type) {
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
316 eval "require $Type" unless _is_class($Type);
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
317 if (UNIVERSAL::can($Type,'surrogate')) {
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
318 return $Type->surrogate();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
319 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
320 return bless {}, $Type;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
321 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
322 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
323 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
324
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
325 # deserialization context:
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
326 # [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
327 # 'var_name',value,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
328 # ....
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
329 # ]
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
330
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
331 sub DefaultFactory {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
332 my ($Type,$Data,$refSurogate) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
333
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
334 if ($Type eq 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
335 die new Exception("SCALAR needs a plain data for a deserialization") if ref $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
336 if ($refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
337 $$refSurogate = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
338 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
339 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
340 return \$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
341 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
342 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
343 die new Exception("Invalid a deserialization context when deserializing ARRAY") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
344 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
345 my @Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
346 $refSurogate = \@Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
347 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
348 for (my $i = 0; $i < scalar(@{$Data})/2; $i++) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
349 push @$refSurogate,$Data->[$i*2+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
350 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
351 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
352 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
353 die new Exception("Invalid a deserialization context when deserializing HASH") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
354 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
355 $refSurogate = {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
356 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
357 for (my $i = 0; $i< @$Data; $i+= 2) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
358 $refSurogate->{$Data->[$i]} = $Data->[$i+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
359 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
360 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
361 } elsif ($Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
362 die new Exception("Invalid a deserialization context when deserializing REF") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
363 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
364 my $ref = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
365 return \$ref;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
366 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
367 $$refSurogate = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
368 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
369 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
370 } else {
140
fb896377389f to_json and escape_string functions for the templates
wizard
parents: 115
diff changeset
371 eval "require $Type; 1;" or warn $@ unless _is_class($Type);
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
372 if ( $Type->UNIVERSAL::can('restore') ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
373 return $Type->restore($Data,$refSurogate);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
374 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
375 die new Exception("Don't know how to deserialize $Type");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
376 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
377 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
378 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
379
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
380 package IMPL::Serializer;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
381 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
382
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
383 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
384 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
385 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
386
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
387 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
388 private _direct property Formatter => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
389 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
390
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
391 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
392 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
393 $this->Formatter($args{'Formatter'}) or die new Exception("Omitted mandatory parameter 'Formatter'");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
394 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
395
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
396 sub Serialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
397 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
398 my ($hStream,$Object) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
399 my $ObjWriter = $this->Formatter()->CreateWriter($hStream);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
400 my $Context = new IMPL::Serialization::Context(ObjectWriter => $ObjWriter);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
401 $Context->AddVar('root',$Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
402 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
403 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
404
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
405 sub Deserialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
406 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
407 my ($hStream) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
408 my $Context = new IMPL::Deserialization::Context();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
409 my $ObjReader = $this->Formatter()->CreateReader($hStream,$Context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
410 $ObjReader->Parse();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
411 return $Context->Root();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
412 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
413
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
414 1;