Mercurial > pub > Impl

comparison Lib/IMPL/Serialization.pm @ 49:16ada169ca75

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
migrating to the Eclipse IDE
author wizard@linux-odin.local
date Fri, 26 Feb 2010 10:49:21 +0300
parents 03e58a454b20
children b0c068da93ac
comparison
equal deleted inserted replaced
48:1c3c3e63a314 49:16ada169ca75
1
2 # 20060222
3 # Модуль для сериализации структур данных
4 # (ц) Sourcer, cin.sourcer@gmail.com
5 # revision 3 (20090517)
6
7
8 package IMPL::Serialization; 1 package IMPL::Serialization;
9 use strict; 2 use strict;
3
4 # 20060222
5 # пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
6 # (пїЅ) Sourcer, cin.sourcer@gmail.com
7 # revision 3 (20090517)
8
10 9
11 package IMPL::Serialization::Context; 10 package IMPL::Serialization::Context;
12 use base qw(IMPL::Object); 11 use base qw(IMPL::Object);
13 12
14 use IMPL::Class::Property; 13 use IMPL::Class::Property;
15 use IMPL::Class::Property::Direct; 14 use IMPL::Class::Property::Direct;
16 use IMPL::Exception; 15 use IMPL::Exception;
17 use Scalar::Util qw(refaddr); 16 use Scalar::Util qw(refaddr);
18 17
19 BEGIN { 18 BEGIN {
20 private _direct property ObjectWriter => prop_all; # объект, записывающий данные в поток 19 private _direct property ObjectWriter => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅ
21 private _direct property Context => prop_all; # контекст (объекты которые уже сериализованы, их идентификаторы) 20 private _direct property Context => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ (пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ)
22 private _direct property NextID => prop_all;# следующий идентификатор для объекта 21 private _direct property NextID => prop_all;# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ
23 22
24 # процедура, которая знает, как сериализовывать определенные типы. Первым параметром 23 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
25 # получаем ссылку на IMPL::Serialization::Context, вторым параметром ссылку на объект 24 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ IMPL::Serialization::Context, пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
26 public _direct property Serializer => prop_all; 25 public _direct property Serializer => prop_all;
27 26
28 private _direct property State => prop_all; # состояние контекста сериализации 27 private _direct property State => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
29 } 28 }
30 29
31 # контекст закрыт, т.е. никакой объект не начат 30 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
32 sub STATE_CLOSED () { 0 } 31 sub STATE_CLOSED () { 0 }
33 # контекст открыт, т.е. объект начат, но в нем еще ничего не лежит 32 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅ пїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
34 sub STATE_OPENED () { 1 } 33 sub STATE_OPENED () { 1 }
35 # контекст открыт и в него могут быть добавлены только подобъекты 34 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
36 sub STATE_COMPLEX () { 2 } 35 sub STATE_COMPLEX () { 2 }
37 # контекст открыт и в него уже ничего не может быть добавлено, там лежат данные 36 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
38 sub STATE_DATA () { 3 } 37 sub STATE_DATA () { 3 }
39 38
40 sub CTOR { 39 sub CTOR {
41 my ($this,%args) = @_; 40 my ($this,%args) = @_;
42 41
53 my ($this,$sName,$Var) = @_; 52 my ($this,$sName,$Var) = @_;
54 53
55 die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA; 54 die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA;
56 55
57 if (not ref $Var) { 56 if (not ref $Var) {
58 # немного дублируется то, что снизу, но это ради того, чтобы объекты, которые идут 57 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ
59 # не по ссылке, не получали идентификатора, им он не нужен 58 # пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ
60 my $prevState = $this->{$State}; 59 my $prevState = $this->{$State};
61 60
62 $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR'); 61 $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR');
63 $this->{$State} = STATE_OPENED; 62 $this->{$State} = STATE_OPENED;
64 63
147 use IMPL::Class::Property; 146 use IMPL::Class::Property;
148 use IMPL::Class::Property::Direct; 147 use IMPL::Class::Property::Direct;
149 use IMPL::Exception; 148 use IMPL::Exception;
150 149
151 BEGIN { 150 BEGIN {
152 # уже десериализованные объекты, хеш, ключ - идентификатор, значение - ссылка. 151 # пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ, пїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅ.
153 private _direct property Context => prop_all; 152 private _direct property Context => prop_all;
154 153
155 # текущий объект. информация для десериализации 154 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
156 # { 155 # {
157 # Type => 'typename', 156 # Type => 'typename',
158 # Name => 'object_name', 157 # Name => 'object_name',
159 # Data => $Data, 158 # Data => $Data,
160 # Id => 'object_id' 159 # Id => 'object_id'
161 # } 160 # }
162 private _direct property CurrentObject => prop_all; 161 private _direct property CurrentObject => prop_all;
163 162
164 # стек объектов. сюда добавляются описания объектов по мере встречания новых объектов. 163 # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ.
165 private _direct property ObjectsPath => prop_all; 164 private _direct property ObjectsPath => prop_all;
166 165
167 # сюда попадет корень графа объектов 166 # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ
168 public _direct property Root => prop_get; 167 public _direct property Root => prop_get;
169 168
170 # создает объект и возвращает на него ссылку 169 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
171 # ObjectFactory($Type,$DeserializationData,$refSurogate) 170 # ObjectFactory($Type,$DeserializationData,$refSurogate)
172 # $Type - имя типа данных 171 # $Type - пїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
173 # $DeserializationData - либо ссылка на массив с данными для десериализации полей, 172 # $DeserializationData - пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ,
174 # либо скаляр содержащий данные. 173 # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ.
175 # $refSurogate - ссылка на предварительно созданный, не инициализированный объект. 174 # $refSurogate - пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ.
176 # может принимать значение undef 175 # пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ undef
177 private _direct property ObjectFactory => prop_all; 176 private _direct property ObjectFactory => prop_all;
178 177
179 # Создает неинициализированные объекты. 178 # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ.
180 # SurogateHelper($Type) 179 # SurogateHelper($Type)
181 # $Type имя типпа, чей сурогат нужно создать. 180 # $Type пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ.
182 private _direct property SurogateHelper => prop_all; 181 private _direct property SurogateHelper => prop_all;
183 } 182 }
184 183
185 sub CTOR { 184 sub CTOR {
186 my ($this,%args) = @_; 185 my ($this,%args) = @_;
206 push @{$rhCurrentObj->{'Data'}}, $name,$refObj; 205 push @{$rhCurrentObj->{'Data'}}, $name,$refObj;
207 } else { 206 } else {
208 $rhCurrentObj->{'Data'} = [$name,$refObj]; 207 $rhCurrentObj->{'Data'} = [$name,$refObj];
209 } 208 }
210 209
211 # это затем, что будет вызван OnObjectEnd для объекта, который был простой ссылкой. т.о. мы не нарушим стек 210 # пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ OnObjectEnd пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ. пїЅ.пїЅ. пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ
212 push @{$this->{$ObjectsPath}},$rhCurrentObj; 211 push @{$this->{$ObjectsPath}},$rhCurrentObj;
213 $this->{$CurrentObject} = undef; 212 $this->{$CurrentObject} = undef;
214 213
215 } else { 214 } else {
216 push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject}; 215 push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
246 my ($this,$name) = @_; 245 my ($this,$name) = @_;
247 246
248 my $rhObject = $this->{$CurrentObject}; 247 my $rhObject = $this->{$CurrentObject};
249 my $rhPrevObject = pop @{$this->{$ObjectsPath}}; 248 my $rhPrevObject = pop @{$this->{$ObjectsPath}};
250 249
251 # если текущий объект не определен, а предыдущий - определен, значит текущий - это ссылка 250 # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ - пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
252 # просто восстанавливаем предыдущий в текущий и ничего более не делаем 251 # пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ
253 if ((not defined($rhObject)) && $rhPrevObject) { 252 if ((not defined($rhObject)) && $rhPrevObject) {
254 $this->{$CurrentObject} = $rhPrevObject; 253 $this->{$CurrentObject} = $rhPrevObject;
255 return 1; 254 return 1;
256 } 255 }
257 256