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;