diff Lib/IMPL/Class/Meta.pm @ 229:47f77e6409f7

heavily reworked the resource model of the web application: *some ResourcesContraact functionality moved to Resource +Added CustomResource *Corrected action handlers
author sergey
date Sat, 29 Sep 2012 02:34:47 +0400
parents a8db61d0ed33
children 6d8092d8ce1b
line wrap: on
line diff
--- a/Lib/IMPL/Class/Meta.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Class/Meta.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -69,7 +69,17 @@
 }
 
 sub static_accessor {
-    my ($class,$name,$value,$clone) = @_;
+    my ($class,$name,$value,$inherit) = @_;
+    
+    $inherit ||= 'inherit';
+    
+    my $method = "static_accessor_$inherit";
+    
+    return $class->$method($name,$value);
+}
+
+sub static_accessor_clone {
+    my ($class,$name,$value) = @_;
     $class = ref $class || $class;
     
     no strict 'refs';
@@ -81,18 +91,62 @@
             $self = ref $self || $self;            
             
             if ($class ne $self) {
-                $self->static_accessor( $name => $_[0] ); # define own class data
+                $self->static_accessor_clone( $name => $_[0] ); # define own class data
+            } else {
+                $value = $_[0];
+            }
+        } else {
+        	$self->static_accessor_clone($name => clone($value));
+        }
+    };
+    $value
+};
+
+sub static_accessor_inherit {
+    my ($class,$name,$value) = @_;
+    
+    no strict 'refs';
+    
+    *{"${class}::$name"} = sub {
+        my $self = shift;
+        
+        if (@_ > 0) {            
+            $self = ref $self || $self;            
+            
+            if ($class ne $self) {
+                $self->static_accessor_inherit( $name => $_[0] ); # define own class data
             } else {
                 $value = $_[0];
             }
         } else {
-        	($clone and $class ne $self)
-        	   ? $self->static_accessor($name => clone($value),$clone)
-        	   : $value and $value ;
-        }
-    };
-    $value
-};
+            $value ;
+        }        
+    }
+}
+
+sub static_accessor_own {
+    my ($class,$name,$value) = @_;
+    
+    no strict 'refs';
+    
+    *{"${class}::$name"} = sub {
+        my $self = shift;
+        
+        if ($class ne $self) {
+            if (@_ > 0) {
+                $self->static_accessor_own( $name => $_[0] ); # define own class data
+            } else {
+                return;
+            }
+        } else {
+            if ( @_ > 0 ) {
+                $value = $_[0];
+            } else {
+                return $value;
+            }
+        }    
+    }
+}
 
 sub _find_class_data {
     my ($class,$name) = @_;
@@ -213,13 +267,39 @@
 
 =back  
 
-=head2 C<static_accessor($name[,$value[,$clone]])>
+=head2 C<static_accessor($name[,$value[,$inherit]])>
 
 Создает статическое свойство с именем C<$name> и начальным значением C<$value>.
 
-Параметр C<$clone> контролирует то, как наследуются значения, если требуется каждому классу обеспечить
-свое уникальное значение, то при первом обращении оно будет клонировано, по умолчанию клонирование не
-происходит.
+Параметр C<$inherit> контролирует то, как наследуются значения.
+
+=over
+
+=item * C<inherit>
+
+По умолчанию. Означает, что если для класса не определено значение, оно будет
+получено от родителя.
+
+=item * C<clone>
+
+Если для класса не определено значение, то оно будет клонировано из
+родительского значения при первом обращении. Полезно, когда родитель задает
+значение по-умолчанию, которое разделяется между несколькими потомками,
+которые модифицирю само значение (например значением является ссылка на хеш,
+а потомки добавляют или меняют значения в этом хеше).
+
+=item * C<own>
+
+Каждый класс имеет свое собственное значение не зависящее от того, что было
+у предка. Начальное значение для этого статического свойства C<undef>.
+
+=back
+
+Данный метод является заглушкой, он передает управление 
+C<static_accessor_inherit>, C<static_accessor_clone>, C<static_accessor_own>
+соответственно. Эти методы можно вызывать явно 
+C<static_accessor_*($name[,$value])>. 
+
 
 =begin code
 
@@ -227,12 +307,30 @@
 use parent qw(IMPL::Class::Meta);
 
 __PACKAGE__->static_accessor( info => { version => 1 } );
+__PACKAGE__->static_accessor( mappings => { toString => \&ToString }, 'clone' );
+__PACKAGE__->static_accessor( _instance => undef, 'own' );
+
+sub ToString {
+    "[object Foo]";
+}
+
+sub default {
+    my ($self) = @_;
+    
+    $self = ref $self || $self;
+    return $self->_instance ? $self->_instance : $self->_instance($self->new());
+}
 
 package Bar;
 use parent qw(Foo);
 
-__PACKAGE__->info->{language} = 'English'; # Foo->info->{language} will become 'English' to!!!
-__PACKAGE__->info({language => 'English'}); # will define own 'info' but will loose original data.
+__PACKAGE__->info({language => 'English', version => 2}); # will define own 'info' but will loose original data.
+__PACKAGE__->mappings->{sayHello} = \&SayHello; # will not affect Foo->mappings;
+
+package main;
+
+my $foo = Foo->default; # will be a Foo object
+my $bar = Bar->default; # will be a Bar object 
 
 =end code