annotate Lib/IMPL/Serialization.pm @ 1:3b418b134d8c

ORM in progress
author Sergey
date Fri, 17 Jul 2009 13:30:46 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 # 20060222
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 # Ìîäóëü äëÿ ñåðèàëèçàöèè ñòðóêòóð äàííûõ
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 # (ö) Sourcer, cin.sourcer@gmail.com
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 # revision 3 (20090517)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 package IMPL::Serialization;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 package IMPL::Serialization::Context;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 use Scalar::Util qw(refaddr);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 private _direct property ObjectWriter => prop_all; # îáúåêò, çàïèñûâàþùèé äàííûå â ïîòîê
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 private _direct property Context => prop_all; # êîíòåêñò (îáúåêòû êîòîðûå óæå ñåðèàëèçîâàíû, èõ èäåíòèôèêàòîðû)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 private _direct property NextID => prop_all;# ñëåäóþùèé èäåíòèôèêàòîð äëÿ îáúåêòà
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 # ïðîöåäóðà, êîòîðàÿ çíàåò, êàê ñåðèàëèçîâûâàòü îïðåäåëåííûå òèïû. Ïåðâûì ïàðàìåòðîì
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 # ïîëó÷àåì ññûëêó íà IMPL::Serialization::Context, âòîðûì ïàðàìåòðîì ññûëêó íà îáúåêò
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 public _direct property Serializer => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 private _direct property State => prop_all; # ñîñòîÿíèå êîíòåêñòà ñåðèàëèçàöèè
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 # êîíòåêñò çàêðûò, ò.å. íèêàêîé îáúåêò íå íà÷àò
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 sub STATE_CLOSED () { 0 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 # êîíòåêñò îòêðûò, ò.å. îáúåêò íà÷àò, íî â íåì åùå íè÷åãî íå ëåæèò
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 sub STATE_OPENED () { 1 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 # êîíòåêñò îòêðûò è â íåãî ìîãóò áûòü äîáàâëåíû òîëüêî ïîäîáúåêòû
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 sub STATE_COMPLEX () { 2 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 # êîíòåêñò îòêðûò è â íåãî óæå íè÷åãî íå ìîæåò áûòü äîáàâëåíî, òàì ëåæàò äàííûå
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 sub STATE_DATA () { 3 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 $this->{$ObjectWriter} = $args{'ObjectWriter'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 #$this->{$Context} = {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 $this->{$NextID} = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 $this->{$Serializer} = ($args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 $this->{$State} = STATE_CLOSED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 sub AddVar {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 my ($this,$sName,$Var) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 if (not ref $Var) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 # íåìíîãî äóáëèðóåòñÿ òî, ÷òî ñíèçó, íî ýòî ðàäè òîãî, ÷òîáû îáúåêòû, êîòîðûå èäóò
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 # íå ïî ññûëêå, íå ïîëó÷àëè èäåíòèôèêàòîðà, èì îí íå íóæåí
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 my $prevState = $this->{$State};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 $this->{$State} = STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 $this->{$Serializer}->($this,\$Var);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 if ($prevState == STATE_OPENED) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 $this->{$State} = STATE_COMPLEX;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 $this->{$State} = $prevState;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 return 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 my $PrevState = $this->{$State};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79 my $ObjID = $this->{$Context}->{refaddr $Var};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 if ($ObjID) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 $this->{$ObjectWriter}->BeginObject(name => $sName, refid => $ObjID);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 return $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 $ObjID = $this->{$NextID};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87 $this->{$NextID} = $ObjID + 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 $this->{$Context}->{refaddr $Var} = $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 $this->{$ObjectWriter}->BeginObject(name => $sName, type => ref($Var), id => $ObjID);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93 $this->{$State} = STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 $this->{$Serializer}->($this,$Var);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96 $this->{$ObjectWriter}->EndObject();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98 if ($PrevState == STATE_OPENED) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 $this->{$State} = STATE_COMPLEX;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 $this->{$State} = $PrevState;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 return $ObjID;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 sub SetData {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108 my ($this,$Data,$Type) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 die new Exception ('The object should be a scalar value') if ref $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111 die new Exception ('Invalid operation') if $this->{$State} != STATE_OPENED;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113 $this->{$ObjectWriter}->SetData($Data,$Type);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115 $this->{$State} = STATE_DATA;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120 sub DefaultSerializer {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121 my ($Context, $refObj) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123 if (ref($refObj) eq 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 $Context->SetData($$refObj, 'SCALAR');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125 } elsif (ref($refObj) eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126 $Context->AddVar('item',$_) foreach @$refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127 } elsif (ref($refObj) eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 while (my ($key,$value) = each %$refObj) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129 $Context->AddVar($key,$value);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 } elsif (ref($refObj) eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 $Context->AddVar('ref',$$refObj);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 if (ref $refObj and $refObj->UNIVARSAL::can('save')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 $refObj->save($Context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137 die new Exception('Cant serialize the object of the type: '.ref($refObj));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144 package IMPL::Deserialization::Context;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
148 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
149 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
150
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
151 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
152 # óæå äåñåðèàëèçîâàííûå îáúåêòû, õåø, êëþ÷ - èäåíòèôèêàòîð, çíà÷åíèå - ññûëêà.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
153 private _direct property Context => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
154
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
155 # òåêóùèé îáúåêò. èíôîðìàöèÿ äëÿ äåñåðèàëèçàöèè
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
156 # {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
157 # Type => 'typename',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
158 # Name => 'object_name',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
159 # Data => $Data,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
160 # Id => 'object_id'
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
161 # }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
162 private _direct property CurrentObject => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
163
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 # ñòåê îáúåêòîâ. ñþäà äîáàâëÿþòñÿ îïèñàíèÿ îáúåêòîâ ïî ìåðå âñòðå÷àíèÿ íîâûõ îáúåêòîâ.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165 private _direct property ObjectsPath => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
166
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
167 # ñþäà ïîïàäåò êîðåíü ãðàôà îáúåêòîâ
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
168 public _direct property Root => prop_get;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
169
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
170 # ñîçäàåò îáúåêò è âîçâðàùàåò íà íåãî ññûëêó
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
171 # ObjectFactory($Type,$DeserializationData,$refSurogate)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
172 # $Type - èìÿ òèïà äàííûõ
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
173 # $DeserializationData - ëèáî ññûëêà íà ìàññèâ ñ äàííûìè äëÿ äåñåðèàëèçàöèè ïîëåé,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
174 # ëèáî ñêàëÿð ñîäåðæàùèé äàííûå.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
175 # $refSurogate - ññûëêà íà ïðåäâàðèòåëüíî ñîçäàííûé, íå èíèöèàëèçèðîâàííûé îáúåêò.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
176 # ìîæåò ïðèíèìàòü çíà÷åíèå undef
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
177 private _direct property ObjectFactory => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
178
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
179 # Ñîçäàåò íåèíèöèàëèçèðîâàííûå îáúåêòû.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
180 # SurogateHelper($Type)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
181 # $Type èìÿ òèïïà, ÷åé ñóðîãàò íóæíî ñîçäàòü.
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
182 private _direct property SurogateHelper => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
183 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
184
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
185 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
186 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
187 $this->{$CurrentObject} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
188 $this->{$Root} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
189 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
190
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
191 sub OnObjectBegin {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
192 my ($this,$name,$rhProps) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
193
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
194 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
195 die new Exception("Trying to create second root object") if not $this->{$CurrentObject} and $this->{$Root};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
196
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
197 if ($rhProps->{'refid'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
198 my $refObj = $this->{$Context}->{$rhProps->{'refid'}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
199 die new Exception("A reference to a not existing object found") if not $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
200 my $rhCurrentObj = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
201
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
202 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
203
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
204 if ($rhCurrentObj->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
205 die new Exception("Invalid serializaed data","Plain deserialization data for an object already exist") if not ref $rhCurrentObj->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
206 push @{$rhCurrentObj->{'Data'}}, $name,$refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
207 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
208 $rhCurrentObj->{'Data'} = [$name,$refObj];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
209 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
210
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
211 # ýòî çàòåì, ÷òî áóäåò âûçâàí OnObjectEnd äëÿ îáúåêòà, êîòîðûé áûë ïðîñòîé ññûëêîé. ò.î. ìû íå íàðóøèì ñòåê
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
212 push @{$this->{$ObjectsPath}},$rhCurrentObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
213 $this->{$CurrentObject} = undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
214
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
215 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
216 push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
217
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
218 $this->{$CurrentObject} = {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
219 Name => $name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
220 Type => $rhProps->{'type'} || 'SCALAR',
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
221 Id => $rhProps->{'id'},
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
222 refId => $rhProps->{'refid'}
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
223 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
224 $this->{$Context}->{$rhProps->{'id'}} = $this->{$SurogateHelper} ? $this->{$SurogateHelper}->($rhProps->{'type'}) : DefaultSurogateHelper($rhProps->{'type'}) if defined $rhProps->{'id'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
225 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
226
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
227 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
228 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
229
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
230 sub OnObjectData {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
231 my ($this,$data) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
232
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
233 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
234
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
235 die new Exception("Trying to set data for an object which not exists") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
236
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
237 die new Exception("Deserialization data already exists for a current object", "ObjectName= $rhObject->{'Name'}") if $rhObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
238
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
239 $rhObject->{'Data'} = $data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
240
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
241 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
242 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
243 {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
244 my $AutoId = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
245 sub OnObjectEnd {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
246 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
247
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
248 my $rhObject = $this->{$CurrentObject};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
249 my $rhPrevObject = pop @{$this->{$ObjectsPath}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
250
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
251 # åñëè òåêóùèé îáúåêò íå îïðåäåëåí, à ïðåäûäóùèé - îïðåäåëåí, çíà÷èò òåêóùèé - ýòî ññûëêà
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
252 # ïðîñòî âîññòàíàâëèâàåì ïðåäûäóùèé â òåêóùèé è íè÷åãî áîëåå íå äåëàåì
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
253 if ((not defined($rhObject)) && $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
254 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
255 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
256 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
257
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
258 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
259
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
260 die new Exception("Trying to close a non existing oject") if not $rhObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
261
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
262 my $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
263
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
264 if ($rhObject->{'Id'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
265 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
266 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
267 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
268 if (ref $refObj ne 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
269 $rhObject->{Id} = "auto$AutoId";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
270 $AutoId ++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
271 $this->{$Context}->{$rhObject->{'Id'}} = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
272 $Data = $refObj;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
273 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
274 $Data = ${$refObj};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
275 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
276 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
277
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
278 if (not $rhPrevObject) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
279 $this->{$Root} = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
280 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
281 if ($rhPrevObject->{'Data'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
282 die new Exception("Trying append a reference to an object to the plain data") if not ref $rhPrevObject->{'Data'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
283 push @{$rhPrevObject->{'Data'}},$rhObject->{'Name'},$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
284 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
285 $rhPrevObject->{'Data'} = [$rhObject->{'Name'},$Data];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
286 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
287 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
288
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
289 $this->{$CurrentObject} = $rhPrevObject;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
290
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
291 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
292 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
293 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
294
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
295 sub _is_class {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
296 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
297 scalar keys %{"$_[0]::"} ? 1 : 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
298 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
299
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
300 sub DefaultSurogateHelper {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
301 my ($Type) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
302
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
303 if ($Type eq 'SCALAR' or $Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
304 my $var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
305 return \$var;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
306 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
307 return [];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
308 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
309 return {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
310 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
311 eval "require $Type" unless _is_class($Type);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
312 if ($Type->UNIVERSAL::can('surrogate')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
313 return $Type->surrogate();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
314 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
315 return bless {}, $Type;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
316 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
317 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
318 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
319
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
320 # deserialization context:
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
321 # [
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
322 # 'var_name',value,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
323 # ....
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
324 # ]
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
325
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
326 sub DefaultFactory {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
327 my ($Type,$Data,$refSurogate) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
328
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
329 if ($Type eq 'SCALAR') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
330 die new Exception("SCALAR needs a plain data for a deserialization") if ref $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
331 if ($refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
332 $$refSurogate = $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
333 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
334 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
335 return \$Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
336 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
337 } elsif ($Type eq 'ARRAY') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
338 die new Exception("Invalid a deserialization context when deserializing ARRAY") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
339 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
340 my @Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
341 $refSurogate = \@Array;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
342 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
343 for (my $i = 0; $i < scalar(@{$Data})/2; $i++) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
344 push @$refSurogate,$Data->[$i*2+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
345 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
346 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
347 } elsif ($Type eq 'HASH') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
348 die new Exception("Invalid a deserialization context when deserializing HASH") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
349 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
350 $refSurogate = {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
351 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
352 for (my $i = 0; $i< @$Data; $i+= 2) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
353 $refSurogate->{$Data->[$i]} = $Data->[$i+1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
354 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
355 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
356 } elsif ($Type eq 'REF') {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
357 die new Exception("Invalid a deserialization context when deserializing REF") if not ref $Data and defined $Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
358 if (not ref $refSurogate) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
359 my $ref = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
360 return \$ref;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
361 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
362 $$refSurogate = $Data->[1];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
363 return $refSurogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
364 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
365 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
366 eval "require $Type" unless _is_class($Type);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
367 if ( $Type->UNIVERSAL::can('restore') ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
368 return $Type->restore($Data,$refSurogate);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
369 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
370 die new Exception("Don't know how to deserialize $Type");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
371 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
372 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
373 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
374
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
375 package IMPL::Serializer;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
376 use base qw(IMPL::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
377
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
378 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
379 use IMPL::Class::Property::Direct;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
380 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
381
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
382 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
383 private _direct property Formatter => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
384 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
385
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
386 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
387 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
388 $this->Formatter($args{'Formatter'}) or die new Exception("Omitted mandatory parameter 'Formatter'");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
389 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
390
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
391 sub Serialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
392 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
393 my ($hStream,$Object) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
394 my $ObjWriter = $this->Formatter()->CreateWriter($hStream);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
395 my $Context = new IMPL::Serialization::Context(ObjectWriter => $ObjWriter);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
396 $Context->AddVar('root',$Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
397 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
398 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
399
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
400 sub Deserialize {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
401 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
402 my ($hStream) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
403 my $Context = new IMPL::Deserialization::Context();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
404 my $ObjReader = $this->Formatter()->CreateReader($hStream,$Context);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
405 $ObjReader->Parse();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
406 return $Context->Root();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
407 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
408
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
409 1;