# HG changeset patch
# User sergey
# Date 1359639464 -14400
# Node ID 8a5da17d7ef938437236e362f882bc837558aea2
# Parent  6253872024a4eb7b340a57dab8e2b2892f532dc7
*IMPL::Class refactoring property definition mechanism (incomplete).

diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Class/DirectPropertyInfo.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Class/DirectPropertyInfo.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -0,0 +1,15 @@
+package IMPL::Class::DirectPropertyInfo;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	base => [
+	   'IMPL::Class::PropertyInfo' => '@_'
+	],
+	props => [
+	   fieldName => PROP_RW,
+	   directAccess => PROP_RW
+	]
+};
+
+1;
\ No newline at end of file
diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Class/Member.pm
--- a/Lib/IMPL/Class/Member.pm	Thu Jan 31 02:18:31 2013 +0400
+++ b/Lib/IMPL/Class/Member.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -3,31 +3,30 @@
 use parent qw(Exporter);
 our @EXPORT = qw(virtual public private protected);
 
+
+use IMPL::Const qw(:access);
+
 use IMPL::Class::Meta;
 require IMPL::Class::MemberInfo;
 
-#TODO: remove
-use constant {
-    MOD_PUBLIC => 1,
-    MOD_PROTECTED => 2,
-    MOD_PRIVATE => 3
-};
-
 sub public($) {
-    $_[0]->access(MOD_PUBLIC);
-    $_[0]->Implement;
-    $_[0];
+	my $info = shift;
+    $info->{access} = ACCESS_PUBLIC;
+    my ($class,$implementor) = delete $info->{'class','-implementor'};
+    $class->$implementor($info);
 }
 
 sub private($) {
-    $_[0]->access(MOD_PRIVATE);
-    $_[0]->Implement;
-    $_[0];
+    my $info = shift;
+    $info->{access} = ACCESS_PRIVATE;
+    my ($class,$implementor) = delete $info->{'class','-implementor'};
+    $class->$implementor($info);
 }
 
 sub protected($) {
-    $_[0]->access(MOD_PROTECTED);
-    $_[0]->Implement;
-    $_[0];
+    my $info = shift;
+    $info->{access} = ACCESS_PROTECTED;
+    my ($class,$implementor) = delete $info->{'class','-implementor'};
+    $class->$implementor($info);
 }
 1;
diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Class/Property.pm
--- a/Lib/IMPL/Class/Property.pm	Thu Jan 31 02:18:31 2013 +0400
+++ b/Lib/IMPL/Class/Property.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -1,12 +1,15 @@
 package IMPL::Class::Property;
 use strict;
 use parent qw(Exporter);
+
 BEGIN {
     our @EXPORT = qw(property prop_get prop_set owner_set prop_none prop_all prop_list CreateProperty);
 }
 
-require IMPL::Class::Member;
-require IMPL::Class::PropertyInfo;
+use IMPL::lang qw(:hash);
+use IMPL::Const qw(:prop);
+use Carp qw(carp);
+require IMPL::Class::Memeber;
 
 sub import {
     __PACKAGE__->export_to_level(1,@_);
@@ -20,16 +23,31 @@
 sub prop_all { 3 };
 sub prop_list { 4 };
 
-sub property($$;$) {
-    my ($propName,$mutators,$attributes) = @_;
-    my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => scalar(caller), attributes => $attributes } );
-    return $Info;
+sub property($$) {
+    my ($propName,$attributes) = @_;
+    
+    $attributes = {
+    	get => $attributes & PROP_GET,
+    	set => $attributes & PROP_SET,
+    	isList => $attributes & PROP_LIST
+    } unless ref $attributes;
+     
+    return hashMerge (
+        $attributes,
+	    {
+	        -implementor => 'ImplementProperty',
+	    	name => $propName,
+	    	class => scalar(caller),
+	    }
+    );
 }
 
 sub CreateProperty {
-    my ($class,$propName,$mutators,$attributes) = @_;
-    my $Info = new IMPL::Class::PropertyInfo( {name => $propName, mutators => $mutators, class => $class, attributes => $attributes} );
-    return $Info;
+    my ($class,$propName,$attributes) = @_;
+    
+    carp "Using create property is deprecated, use ImplementProperty instead";
+    
+    $class->ImplementProperty($propName,$attributes);
 };
 
 1;
diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Class/Property/Base.pm
--- a/Lib/IMPL/Class/Property/Base.pm	Thu Jan 31 02:18:31 2013 +0400
+++ b/Lib/IMPL/Class/Property/Base.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -107,7 +107,11 @@
 }
 
 sub Implement {
-    my ($self,$spec) = @_;
+    my ($self, $name, $spec) = @_;
+    
+    {
+    	name => 
+    }
 }
 
 # extract from property info: class, name, get_accessor, set_accessor, validator
diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Object.pm
--- a/Lib/IMPL/Object.pm	Thu Jan 31 02:18:31 2013 +0400
+++ b/Lib/IMPL/Object.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -3,13 +3,12 @@
 
 use parent qw(IMPL::Object::Abstract);
 require IMPL::Class::Property::Direct;
+use IMPL::Const qw(:prop);
 
 sub surrogate {
     bless {}, ref $_[0] || $_[0];
 }
 
-__PACKAGE__->static_accessor( propertyInfoClass => 'IMPL::Class::DirectPropertyInfo' );
-
 sub new {
     my $class = shift;
     my $self = bless {}, ref($class) || $class;    
@@ -22,6 +21,18 @@
     'IMPL::Class::Property::Direct'
 }
 
+sub ImplementProperty {
+	my ($self,$name,$attributes) = @_;
+	
+	$attributes = {
+        get => $attributes & PROP_GET,
+        set => $attributes & PROP_SET,
+        isList => $attributes & PROP_LIST
+    } unless ref $attributes;
+    
+    $self->_ProppertyImplementor->Implement($name,$attributes);
+}
+
 1;
 
 __END__
diff -r 6253872024a4 -r 8a5da17d7ef9 Lib/IMPL/Object/Abstract.pm
--- a/Lib/IMPL/Object/Abstract.pm	Thu Jan 31 02:18:31 2013 +0400
+++ b/Lib/IMPL/Object/Abstract.pm	Thu Jan 31 17:37:44 2013 +0400
@@ -184,4 +184,5 @@
 
 Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
 создания экземпляров.
+
 =cut