Mercurial > pub > Impl

comparison lib/IMPL/Serialization.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Serialization;
2 use strict;
3
4 package IMPL::Serialization::Context;
5
6 use IMPL::Exception();
7 use Scalar::Util qw(refaddr);
8
9 use IMPL::Const qw(:prop);
10 use IMPL::declare {
11 base => [ 'IMPL::Object' => undef ],
12 props => [
13 _objectWriter => PROP_RW | PROP_DIRECT,
14 _context => PROP_RW | PROP_DIRECT,
15 _nextId => PROP_RW | PROP_DIRECT,
16 serializer => PROP_RW | PROP_DIRECT,
17 _state => PROP_RW | PROP_DIRECT
18 ]
19 };
20
21 sub STATE_CLOSED () { 0 }
22 sub STATE_OPENED () { 1 }
23 sub STATE_COMPLEX () { 2 }
24 sub STATE_DATA () { 3 }
25
26 sub CTOR {
27 my ( $this, %args ) = @_;
28
29 $this->{$_objectWriter} = $args{'ObjectWriter'};
30 $this->{$_nextId} = 1;
31 $this->{$serializer} =
32 ( $args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer );
33 $this->{$_state} = STATE_CLOSED;
34
35 return 1;
36 }
37
38 sub AddVar {
39 my ( $this, $sName, $Var ) = @_;
40
41 die new Exception('Invalid operation') if $this->{$_state} == STATE_DATA;
42
43 if ( not ref $Var ) {
44 my $prevState = $this->{$_state};
45
46 $this->{$_objectWriter}->BeginObject( name => $sName );
47 $this->{$_state} = STATE_OPENED;
48
49 $this->{$serializer}->( $this, \$Var );
50
51 $this->{$_objectWriter}->EndObject();
52
53 if ( $prevState == STATE_OPENED ) {
54 $this->{$_state} = STATE_COMPLEX;
55 }
56 else {
57 $this->{$_state} = $prevState;
58 }
59 return 0;
60 }
61
62 my $PrevState = $this->{$_state};
63
64 my $ObjID = $this->{$_context}->{ refaddr $Var};
65 if ($ObjID) {
66 $this->{$_objectWriter}->BeginObject( name => $sName, refid => $ObjID );
67 $this->{$_objectWriter}->EndObject();
68 return $ObjID;
69 }
70
71 $ObjID = $this->{$_nextId};
72 $this->{$_nextId} = $ObjID + 1;
73
74 $this->{$_context}->{ refaddr $Var} = $ObjID;
75
76 $this->{$_objectWriter}
77 ->BeginObject( name => $sName, type => ref($Var), id => $ObjID );
78
79 $this->{$_state} = STATE_OPENED;
80 $this->{$serializer}->( $this, $Var );
81
82 $this->{$_objectWriter}->EndObject();
83
84 if ( $PrevState == STATE_OPENED ) {
85 $this->{$_state} = STATE_COMPLEX;
86 }
87 else {
88 $this->{$_state} = $PrevState;
89 }
90
91 return $ObjID;
92 }
93
94 sub SetData {
95 my ( $this, $data, $type ) = @_;
96
97 die new Exception('The object should be a scalar value') if ref $data;
98 die new Exception('Invalid operation') if $this->{$_state} != STATE_OPENED;
99
100 $this->{$_objectWriter}->SetData( $data, $type );
101
102 $this->{$_state} = STATE_DATA;
103
104 return 1;
105 }
106
107 sub DefaultSerializer {
108 my ( $_context, $refObj ) = @_;
109
110 if ( ref($refObj) eq 'SCALAR' ) {
111 $_context->SetData( $$refObj, 'SCALAR' );
112 }
113 elsif ( ref($refObj) eq 'ARRAY' ) {
114 $_context->AddVar( 'item', $_ ) foreach @$refObj;
115 }
116 elsif ( ref($refObj) eq 'HASH' ) {
117 while ( my ( $key, $value ) = each %$refObj ) {
118 $_context->AddVar( $key, $value );
119 }
120 }
121 elsif ( ref($refObj) eq 'REF' ) {
122 $_context->AddVar( 'ref', $$refObj );
123 }
124 else {
125 if ( ref $refObj and $refObj->UNIVARSAL::can('save') ) {
126 $refObj->save($_context);
127 }
128 else {
129 die new Exception(
130 'Cant serialize the object of the type: ' . ref($refObj) );
131 }
132 }
133
134 return 1;
135 }
136
137 package IMPL::Deserialization::Context;
138
139 use IMPL::Const qw(:prop);
140 use IMPL::declare {
141 require => {
142 Exception => 'IMPL::Exception',
143 Loader => 'IMPL::Code::Loader'
144 },
145 base => [ 'IMPL::Object' => undef ],
146 props => [
147
148 # структура информации об объекте
149 # {
150 # Type => 'typename',
151 # Name => 'object_name',
152 # Data => $data,
153 # Id => 'object_id'
154 # }
155 _context => PROP_RW | PROP_DIRECT,
156 _currentObject => PROP_RW | PROP_DIRECT,
157 _objectsPath => PROP_RW | PROP_DIRECT,
158 root => PROP_RW | PROP_DIRECT
159 ]
160 };
161
162 sub CTOR {
163 my ( $this, %args ) = @_;
164 $this->{$_currentObject} = undef;
165 $this->{$root} = undef;
166 }
167
168 sub OnObjectBegin {
169 my ( $this, $name, $rhProps ) = @_;
170
171 die Exception->new(
172 "Invalid data from an ObjectReader",
173 "An object reader should pass a referense to a hash which contains attributes of an object"
174 ) if ( ref $rhProps ne 'HASH' );
175
176 die Exception->new("Trying to create second root object")
177 if not $this->{$_currentObject} and $this->{$root};
178
179 if ( $rhProps->{'refid'} ) {
180
181 my $refObj = $this->{$_context}->{ $rhProps->{'refid'} };
182
183 die Exception->new("A reference to a not existing object found")
184 if not $refObj;
185
186 my $rhCurrentObj = $this->{$_currentObject};
187
188 die Exception->new("The root object can't be a reference")
189 if not $rhCurrentObj;
190
191 if ( $rhCurrentObj->{'Data'} ) {
192
193 die Exception->new( "Invalid serializaed data",
194 "Plain deserialization data for an object already exist" )
195 if not ref $rhCurrentObj->{'Data'};
196
197 push @{ $rhCurrentObj->{'Data'} }, $name, $refObj;
198 } else {
199 $rhCurrentObj->{'Data'} = [ $name, $refObj ];
200 }
201
202 push @{ $this->{$_objectsPath} }, $rhCurrentObj;
203 $this->{$_currentObject} = undef;
204
205 } else {
206 push @{ $this->{$_objectsPath} }, $this->{$_currentObject}
207 if $this->{$_currentObject};
208
209 $this->{$_currentObject} = {
210 Name => $name,
211 Type => $rhProps->{'type'} || 'SCALAR',
212 Id => $rhProps->{'id'},
213 refId => $rhProps->{'refid'}
214 };
215
216 if ( defined $rhProps->{'id'} ) {
217 die new IMPL::Exception(
218 "Trying to create a simple object instead of a reference, type is missing.",
219 $name, $rhProps->{id}
220 ) unless $rhProps->{'type'};
221
222 $this->{$_context}->{ $rhProps->{'id'} } = $this->CreateSurrogate( $rhProps->{'type'} );
223 }
224 }
225
226 return 1;
227 }
228
229 sub OnObjectData {
230 my ( $this, $data ) = @_;
231
232 my $rhObject = $this->{$_currentObject};
233
234 die Exception->new("Trying to set data for an object which not exists")
235 if not $rhObject;
236
237 #die Exception->new(
238 # "Deserialization data already exists for a current object",
239 # "ObjectName= $rhObject->{'Name'}" )
240 # if $rhObject->{'Data'};
241
242 $rhObject->{'Data'} .= $data;
243
244 return 1;
245 }
246 {
247 my $autoId = 0;
248
249 sub OnObjectEnd {
250 my ( $this, $name ) = @_;
251
252 my $rhObject = $this->{$_currentObject};
253 my $rhPrevObject = pop @{ $this->{$_objectsPath} };
254
255 if ( ( not defined($rhObject) ) && $rhPrevObject ) {
256 $this->{$_currentObject} = $rhPrevObject;
257 return 1;
258 }
259
260 my $refObj = $this->CreateObject(
261 $rhObject->{'Type'},
262 $rhObject->{'Data'},
263 $rhObject->{'Id'}
264 ? $this->{$_context}->{ $rhObject->{'Id'} }
265 : undef
266 );
267
268 die Exception->new("Trying to close a non existing oject")
269 if not $rhObject;
270
271 my $data;
272
273 if ( $rhObject->{'Id'} ) {
274 $this->{$_context}->{ $rhObject->{'Id'} } = $refObj;
275 $data = $refObj;
276 }
277 else {
278 if ( ref $refObj ne 'SCALAR' ) {
279 $rhObject->{Id} = "auto$autoId";
280 $autoId++;
281 $this->{$_context}->{ $rhObject->{'Id'} } = $refObj;
282 $data = $refObj;
283 }
284 else {
285 $data = ${$refObj};
286 }
287 }
288
289 if ( not $rhPrevObject ) {
290 $this->{$root} = $data;
291 }
292 else {
293 if ( $rhPrevObject->{'Data'} ) {
294 die Exception->new(
295 "Trying append a reference to an object to the plain data")
296 if not ref $rhPrevObject->{'Data'};
297
298 push @{ $rhPrevObject->{'Data'} }, $rhObject->{'Name'}, $data;
299 }
300 else {
301 $rhPrevObject->{'Data'} = [ $rhObject->{'Name'}, $data ];
302 }
303 }
304
305 $this->{$_currentObject} = $rhPrevObject;
306
307 return 1;
308 }
309 }
310
311 sub CreateSurrogate {
312 my ($this,$type) = @_;
313
314 if ( $type eq 'SCALAR' or $type eq 'REF' ) {
315 my $var;
316 return \$var;
317 }
318 elsif ( $type eq 'ARRAY' ) {
319 return [];
320 }
321 elsif ( $type eq 'HASH' ) {
322 return {};
323 }
324 elsif ($type) {
325 Loader->safe->Require($type);
326 if ( eval { $type->can('surrogate') } ) {
327 return $type->surrogate();
328 }
329 else {
330 return bless {}, $type;
331 }
332 }
333 }
334
335 # deserialization context:
336 # [
337 # 'var_name',value,
338 # ....
339 # ]
340
341 sub CreateObject {
342 my ($this, $type, $data, $refSurogate ) = @_;
343
344 if ( $type eq 'SCALAR' ) {
345 die Exception->new("SCALAR needs a plain data for a deserialization")
346 if ref $data;
347 if ($refSurogate) {
348 $$refSurogate = $data;
349 return $refSurogate;
350 }
351 else {
352 return \$data;
353 }
354 }
355 elsif ( $type eq 'ARRAY' ) {
356 $data ||= [];
357 die Exception->new(
358 "Invalid a deserialization context when deserializing ARRAY")
359 if not ref $data and defined $data;
360 if ( not ref $refSurogate ) {
361 my @Array;
362 $refSurogate = \@Array;
363 }
364 for ( my $i = 0 ; $i < scalar( @{$data} ) / 2 ; $i++ ) {
365 push @$refSurogate, $data->[ $i * 2 + 1 ];
366 }
367 return $refSurogate;
368 }
369 elsif ( $type eq 'HASH' ) {
370 $data ||= [];
371 die Exception->new(
372 "Invalid a deserialization context when deserializing HASH")
373 if not ref $data and defined $data;
374 if ( not ref $refSurogate ) {
375 $refSurogate = {};
376 }
377 for ( my $i = 0 ; $i < @$data ; $i += 2 ) {
378 $refSurogate->{ $data->[$i] } = $data->[ $i + 1 ];
379 }
380 return $refSurogate;
381 }
382 elsif ( $type eq 'REF' ) {
383 $data ||= [];
384 die Exception->new(
385 "Invalid a deserialization context when deserializing REF")
386 if not ref $data and defined $data;
387 if ( not ref $refSurogate ) {
388 my $ref = $data->[1];
389 return \$ref;
390 }
391 else {
392 $$refSurogate = $data->[1];
393 return $refSurogate;
394 }
395 }
396 else {
397 Loader->safe->Require($type);
398 if ( eval { $type->can('restore') } ) {
399 return $type->restore( $data, $refSurogate );
400 }
401 else {
402 die Exception->new("Don't know how to deserialize $type");
403 }
404 }
405 }
406
407 package IMPL::Serializer;
408
409 use IMPL::Const qw(:prop);
410 use IMPL::declare {
411 require => {
412 Exception => 'IMPL::Exception',
413 SerializationContext => '-IMPL::Serialization::Context',
414 DeserializationContext => '-IMPL::Deserialization::Context'
415 },
416 base => [
417 'IMPL::Object' => undef
418 ],
419 props => [
420 _formatter => PROP_RW
421 ]
422 };
423
424 sub CTOR {
425 my ( $this, %args ) = @_;
426 $this->_formatter( $args{formatter} )
427 or die Exception->new("Omitted mandatory parameter 'formatter'");
428 }
429
430 sub Serialize {
431 my $this = shift;
432 my ( $hStream, $Object ) = @_;
433 my $ObjWriter = $this->_formatter->CreateWriter($hStream);
434 my $context =
435 SerializationContext->new( objectWriter => $ObjWriter );
436 $context->AddVar( 'root', $Object );
437 return 1;
438 }
439
440 sub Deserialize {
441 my $this = shift;
442 my ($hStream) = @_;
443 my $context = DeserializationContext->new();
444 my $ObjReader = $this->_formatter->CreateReader( $hStream, $context );
445 $ObjReader->Parse();
446 return $context->root;
447 }
448
449 1;