view Lib/IMPL/Class/Property/Direct.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents 4d0e1962161c
children 6253872024a4
line wrap: on
line source

package IMPL::Class::Property::Direct;
use strict;

use parent qw(Exporter IMPL::Object::Accessor IMPL::Class::Property::Base);
our @EXPORT = qw(_direct);

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

__PACKAGE__->mk_accessors( qw(ExportField) );

sub factoryParams {
    $_[0]->SUPER::factoryParams, qw($field);
}

my $default = __PACKAGE__->new({ExportField => 1});

sub _direct($) {
    my ($prop_info) = @_;
    $prop_info->Implementor( $default );
    return $prop_info;
}


sub GenerateGet {
    'return ($this->{$field});';
}

sub GenerateSet {
    'return ($this->{$field} = $_[0])';
}

sub GenerateSetList {
    'return(
        wantarray ?
        @{ $this->{$field} = IMPL::Object::List->new(
            (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_]  
        )} : 
        ($this->{$field} = IMPL::Object::List->new(
            (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_]  
        ))
    );';
}

sub GenerateGetList {
    'return(
        wantarray ?
        @{ $this->{$field} ?
            $this->{$field} :
            ( $this->{$field} = IMPL::Object::List->new() )
        } :
        ( $this->{$field} ?
            $this->{$field} :
            ( $this->{$field} = IMPL::Object::List->new() )
        )
    );';
}

sub RemapFactoryParams {
    my ($self,$propInfo) = @_;
    
    return $self->SUPER::RemapFactoryParams($propInfo),$self->FieldName($propInfo);
}

sub Make {
    my ($self,$propInfo) = @_;
    
    $self->SUPER::Make($propInfo);
    
    {
        no strict 'refs';
        if (ref $self and $self->ExportField) {
            my $field = $self->FieldName($propInfo);
            *{$propInfo->Class.'::'.$propInfo->Name} = \$field;
        }
    }
}

sub FieldName {
    my ($self,$propInfo) = @_;
    
    my ($class,$name) = $propInfo->get( qw(Class Name) );
    (my $field = "${class}_$name") =~ s/::/_/g;
    return $field;
}

1;