diff Lib/IMPL/lang.pm @ 278:4ddb27ff4a0b

core refactoring
author cin
date Mon, 04 Feb 2013 02:10:37 +0400
parents 6253872024a4
children c6d0f889ef87
line wrap: on
line diff
--- a/Lib/IMPL/lang.pm	Fri Feb 01 16:37:59 2013 +0400
+++ b/Lib/IMPL/lang.pm	Mon Feb 04 02:10:37 2013 +0400
@@ -7,8 +7,6 @@
 use IMPL::clone qw(clone);
 use Scalar::Util qw(blessed);
 
-require IMPL::Class::PropertyInfo;
-
 our @EXPORT      = qw(&is &isclass &typeof);
 our %EXPORT_TAGS = (
     base => [
@@ -25,10 +23,10 @@
           &public
           &protected
           &private
-          &virtual
           &property
           &static
           &property
+          &_direct
           &ACCESS_PUBLIC
           &ACCESS_PROTECTED
           &ACCESS_PRIVATE
@@ -39,6 +37,7 @@
           &PROP_ALL
           &PROP_RO
           &PROP_RW
+          &PROP_DIRECT
           )
     ],
     compare => [
@@ -76,40 +75,52 @@
     eval { $_[0]->typeof } || blessed($_[0]);
 }
 
-sub virtual($) {
-    $_[0]->Virtual(1);
-    $_[0];
-}
-
 sub public($) {
-    $_[0]->access(ACCESS_PUBLIC);
-    $_[0]->Implement;
-    $_[0];
+    my $info = shift;
+    $info->{access} = ACCESS_PUBLIC;
+    my $implementor = delete $info->{implementor};
+    $implementor->Implement($info);
 }
 
 sub private($) {
-    $_[0]->access(ACCESS_PRIVATE);
-    $_[0]->Implement;
-    $_[0];
+    my $info = shift;
+    $info->{access} = ACCESS_PRIVATE;
+    my $implementor = delete $info->{implementor};
+    $implementor->Implement($info);
 }
 
 sub protected($) {
-    $_[0]->access(ACCESS_PROTECTED);
-    $_[0]->Implement;
-    $_[0];
+    my $info = shift;
+    $info->{access} = ACCESS_PROTECTED;
+    my $implementor = delete $info->{implementor};
+    $implementor->Implement($info);
+}
+
+sub _direct ($) {
+    my $info = shift;
+    $info->{direct} = 1;
+    return $info;
 }
 
-sub property($$;$) {
-    my ( $propName, $mutators, $attributes ) = @_;
-    my $Info = new IMPL::Class::PropertyInfo(
+sub property($$) {
+    my ($propName,$attributes) = @_;
+    
+    $attributes = {
+        get => $attributes & PROP_GET,
+        set => $attributes & PROP_SET,
+        isList => $attributes & PROP_LIST
+    } unless ref $attributes;
+    
+    my $class = caller;
+     
+    return hashMerge (
+        $attributes,
         {
-            name       => $propName,
-            mutators   => $mutators,
-            class      => scalar(caller),
-            attributes => $attributes
+            implementor => $class->ClassPropertyImplementor,
+            name => $propName,
+            class => scalar(caller),
         }
     );
-    return $Info;
 }
 
 sub static($$) {