view Lib/IMPL/Object/Serializable.pm @ 148:e6447ad85cb4

DOM objects now have a schema and schemaSource properties RegExp now can launder data Improved post to DOM transformation (multiple values a now supported) Added new axes to navigation queries: ancestor and descendant minor changes and bug fixes
author wizard
date Mon, 16 Aug 2010 08:26:44 +0400
parents 16ada169ca75
children c8fe3f84feba
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 "\t".'$ctx->AddVar('.$_->Name.' => ' .
            ((not ref $_->Mutators and $_->Mutators & prop_list) ? ('[$this->'.$_->Class.'::'.$_->Name.'()]') : ('$this->'.$_->Class.'::'.$_->Name.'()')) .
        ') if defined ' . '$this->'.$_->Class.'::'.$_->Name.'()' . ';', grep $_->canGet, $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;