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