annotate Lib/IMPL/Serialization.pm @ 339:97628101b765

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