view Lib/IMPL/Class/Property/Direct.pm @ 191:78a18a2b6266

IMPL::Web::View improvements (unstable)
author cin
date Thu, 05 Apr 2012 17:51:51 +0400
parents d1676be8afcc
children 4d0e1962161c
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;