diff lib/IMPL/Code/DirectPropertyImplementor.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Code/DirectPropertyImplementor.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,96 @@
+package IMPL::Code::DirectPropertyImplementor;
+use strict;
+
+require IMPL::Object::List;
+
+use IMPL::lang qw(:hash);
+use IMPL::require {
+	Exception => 'IMPL::Exception',
+	ArgException => '-IMPL::InvalidArgumentException',
+	DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo'
+};
+
+use parent qw(IMPL::Code::BasePropertyImplementor);
+
+use constant {
+	CodeGetAccessor => 'return ($this->{$field});',
+	CodeSetAccessor => 'return ($this->{$field} = $_[0])',
+	CodeGetListAccessor => 'return(
+        wantarray ?
+        @{ $this->{$field} ?
+            $this->{$field} :
+            ( $this->{$field} = IMPL::Object::List->new() )
+        } :
+        ( $this->{$field} ?
+            $this->{$field} :
+            ( $this->{$field} = IMPL::Object::List->new() )
+        )
+    );',
+    CodeSetListAccessor => '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 factoryParams { qw($class $name $get $set $validator $field) };
+
+my %cache;
+
+sub Implement {
+	my $self = shift;
+	
+	my $spec = {};
+    
+    map hashApply($spec,$self->NormalizeSpecification($_)), @_;
+	
+	my $name = $spec->{name}
+        or ArgException->new(name => "The name of the property is required");
+    my $class = $spec->{class}
+        or ArgException->new(name => "The onwer class must be specified");
+	
+	my $id = $self->CreateFactoryId($spec);
+	my $factory = $cache{$id};
+	unless($factory) {
+        $factory = $self->CreateFactory($spec);
+        $cache{$id} = $factory;		
+	}
+	
+	my $field = join( '_', split(/::/, $class), $name);
+	
+	my $accessor = $factory->($class, $name, $spec->{get}, $spec->{set}, $spec->{validator}, $field);
+	
+	my $args = {
+	    getter => $spec->{get} ? $accessor : undef,
+	    setter => $spec->{set} ? $accessor : undef,
+	    ownetSet => $spec->{ownerSet} ? 1 : 0,
+	    isList => $spec->{isList} ? 1 : 0,
+	    name => $spec->{name},
+	    class => $spec->{class},
+	    type => $spec->{type},
+	    access => $spec->{access},
+	    fieldName => $field,
+	    directAccess => $spec->{direct}
+	};
+	
+	delete @$spec{qw(get set ownerSet isList name class type access field direct)};
+	
+	$args->{attributes} = $spec;
+	
+	my $propInfo = DirectPropertyInfo->new($args);
+	
+	{
+	    no strict 'refs';
+	    *{"${class}::$name"} = $accessor;
+	    *{"${class}::$name"} = \$field if $args->{directAccess};
+	}
+	$class->SetMeta($propInfo);
+	
+	return $propInfo;
+}
+
+1;
\ No newline at end of file