package IMPL::Serialization;
use strict;

package IMPL::Serialization::Context;
use parent 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;

  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->{$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 parent 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 SurrogateHelper => prop_all;
}

sub CTOR {
  my ($this,%args) = @_;
  $this->{$CurrentObject} = undef;
  $this->{$Root} = undef;
  $this->{$ObjectFactory} = $args{ObjectFactory} if $args{ObjectFactory};
  $this->{$SurrogateHelper} = $args{SurrogateHelper} if $args{SurrogateHelper};
}

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->{$SurrogateHelper} ? $this->{$SurrogateHelper}->($rhProps->{'type'}) : DefaultSurrogateHelper($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;
  }
}

{
	my %classes;
	sub _load_class {
		return if $classes{$_[0]};
		
		die new IMPL::Exception("Invalid class name",$_[0]) unless $_[0] =~ m/^(\w+(?:\:\:\w+)*)$/;
		
		eval "require $1";
		$classes{$_[0]} = 1;
	}
}

sub DefaultSurrogateHelper {
  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) {
    _load_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') {
  	$Data ||= [];
    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') {
  	$Data ||= [];
    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') {
  	$Data ||= [];
    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 {
    _load_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 parent 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;