diff Lib/IMPL/Code/DirectPropertyImplementor.pm @ 278:4ddb27ff4a0b

core refactoring
author cin
date Mon, 04 Feb 2013 02:10:37 +0400
parents 6585464c4664
children
line wrap: on
line diff
--- a/Lib/IMPL/Code/DirectPropertyImplementor.pm	Fri Feb 01 16:37:59 2013 +0400
+++ b/Lib/IMPL/Code/DirectPropertyImplementor.pm	Mon Feb 04 02:10:37 2013 +0400
@@ -1,9 +1,13 @@
 package IMPL::Code::DirectPropertyImplementor;
 use strict;
 
+require IMPL::Object::List;
+
+use IMPL::lang qw(:hash);
 use IMPL::require {
 	Exception => 'IMPL::Exception',
-	ArgException => '-IMPL::InvalidArgumentException'
+	ArgException => '-IMPL::InvalidArgumentException',
+	DirectPropertyInfo => 'IMPL::Class::DirectPropertyInfo'
 };
 
 use parent qw(IMPL::Code::BasePropertyImplementor);
@@ -33,20 +37,22 @@
     );'
 };
 
-sub factoryParams { qw($class $name $set $get $validator $field) };
+sub factoryParams { qw($class $name $get $set $validator $field) };
 
 my %cache;
 
 sub Implement {
-	my ($self, $spec) = @_;
+	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");
 	
-	$spec = $self->NormalizeSpecification($spec);
-	
 	my $id = $self->CreateFactoryId($spec);
 	my $factory = $cache{$id};
 	unless($factory) {
@@ -54,9 +60,37 @@
         $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