instnaces
Stevan Little [Sun, 30 Apr 2006 12:57:48 +0000 (12:57 +0000)]
examples/ArrayBasedStorage.pod
examples/InsideOutClass.pod
lib/Class/MOP.pm
lib/Class/MOP/Attribute.pm
t/010_self_introspection.t
t/102_InsideOutClass_test.t
t/108_ArrayBasedStorage_test.t

index 284e558..0702eef 100644 (file)
@@ -1,58 +1,5 @@
 
 package # hide the package from PAUSE
-    ArrayBasedStorage::Attribute;
-
-use strict;
-use warnings;
-
-use Carp 'confess';
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Attribute';    
-
-sub generate_accessor_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub {
-        my $meta_instance = $_[0]->meta->get_meta_instance;            
-        $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
-        $meta_instance->get_slot_value($_[0], $attr_name);
-    };
-}
-
-sub generate_reader_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub { 
-        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
-        $_[0]->meta
-             ->get_meta_instance
-             ->get_slot_value($_[0], $attr_name); 
-    };   
-}
-
-sub generate_writer_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub { 
-        $_[0]->meta
-             ->get_meta_instance
-             ->set_slot_value($_[0], $attr_name, $_[1]);
-    };
-}
-
-sub generate_predicate_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub {        
-        defined $_[0]->meta
-                     ->get_meta_instance
-                     ->get_slot_value($_[0], $attr_name) ? 1 : 0;
-    };
-}    
-
-package # hide the package from PAUSE
     ArrayBasedStorage::Instance;
 
 use strict;
@@ -121,7 +68,6 @@ ArrayBasedStorage - An example of an Array based instance storage
   package Foo;
   
   use metaclass 'Class::MOP::Class' => (
-    ':attribute_metaclass' => 'ArrayBasedStorage::Attribute'
     ':instance_metaclass'  => 'ArrayBasedStorage::Instance'
   );
   
index d78ce24..0bf4db6 100644 (file)
@@ -1,64 +1,11 @@
 
 package # hide the package from PAUSE
-    InsideOutClass::Attribute;
-
-use strict;
-use warnings;
-
-use Carp 'confess';
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Attribute';    
-
-sub generate_accessor_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub {
-        my $meta_instance = $_[0]->meta->get_meta_instance;            
-        $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
-        $meta_instance->get_slot_value($_[0], $attr_name);
-    };
-}
-
-sub generate_reader_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub { 
-        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
-        $_[0]->meta
-             ->get_meta_instance
-             ->get_slot_value($_[0], $attr_name); 
-    };   
-}
-
-sub generate_writer_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub { 
-        $_[0]->meta
-             ->get_meta_instance
-             ->set_slot_value($_[0], $attr_name, $_[1]);
-    };
-}
-
-sub generate_predicate_method {
-    my $self = shift;
-    my $attr_name = $self->name;
-    return sub {        
-        defined $_[0]->meta
-                     ->get_meta_instance
-                     ->get_slot_value($_[0], $attr_name) ? 1 : 0;
-    };
-}    
-
-package # hide the package from PAUSE
     InsideOutClass::Instance;
 
 use strict;
 use warnings;
 
-our $VERSION = '0.06';
+our $VERSION = '0.01';
 
 use Carp         'confess';
 use Scalar::Util 'refaddr';
@@ -108,9 +55,6 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec
   package Foo;
   
   use metaclass 'Class::MOP::Class' => (
-     # tell our metaclass to use the 
-     # InsideOut attribute metclass 
-     # to construct all it's attributes
     ':instance_metaclass' => 'InsideOutClass::Instance'
   );
   
index 20e02b6..64e6d24 100644 (file)
@@ -41,7 +41,12 @@ our $VERSION = '0.30';
 
 Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('$:package' => (
-        reader   => 'name',
+        reader   => {
+            # NOTE: we need to do this in order 
+            # for the instance meta-object to 
+            # not fall into meta-circular death
+            'name' => sub { (shift)->{'$:package'} }
+        },
         init_arg => ':package',
     ))
 );
@@ -72,7 +77,12 @@ Class::MOP::Class->meta->add_attribute(
 
 Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('$:instance_metaclass' => (
-        reader   => 'instance_metaclass',
+        reader   => {
+            # NOTE: we need to do this in order 
+            # for the instance meta-object to 
+            # not fall into meta-circular death            
+            'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} }
+        },
         init_arg => ':instance_metaclass',
         default  => 'Class::MOP::Instance',        
     ))
@@ -82,13 +92,23 @@ Class::MOP::Class->meta->add_attribute(
 
 Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('name' => (
-        reader => 'name'
+        reader => {
+            # NOTE: we need to do this in order 
+            # for the instance meta-object to 
+            # not fall into meta-circular death            
+            'name' => sub { (shift)->{name} }
+        }
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('associated_class' => (
-        reader => 'associated_class'
+        reader => {
+            # NOTE: we need to do this in order 
+            # for the instance meta-object to 
+            # not fall into meta-circular death            
+            'associated_class' => sub { (shift)->{associated_class} }
+        }
     ))
 );
 
index 284d2b9..cf12216 100644 (file)
@@ -132,9 +132,10 @@ sub detach_from_class {
 
 sub generate_accessor_method {
     my $self = shift;
-    my $meta_instance = $self->associated_class->get_meta_instance;    
-    my $attr_name = $self->name;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
     return sub {
+        my $meta_instance = $meta_class->initialize(Scalar::Util::blessed($_[0]))->get_meta_instance;
         $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
         $meta_instance->get_slot_value($_[0], $attr_name);
     };
@@ -142,29 +143,35 @@ sub generate_accessor_method {
 
 sub generate_reader_method {
     my $self = shift;
-    my $meta_instance = $self->associated_class->get_meta_instance;
-    my $attr_name = $self->name;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
     return sub { 
         confess "Cannot assign a value to a read-only accessor" if @_ > 1;
-        $meta_instance->get_slot_value($_[0], $attr_name); 
+        $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                   ->get_meta_instance
+                   ->get_slot_value($_[0], $attr_name); 
     };   
 }
 
 sub generate_writer_method {
     my $self = shift;
-    my $meta_instance = $self->associated_class->get_meta_instance;
-    my $attr_name = $self->name;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
     return sub { 
-        $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
+        $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                   ->get_meta_instance
+                   ->set_slot_value($_[0], $attr_name, $_[1]);
     };
 }
 
 sub generate_predicate_method {
     my $self = shift;
-    my $meta_instance = $self->associated_class->get_meta_instance;
-    my $attr_name = $self->name;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
     return sub { 
-        defined $meta_instance->get_slot_value($_[0], $attr_name) ? 1 : 0;
+        defined $meta_class->initialize(Scalar::Util::blessed($_[0]))
+                           ->get_meta_instance
+                           ->get_slot_value($_[0], $attr_name) ? 1 : 0;
     };
 }
 
index 38feb82..ddb26e9 100644 (file)
@@ -100,7 +100,7 @@ foreach my $attribute_name (@attributes) {
 ## check the attributes themselves
 
 ok($meta->get_attribute('$:package')->has_reader, '... Class::MOP::Class $:package has a reader');
-is($meta->get_attribute('$:package')->reader, 'name', '... Class::MOP::Class $:package\'s a reader is &name');
+is(ref($meta->get_attribute('$:package')->reader), 'HASH', '... Class::MOP::Class $:package\'s a reader is { name => sub { ... } }');
 
 ok($meta->get_attribute('$:package')->has_init_arg, '... Class::MOP::Class $:package has a init_arg');
 is($meta->get_attribute('$:package')->init_arg, ':package', '... Class::MOP::Class $:package\'s a init_arg is :package');
index 5a486ff..ccee85e 100644 (file)
@@ -18,7 +18,6 @@ BEGIN {
     use warnings;    
     
     use metaclass 'Class::MOP::Class' => (
-        ':attribute_metaclass' => 'InsideOutClass::Attribute',
         ':instance_metaclass'  => 'InsideOutClass::Instance'
     );
     
@@ -54,8 +53,7 @@ BEGIN {
     
     use strict;
     use warnings;
-    use metaclass 'Class::MOP::Class' => (
-        ':attribute_metaclass' => 'InsideOutClass::Attribute',        
+    use metaclass 'Class::MOP::Class' => (     
         ':instance_metaclass' => 'InsideOutClass::Instance'
     );
     
index 689c996..faf4378 100644 (file)
@@ -17,7 +17,6 @@ BEGIN {
     use strict;
     use warnings;    
     use metaclass 'Class::MOP::Class' => (
-        ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',
         ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
     );
     
@@ -54,7 +53,6 @@ BEGIN {
     use strict;
     use warnings;
     use metaclass 'Class::MOP::Class' => (
-        ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',
         ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
     );