Mercurial > pub > Impl

comparison Lib/IMPL/Serialization.pm @ 278:4ddb27ff4a0b

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