--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Code/BasePropertyImplementor.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,149 @@
+package IMPL::Code::BasePropertyImplementor;
+use strict;
+
+use IMPL::Const qw(:prop :access);
+use Scalar::Util qw(looks_like_number);
+
+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 => '$this->$get(@_);',
+    CodeCustomSetAccessor => '$this->$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 $spec if ref($spec);
+	
+	if (looks_like_number($spec)) {
+		return {
+            get => $spec & PROP_GET,
+            set => $spec & PROP_SET,
+            isList => $spec & PROP_LIST,
+            ownerSet => (($spec & PROP_OWNERSET) == PROP_OWNERSET),
+            direct => $spec & PROP_DIRECT
+        };
+	} else {
+		return {};
+	}	    
+}
+
+sub CreateFactoryId {
+	my ($self, $spec) = @_;
+	
+	join( '',
+        map(
+            ($_
+                ? ( _isCustom($_)
+                    ? 'x'
+                    : 's')
+                : '_'),
+            @$spec{qw(get set)}
+        ),
+        $spec->{access} || ACCESS_PUBLIC,
+        $spec->{validator} ? 'v' : '_',
+        $spec->{isList} ? 'l' : '_',
+        $spec->{ownerSet} ? 'o' : '_'
+    );
+}
+
+sub _isCustom {
+	ref($_[0]) eq 'CODE' || not(ref($_[0]) || looks_like_number($_[0]));
+}
+
+sub CreateFactory {
+	my ($self,$spec) = @_;
+	
+	return $self->CreateFactoryImpl(
+        ($spec->{get}
+            ? ( _isCustom($spec->{get})
+                ? $self->CodeCustomGetAccessor
+                : ($spec->{isList}
+                    ? $self->CodeGetListAccessor
+                    : $self->CodeGetAccessor
+                  )
+              )
+            : $self->CodeNoGetAccessor
+        ),
+        ($spec->{set}
+            ? ( _isCustom($spec->{set})
+                ? $self->CodeCustomSetAccessor
+                : ($spec->{isList}
+                    ? $self->CodeSetListAccessor
+                    : $self->CodeSetAccessor
+                  )
+              )
+            : $self->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) = \@_;
+    return 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