--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Code/BasePropertyImplementor.pm	Fri Feb 01 16:37:59 2013 +0400
@@ -0,0 +1,134 @@
+package IMPL::Code::BasePropertyImplementor;
+use strict;
+
+use IMPL::Const qw(:prop :access);
+
+use constant {
+	CodeNoGetAccessor => 'die new IMPL::Exception(\'The property is write only\',$name,$class) unless $get;',
+    CodeNoSetAccessor => 'die new IMPL::Exception(\'The property is read only\',$name,$class) unless $set;',
+    CodeCustomGetAccessor => 'unshift @_, $this and goto &$get;',
+    CodeCustomSetAccessor => 'unshift @_, $this and goto &$set;',
+    CodeValidator => '$this->$validator(@_);',
+    CodeOwnerCheck => "die new IMPL::Exception('Set accessor is restricted to the owner',\$name,\$class,scalar caller) unless caller eq \$class;"
+};
+
+sub CodeSetAccessor {
+    die new IMPL::Exception("Standard accessors not supported",'Set');
+}
+    
+sub CodeGetAccessor {
+    die new IMPL::Exception("Standard accessors not supported",'Get');
+}
+
+sub CodeGetListAccessor {
+    die new IMPL::Exception("Standard accessors not supported",'GetList');
+}
+
+sub CodeSetListAccessor {
+    die new IMPL::Exception("Standard accessors not supported",'SetList');
+}
+
+sub factoryParams { qw($class $name $set $get $validator) };
+
+our %ACCESS_CODE = (
+    ACCESS_PUBLIC , "",
+    ACCESS_PROTECTED, "die new IMPL::Exception('Can\\'t access the protected member',\$name,\$class,scalar caller) unless UNIVERSAL::isa(scalar caller,\$class);",
+    ACCESS_PRIVATE, "die new IMPL::Exception('Can\\'t access the private member',\$name,\$class,scalar caller) unless caller eq \$class;" 
+);
+
+sub NormalizeSpecification {
+	my ($this,$spec) = @_;
+	
+	return ref $spec
+        ? $spec
+        : {
+            get => $spec & PROP_GET,
+            set => $spec & PROP_SET,
+            isList => $spec & PROP_LIST,
+            ownerSet => $spec & PROP_OWNERSET
+        };	    
+}
+
+sub CreateFactoryId {
+	my ($self, $spec) = @_;
+	
+	join( '',
+        map(
+            $_
+                ? ref $_ eq 'CODE'
+                    ? 'x'
+                    : 's'
+                : '_',
+            @$spec{qw(get set)}
+        ),
+        $spec->{access},
+        $spec->{validator} ? 'v' : '_',
+        $spec->{isList} ? 'l' : '_',
+        $spec->{ownerSet} ? 'o' : '_'
+    );
+}
+
+sub CreateFactory {
+	my ($self,$spec) = @_;
+	
+	return $self->CreateFactoryImpl(
+        $spec->{get}
+            ? ref $spec->{get} eq 'CODE'
+                ? $self->CodeCustomGetAccessor
+                : $spec->{isList}
+                    ? $spec->CodeGetListAccessor
+                    : $spec->CodeGetAccessor
+            : $spec->CodeNoGetAccessor,
+        $spec->{set}
+            ? ref $spec->{set} eq 'CODE'
+                ? $self->CodeCustomSetAccessor
+                : $spec->{isList}
+                    ? $spec->CodeSetListAccessor
+                    : $spec->CodeSetAccessor
+            : $spec->CodeNoSetAccessor,
+        $ACCESS_CODE{$spec->{access} || ACCESS_PUBLIC} || '',
+        $spec->{validator} ? $self->CodeValidator : '',
+        $spec->{ownerSet} ? $self->CodeOwnerCheck : ''
+	);
+}
+
+sub CreateFactoryImpl {
+    my ($self,$codeGet,$codeSet,$codeAccessCheck,$codeValidator,$codeOwnerCheck) = @_;
+    
+    my $strParams = join(',',$self->factoryParams);
+    
+    my $factory = <<FACTORY;
+    
+sub {
+    my ($strParams) = \@_;
+    my \$accessor;
+    \$accessor = sub {
+        my \$this = shift;
+        $codeAccessCheck
+        if (\@_) {
+            $codeOwnerCheck
+            $codeValidator
+            $codeSet
+        } else {
+            $codeGet
+        }
+    }
+}
+FACTORY
+
+    return ( eval $factory or die new IMPL::Exception("Syntax error due compiling the factory","$@") );
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Code::BasePropertyImplementor> набор впомогательныйх статических методов
+для генерации свойств.
+
+=cut
\ No newline at end of file