view Lib/IMPL/Class/Property/Direct.pm @ 126:c8dfbbdd8005

Several bug fixes Forms support pre-alfa version
author wizard
date Fri, 11 Jun 2010 04:29:51 +0400
parents b0c068da93ac
children 05df123a2ff1
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);

sub factoryParams {
	$_[0]->SUPER::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;