--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Code/AccessorPropertyImplementor.pm	Mon Feb 04 02:10:37 2013 +0400
@@ -0,0 +1,84 @@
+package IMPL::Code::AccessorPropertyImplementor;
+use strict;
+
+use IMPL::lang qw(:hash);
+use IMPL::require {
+    Exception => '-IMPL::Exception',
+    ArgException => '-IMPL::InvalidArgumentException',
+    AccessorPropertyInfo => '-IMPL::Class::AccessorPropertyInfo'
+};
+
+require IMPL::Class::AccessorPropertyInfo;
+require IMPL::Object::List;
+
+use parent qw(IMPL::Code::BasePropertyImplementor);
+
+use constant {
+    CodeGetAccessor => 'return $this->get($field);',
+    CodeSetAccessor => 'return $this->set($field,@_);',
+    CodeSetListAccessor =>
+        'my $val = IMPL::Object::List->new( (@_ == 1 and UNIVERSAL::isa($_[0], \'ARRAY\') ) ? $_[0] : [@_] );
+        $this->set($field,$val);
+        return(    wantarray ?    @{ $val } : $val );',
+    CodeGetListAccessor =>
+        'my $val = $this->get($field);
+        $this->set($field,$val = IMPL::Object::List->new()) unless $val;
+        return(    wantarray ?    @{ $val    } : $val );'
+};
+
+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 = $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
+    };
+    
+    delete @$spec{qw(get set ownerSet isList name class type access field direct)};
+    
+    $args->{attributes} = $spec;
+    
+    my $propInfo = AccessorPropertyInfo->new($args);
+    
+    {
+        no strict 'refs';
+        *{"${class}::$name"} = $accessor;
+    }
+    
+    $class->SetMeta($propInfo);
+    
+    return $propInfo;
+}
+
+1;
\ No newline at end of file