annotate Lib/IMPL/Serialization.pm @ 94:79bf75223afe

Fixed security related bugs
author wizard
date Thu, 29 Apr 2010 01:31:27 +0400
parents b0c068da93ac
children 5edc2ac5231c
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 ��� �����, ��� ������� ����� �������.
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
181 private _direct property SurogateHelper => prop_all;
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;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
188 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
189
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
190 sub OnObjectBegin {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
191 my ($this,$name,$rhProps) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
192
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
193 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
194 die new Exception("Trying to create second root object") if not $this->{$CurrentObject} and $this->{$Root};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
195
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
196 if ($rhProps->{'refid'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
197 my $refObj = $this->{$Context}->{$rhProps->{'refid'}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
198 die new Exception("A reference to a not existing object found") if not $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
199 my $rhCurrentObj = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
200
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
201 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
202
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
203 if ($rhCurrentObj->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
204 die new Exception("Invalid serializaed data","Plain deserialization data for an object already exist") if not ref $rhCurrentObj->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
205 push @{$rhCurrentObj->{'Data'}}, $name,$refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
206 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
207 $rhCurrentObj->{'Data'} = [$name,$refObj];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
208 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
209
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
210 # ��� �����, ��� ����� ������ OnObjectEnd ��� �������, ������� ��� ������� �������. �.�. �� �� ������� ����
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
211 push @{$this->{$ObjectsPath}},$rhCurrentObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
212 $this->{$CurrentObject} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
213
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
214 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
215 push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
216
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
217 $this->{$CurrentObject} = {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
218 Name => $name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
219 Type => $rhProps->{'type'} || 'SCALAR',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
220 Id => $rhProps->{'id'},
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
221 refId => $rhProps->{'refid'}
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
222 };
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
223
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
224 if (defined $rhProps->{'id'}) {
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
225 die new IMPL::Exception("Trying to create a simple object instead of a reference, type is missing.",$name,$rhProps->{id}) unless $rhProps->{'type'} ;
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
226 $this->{$Context}->{$rhProps->{'id'}} = $this->{$SurogateHelper} ? $this->{$SurogateHelper}->($rhProps->{'type'}) : DefaultSurogateHelper($rhProps->{'type'});
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
227 }
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
228 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
229
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
230 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
231 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
232
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
233 sub OnObjectData {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
234 my ($this,$data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
235
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
236 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
237
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
238 die new Exception("Trying to set data for an object which not exists") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
239
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
240 die new Exception("Deserialization data already exists for a current object", "ObjectName= $rhObject->{'Name'}") if $rhObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
241
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
242 $rhObject->{'Data'} = $data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
243
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
244 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
245 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
246 {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
247 my $AutoId = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
248 sub OnObjectEnd {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
249 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
250
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
251 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
252 my $rhPrevObject = pop @{$this->{$ObjectsPath}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
253
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
254 # ���� ������� ������ �� ���������, � ���������� - ���������, ������ ������� - ��� ������
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
255 # ������ ��������������� ���������� � ������� � ������ ����� �� ������
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
256 if ((not defined($rhObject)) && $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
257 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
258 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
259 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
260
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
261 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
262
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
263 die new Exception("Trying to close a non existing oject") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
264
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
265 my $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
266
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
267 if ($rhObject->{'Id'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
268 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
269 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
270 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
271 if (ref $refObj ne 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
272 $rhObject->{Id} = "auto$AutoId";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
273 $AutoId ++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
274 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
275 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
276 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
277 $Data = ${$refObj};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
278 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
279 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
280
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
281 if (not $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
282 $this->{$Root} = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
283 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
284 if ($rhPrevObject->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
285 die new Exception("Trying append a reference to an object to the plain data") if not ref $rhPrevObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
286 push @{$rhPrevObject->{'Data'}},$rhObject->{'Name'},$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
287 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
288 $rhPrevObject->{'Data'} = [$rhObject->{'Name'},$Data];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
289 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
290 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
291
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
292 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
293
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
294 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
295 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
296 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
297
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
298 sub _is_class {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
299 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
300 scalar keys %{"$_[0]::"} ? 1 : 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
301 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
302
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
303 sub DefaultSurogateHelper {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
304 my ($Type) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
305
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
306 if ($Type eq 'SCALAR' or $Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
307 my $var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
308 return \$var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
309 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
310 return [];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
311 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
312 return {};
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
313 } elsif ($Type) {
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
314 eval "require $Type" unless _is_class($Type);
60
b0c068da93ac Lazy activation for the configuration objects (final concept)
wizard
parents: 49
diff changeset
315 if (UNIVERSAL::can($Type,'surrogate')) {
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
316 return $Type->surrogate();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
317 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
318 return bless {}, $Type;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
319 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
320 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
321 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
322
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
323 # deserialization context:
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
324 # [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
325 # 'var_name',value,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
326 # ....
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
327 # ]
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
328
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
329 sub DefaultFactory {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
330 my ($Type,$Data,$refSurogate) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
331
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
332 if ($Type eq 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
333 die new Exception("SCALAR needs a plain data for a deserialization") if ref $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
334 if ($refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
335 $$refSurogate = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
336 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
337 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
338 return \$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
339 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
340 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
341 die new Exception("Invalid a deserialization context when deserializing ARRAY") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
342 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
343 my @Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
344 $refSurogate = \@Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
345 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
346 for (my $i = 0; $i < scalar(@{$Data})/2; $i++) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
347 push @$refSurogate,$Data->[$i*2+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
348 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
349 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
350 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
351 die new Exception("Invalid a deserialization context when deserializing HASH") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
352 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
353 $refSurogate = {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
354 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
355 for (my $i = 0; $i< @$Data; $i+= 2) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
356 $refSurogate->{$Data->[$i]} = $Data->[$i+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
357 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
358 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
359 } elsif ($Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
360 die new Exception("Invalid a deserialization context when deserializing REF") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
361 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
362 my $ref = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
363 return \$ref;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
364 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
365 $$refSurogate = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
366 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
367 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
368 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
369 eval "require $Type" unless _is_class($Type);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
370 if ( $Type->UNIVERSAL::can('restore') ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
371 return $Type->restore($Data,$refSurogate);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
372 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
373 die new Exception("Don't know how to deserialize $Type");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
374 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
375 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
376 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
377
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
378 package IMPL::Serializer;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
379 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
380
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
381 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
382 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
383 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
384
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
385 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
386 private _direct property Formatter => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
387 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
388
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
389 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
390 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
391 $this->Formatter($args{'Formatter'}) or die new Exception("Omitted mandatory parameter 'Formatter'");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
392 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
393
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
394 sub Serialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
395 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
396 my ($hStream,$Object) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
397 my $ObjWriter = $this->Formatter()->CreateWriter($hStream);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
398 my $Context = new IMPL::Serialization::Context(ObjectWriter => $ObjWriter);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
399 $Context->AddVar('root',$Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
400 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
401 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
402
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
403 sub Deserialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
404 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
405 my ($hStream) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
406 my $Context = new IMPL::Deserialization::Context();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
407 my $ObjReader = $this->Formatter()->CreateReader($hStream,$Context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
408 $ObjReader->Parse();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
409 return $Context->Root();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
410 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
411
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
412 1;