Mercurial > pub > Impl
view Lib/IMPL/Class/Property/Direct.pm @ 196:a705e848dcc7
added IMPL::Config::Reference
author | cin |
---|---|
date | Mon, 16 Apr 2012 17:42:54 +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;