Mercurial > pub > Impl
view Lib/IMPL/Serialization.pm @ 342:1090c1dd7429
TTControl: added a helper method 'CreateControlFromTemlpate'
author | cin |
---|---|
date | Wed, 03 Jul 2013 03:53:12 +0400 |
parents | a8dbddf491dd |
children |
line wrap: on
line source
package IMPL::Serialization; use strict; package IMPL::Serialization::Context; use IMPL::Exception(); use Scalar::Util qw(refaddr); use IMPL::Const qw(:prop); use IMPL::declare { base => [ 'IMPL::Object' => undef ], props => [ _objectWriter => PROP_RW | PROP_DIRECT, _context => PROP_RW | PROP_DIRECT, _nextId => PROP_RW | PROP_DIRECT, serializer => PROP_RW | PROP_DIRECT, _state => PROP_RW | PROP_DIRECT ] }; 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->{$_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 ); $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 IMPL::Const qw(:prop); use IMPL::declare { require => { Exception => 'IMPL::Exception', Loader => 'IMPL::Code::Loader' }, base => [ 'IMPL::Object' => undef ], props => [ # структура информации об объекте # { # Type => 'typename', # Name => 'object_name', # Data => $data, # Id => 'object_id' # } _context => PROP_RW | PROP_DIRECT, _currentObject => PROP_RW | PROP_DIRECT, _objectsPath => PROP_RW | PROP_DIRECT, root => PROP_RW | PROP_DIRECT ] }; sub CTOR { my ( $this, %args ) = @_; $this->{$_currentObject} = undef; $this->{$root} = undef; } sub OnObjectBegin { my ( $this, $name, $rhProps ) = @_; die Exception->new( "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 Exception->new("Trying to create second root object") if not $this->{$_currentObject} and $this->{$root}; if ( $rhProps->{'refid'} ) { my $refObj = $this->{$_context}->{ $rhProps->{'refid'} }; die Exception->new("A reference to a not existing object found") if not $refObj; my $rhCurrentObj = $this->{$_currentObject}; die Exception->new("The root object can't be a reference") if not $rhCurrentObj; if ( $rhCurrentObj->{'Data'} ) { die Exception->new( "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 ]; } 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->CreateSurrogate( $rhProps->{'type'} ); } } return 1; } sub OnObjectData { my ( $this, $data ) = @_; my $rhObject = $this->{$_currentObject}; die Exception->new("Trying to set data for an object which not exists") if not $rhObject; #die Exception->new( # "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->CreateObject( $rhObject->{'Type'}, $rhObject->{'Data'}, $rhObject->{'Id'} ? $this->{$_context}->{ $rhObject->{'Id'} } : undef ); die Exception->new("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 Exception->new( "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 CreateSurrogate { my ($this,$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) { Loader->safe->Require($type); if ( eval { $type->can('surrogate') } ) { return $type->surrogate(); } else { return bless {}, $type; } } } # deserialization context: # [ # 'var_name',value, # .... # ] sub CreateObject { my ($this, $type, $data, $refSurogate ) = @_; if ( $type eq 'SCALAR' ) { die Exception->new("SCALAR needs a plain data for a deserialization") if ref $data; if ($refSurogate) { $$refSurogate = $data; return $refSurogate; } else { return \$data; } } elsif ( $type eq 'ARRAY' ) { $data ||= []; die Exception->new( "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' ) { $data ||= []; die Exception->new( "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' ) { $data ||= []; die Exception->new( "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 { Loader->safe->Require($type); if ( eval { $type->can('restore') } ) { return $type->restore( $data, $refSurogate ); } else { die Exception->new("Don't know how to deserialize $type"); } } } package IMPL::Serializer; use IMPL::Const qw(:prop); use IMPL::declare { require => { Exception => 'IMPL::Exception', SerializationContext => '-IMPL::Serialization::Context', DeserializationContext => '-IMPL::Deserialization::Context' }, base => [ 'IMPL::Object' => undef ], props => [ _formatter => PROP_RW ] }; sub CTOR { my ( $this, %args ) = @_; $this->_formatter( $args{formatter} ) or die Exception->new("Omitted mandatory parameter 'formatter'"); } sub Serialize { my $this = shift; my ( $hStream, $Object ) = @_; my $ObjWriter = $this->_formatter->CreateWriter($hStream); my $context = SerializationContext->new( objectWriter => $ObjWriter ); $context->AddVar( 'root', $Object ); return 1; } sub Deserialize { my $this = shift; my ($hStream) = @_; my $context = DeserializationContext->new(); my $ObjReader = $this->_formatter->CreateReader( $hStream, $context ); $ObjReader->Parse(); return $context->root; } 1;