Mercurial > pub > Impl
view Lib/IMPL/Class/Property/Direct.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +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;