Mercurial > pub > Impl
view Lib/IMPL/Serialization.pm @ 93:0667064553ef
fixed _is_class in activator
rewritten IMPL::Config::Resolve
new features in the Abstract class
author | wizard |
---|---|
date | Wed, 28 Apr 2010 17:50:55 +0400 |
parents | b0c068da93ac |
children | 5edc2ac5231c |
line wrap: on
line source
package IMPL::Serialization; use strict; # 20060222 # ������ ��� ������������ �������� ������ # (�) Sourcer, cin.sourcer@gmail.com # revision 3 (20090517) package IMPL::Serialization::Context; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; use IMPL::Exception; use Scalar::Util qw(refaddr); BEGIN { private _direct property ObjectWriter => prop_all; # ������, ������������ ������ � ����� private _direct property Context => prop_all; # �������� (������� ������� ��� �������������, �� ��������������) private _direct property NextID => prop_all;# ��������� ������������� ��� ������� # ���������, ������� �����, ��� ��������������� ������������ ����. ������ ���������� # �������� ������ �� IMPL::Serialization::Context, ������ ���������� ������ �� ������ public _direct property Serializer => prop_all; private _direct property State => prop_all; # ��������� ��������� ������������ } # �������� ������, �.�. ������� ������ �� ����� sub STATE_CLOSED () { 0 } # �������� ������, �.�. ������ �����, �� � ��� ��� ������ �� ����� sub STATE_OPENED () { 1 } # �������� ������ � � ���� ����� ���� ��������� ������ ���������� sub STATE_COMPLEX () { 2 } # �������� ������ � � ���� ��� ������ �� ����� ���� ���������, ��� ����� ������ sub STATE_DATA () { 3 } sub CTOR { my ($this,%args) = @_; $this->{$ObjectWriter} = $args{'ObjectWriter'}; #$this->{$Context} = {}; $this->{$NextID} = 1; $this->{$Serializer} = ($args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer ); $this->{$State} = STATE_CLOSED; return 1; } sub AddVar { my ($this,$sName,$Var) = @_; die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA; if (not ref $Var) { # ������� ����������� ��, ��� �����, �� ��� ���� ����, ����� �������, ������� ���� # �� �� ������, �� �������� ��������������, �� �� �� ����� my $prevState = $this->{$State}; $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR'); $this->{$State} = STATE_OPENED; $this->{$Serializer}->($this,\$Var); $this->{$ObjectWriter}->EndObject(); if ($prevState == STATE_OPENED) { $this->{$State} = STATE_COMPLEX; } else { $this->{$State} = $prevState; } return 0; } my $PrevState = $this->{$State}; my $ObjID = $this->{$Context}->{refaddr $Var}; if ($ObjID) { $this->{$ObjectWriter}->BeginObject(name => $sName, refid => $ObjID); $this->{$ObjectWriter}->EndObject(); return $ObjID; } $ObjID = $this->{$NextID}; $this->{$NextID} = $ObjID + 1; $this->{$Context}->{refaddr $Var} = $ObjID; $this->{$ObjectWriter}->BeginObject(name => $sName, type => ref($Var), id => $ObjID); $this->{$State} = STATE_OPENED; $this->{$Serializer}->($this,$Var); $this->{$ObjectWriter}->EndObject(); if ($PrevState == STATE_OPENED) { $this->{$State} = STATE_COMPLEX; } else { $this->{$State} = $PrevState; } return $ObjID; } sub SetData { my ($this,$Data,$Type) = @_; die new Exception ('The object should be a scalar value') if ref $Data; die new Exception ('Invalid operation') if $this->{$State} != STATE_OPENED; $this->{$ObjectWriter}->SetData($Data,$Type); $this->{$State} = STATE_DATA; return 1; } sub DefaultSerializer { my ($Context, $refObj) = @_; if (ref($refObj) eq 'SCALAR') { $Context->SetData($$refObj, 'SCALAR'); } elsif (ref($refObj) eq 'ARRAY') { $Context->AddVar('item',$_) foreach @$refObj; } elsif (ref($refObj) eq 'HASH') { while (my ($key,$value) = each %$refObj) { $Context->AddVar($key,$value); } } elsif (ref($refObj) eq 'REF') { $Context->AddVar('ref',$$refObj); } else { if (ref $refObj and $refObj->UNIVARSAL::can('save')) { $refObj->save($Context); } else { die new Exception('Cant serialize the object of the type: '.ref($refObj)); } } return 1; } package IMPL::Deserialization::Context; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; use IMPL::Exception; BEGIN { # ��� ����������������� �������, ���, ���� - �������������, �������� - ������. private _direct property Context => prop_all; # ������� ������. ���������� ��� �������������� # { # Type => 'typename', # Name => 'object_name', # Data => $Data, # Id => 'object_id' # } private _direct property CurrentObject => prop_all; # ���� ��������. ���� ����������� �������� �������� �� ���� ���������� ����� ��������. private _direct property ObjectsPath => prop_all; # ���� ������� ������ ����� �������� public _direct property Root => prop_get; # ������� ������ � ���������� �� ���� ������ # ObjectFactory($Type,$DeserializationData,$refSurogate) # $Type - ��� ���� ������ # $DeserializationData - ���� ������ �� ������ � ������� ��� �������������� �����, # ���� ������ ���������� ������. # $refSurogate - ������ �� �������������� ���������, �� ������������������ ������. # ����� ��������� �������� undef private _direct property ObjectFactory => prop_all; # ������� �������������������� �������. # SurogateHelper($Type) # $Type ��� �����, ��� ������� ����� �������. private _direct property SurogateHelper => prop_all; } sub CTOR { my ($this,%args) = @_; $this->{$CurrentObject} = undef; $this->{$Root} = undef; } sub OnObjectBegin { my ($this,$name,$rhProps) = @_; 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'); die new Exception("Trying to create second root object") if not $this->{$CurrentObject} and $this->{$Root}; if ($rhProps->{'refid'}) { my $refObj = $this->{$Context}->{$rhProps->{'refid'}}; die new Exception("A reference to a not existing object found") if not $refObj; my $rhCurrentObj = $this->{$CurrentObject}; die new Exception("Found a reference to an object as a root of an object's graph") if not $rhCurrentObj; if ($rhCurrentObj->{'Data'}) { die new Exception("Invalid serializaed data","Plain deserialization data for an object already exist") if not ref $rhCurrentObj->{'Data'}; push @{$rhCurrentObj->{'Data'}}, $name,$refObj; } else { $rhCurrentObj->{'Data'} = [$name,$refObj]; } # ��� �����, ��� ����� ������ OnObjectEnd ��� �������, ������� ��� ������� �������. �.�. �� �� ������� ���� push @{$this->{$ObjectsPath}},$rhCurrentObj; $this->{$CurrentObject} = undef; } else { push @{$this->{$ObjectsPath}},$this->{$CurrentObject} if $this->{$CurrentObject}; $this->{$CurrentObject} = { Name => $name, Type => $rhProps->{'type'} || 'SCALAR', Id => $rhProps->{'id'}, refId => $rhProps->{'refid'} }; if (defined $rhProps->{'id'}) { die new IMPL::Exception("Trying to create a simple object instead of a reference, type is missing.",$name,$rhProps->{id}) unless $rhProps->{'type'} ; $this->{$Context}->{$rhProps->{'id'}} = $this->{$SurogateHelper} ? $this->{$SurogateHelper}->($rhProps->{'type'}) : DefaultSurogateHelper($rhProps->{'type'}); } } return 1; } sub OnObjectData { my ($this,$data) = @_; my $rhObject = $this->{$CurrentObject}; die new Exception("Trying to set data for an object which not exists") if not $rhObject; die new Exception("Deserialization data already exists for a current object", "ObjectName= $rhObject->{'Name'}") if $rhObject->{'Data'}; $rhObject->{'Data'} = $data; return 1; } { my $AutoId = 0; sub OnObjectEnd { my ($this,$name) = @_; my $rhObject = $this->{$CurrentObject}; my $rhPrevObject = pop @{$this->{$ObjectsPath}}; # ���� ������� ������ �� ���������, � ���������� - ���������, ������ ������� - ��� ������ # ������ ��������������� ���������� � ������� � ������ ����� �� ������ if ((not defined($rhObject)) && $rhPrevObject) { $this->{$CurrentObject} = $rhPrevObject; return 1; } 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); die new Exception("Trying to close a non existing oject") if not $rhObject; my $Data; if ($rhObject->{'Id'}) { $this->{$Context}->{$rhObject->{'Id'}} = $refObj; $Data = $refObj; } else { if (ref $refObj ne 'SCALAR') { $rhObject->{Id} = "auto$AutoId"; $AutoId ++; $this->{$Context}->{$rhObject->{'Id'}} = $refObj; $Data = $refObj; } else { $Data = ${$refObj}; } } if (not $rhPrevObject) { $this->{$Root} = $Data; } else { if ($rhPrevObject->{'Data'}) { die new Exception("Trying append a reference to an object to the plain data") if not ref $rhPrevObject->{'Data'}; push @{$rhPrevObject->{'Data'}},$rhObject->{'Name'},$Data; } else { $rhPrevObject->{'Data'} = [$rhObject->{'Name'},$Data]; } } $this->{$CurrentObject} = $rhPrevObject; return 1; } } sub _is_class { no strict 'refs'; scalar keys %{"$_[0]::"} ? 1 : 0; } sub DefaultSurogateHelper { my ($Type) = @_; if ($Type eq 'SCALAR' or $Type eq 'REF') { my $var; return \$var; } elsif ($Type eq 'ARRAY') { return []; } elsif ($Type eq 'HASH') { return {}; } elsif ($Type) { eval "require $Type" unless _is_class($Type); if (UNIVERSAL::can($Type,'surrogate')) { return $Type->surrogate(); } else { return bless {}, $Type; } } } # deserialization context: # [ # 'var_name',value, # .... # ] sub DefaultFactory { my ($Type,$Data,$refSurogate) = @_; if ($Type eq 'SCALAR') { die new Exception("SCALAR needs a plain data for a deserialization") if ref $Data; if ($refSurogate) { $$refSurogate = $Data; return $refSurogate; } else { return \$Data; } } elsif ($Type eq 'ARRAY') { die new Exception("Invalid a deserialization context when deserializing ARRAY") if not ref $Data and defined $Data; if (not ref $refSurogate) { my @Array; $refSurogate = \@Array; } for (my $i = 0; $i < scalar(@{$Data})/2; $i++) { push @$refSurogate,$Data->[$i*2+1]; } return $refSurogate; } elsif ($Type eq 'HASH') { die new Exception("Invalid a deserialization context when deserializing HASH") if not ref $Data and defined $Data; if (not ref $refSurogate) { $refSurogate = {}; } for (my $i = 0; $i< @$Data; $i+= 2) { $refSurogate->{$Data->[$i]} = $Data->[$i+1]; } return $refSurogate; } elsif ($Type eq 'REF') { die new Exception("Invalid a deserialization context when deserializing REF") if not ref $Data and defined $Data; if (not ref $refSurogate) { my $ref = $Data->[1]; return \$ref; } else { $$refSurogate = $Data->[1]; return $refSurogate; } } else { eval "require $Type" unless _is_class($Type); if ( $Type->UNIVERSAL::can('restore') ) { return $Type->restore($Data,$refSurogate); } else { die new Exception("Don't know how to deserialize $Type"); } } } package IMPL::Serializer; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; use IMPL::Exception; BEGIN { private _direct property Formatter => prop_all; } sub CTOR { my ($this,%args) = @_; $this->Formatter($args{'Formatter'}) or die new Exception("Omitted mandatory parameter 'Formatter'"); } sub Serialize { my $this = shift; my ($hStream,$Object) = @_; my $ObjWriter = $this->Formatter()->CreateWriter($hStream); my $Context = new IMPL::Serialization::Context(ObjectWriter => $ObjWriter); $Context->AddVar('root',$Object); return 1; } sub Deserialize { my $this = shift; my ($hStream) = @_; my $Context = new IMPL::Deserialization::Context(); my $ObjReader = $this->Formatter()->CreateReader($hStream,$Context); $ObjReader->Parse(); return $Context->Root(); } 1;