view lib/IMPL/Object/Serializable.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line source

package IMPL::Object::Serializable;
use strict;
use warnings;

require IMPL::Exception;
use IMPL::Class::Property;

sub restore {
    my ($class,$data,$refSurrogate) = @_;
    
    if ($refSurrogate) {
        $refSurrogate->callCTOR(@$data);
        return $refSurrogate;
    } else {
        return $class->new(@$data);
    }
}

sub save {
    my ($this,$ctx,$predicate) = @_;
    
    ($this->_get_save_method)->($this,$ctx);
}

sub _get_save_method {
    my ($class) = @_;
    
    $class = ref $class || $class;
    
    no strict 'refs';
    if (my $method = *{"${class}::_impl_auto_save"}{CODE}) {
        return $method;
    } else {
        my $code = <<SAVE_METHOD;
package $class;
sub _impl_auto_save {
    my (\$this,\$ctx) = \@_;
SAVE_METHOD
    
        $code .=
        join "\n", map "    ".'$ctx->AddVar('.$_->name.' => ' .
            ($_->isList ? ('[$this->'.$_->class.'::'.$_->name.'()]') : ('$this->'.$_->class.'::'.$_->name.'()')) .
        ') if defined ' . '$this->'.$_->class.'::'.$_->name.'()' . ';', grep $_->setter, $class->get_meta('IMPL::Class::PropertyInfo',undef,1);
        $code .= <<SAVE_METHOD;

}
\\\&_impl_auto_save;
SAVE_METHOD

        return (eval $code || die new IMPL::Exception("Failed to generate serialization method",$class,$@));
    }
}

1;