view Lib/IMPL/Class/Property/Direct.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 609b59c9f03c
children b0c068da93ac
line wrap: on
line source

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

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

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

__PACKAGE__->mk_accessors qw(ExportField);

push @IMPL::Class::Property::Base::factoryParams, qw($field);

sub _direct($) {
    my ($prop_info) = @_;
    $prop_info->Implementor( IMPL::Class::Property::Direct->new({ExportField => 1}) );
    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;