yuval-wins
Stevan Little [Tue, 2 May 2006 02:52:09 +0000 (02:52 +0000)]
examples/ArrayBasedStorage.pod
examples/InsideOutClass.pod
lib/Class/MOP/Attribute.pm
t/102_InsideOutClass_test.t
t/108_ArrayBasedStorage_test.t

index aa174db..1f04012 100644 (file)
@@ -1,75 +1,4 @@
-
-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 initialize_instance_slot {
-    my ($self, $meta_instance, $instance, $params) = @_;
-    my $init_arg = $self->{init_arg};
-    # try to fetch the init arg from the %params ...
-    my $val;        
-    $val = $params->{$init_arg} if exists $params->{$init_arg};
-    # if nothing was in the %params, we can use the 
-    # attribute's default value (if it has one)
-    if (!defined $val && defined $self->{default}) {
-        $val = $self->default($instance);
-    }
-    $meta_instance->set_slot_value($instance, $self->name, $val);
-}
-
-sub generate_accessor_method {
-    my $self = shift;
-    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);
-    };
-}
-
-sub generate_reader_method {
-    my $self = shift;
-    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_class->initialize(Scalar::Util::blessed($_[0]))
-                   ->get_meta_instance
-                   ->get_slot_value($_[0], $attr_name); 
-    };   
-}
-
-sub generate_writer_method {
-    my $self = shift;
-    my $meta_class = $self->associated_class;    
-    my $attr_name  = $self->name;
-    return sub { 
-        $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_class = $self->associated_class;    
-    my $attr_name  = $self->name;
-    return sub { 
-        defined $meta_class->initialize(Scalar::Util::blessed($_[0]))
-                           ->get_meta_instance
-                           ->get_slot_value($_[0], $attr_name) ? 1 : 0;
-    };
-}    
-
+  
 package # hide the package from PAUSE
     ArrayBasedStorage::Instance;
 
index b0f805f..fdd1691 100644 (file)
@@ -1,5 +1,78 @@
 
 package # hide the package from PAUSE
+    InsideOutClass::Attribute;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use Carp         'confess';
+use Scalar::Util 'refaddr';
+
+use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+    my ($self, $meta_instance, $instance, $params) = @_;
+    my $init_arg = $self->{init_arg};
+    # try to fetch the init arg from the %params ...
+    my $val;        
+    $val = $params->{$init_arg} if exists $params->{$init_arg};
+    # if nothing was in the %params, we can use the 
+    # attribute's default value (if it has one)
+    if (!defined $val && defined $self->{default}) {
+        $val = $self->default($instance);
+    }
+    $self->associated_class
+         ->get_meta_instance
+         ->set_slot_value($instance, $self->name, $val);
+}
+
+## Method generation helpers
+
+sub generate_accessor_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;  
+    my $attr_name  = $self->name;
+    return sub {
+        my $meta_instance = $meta_class->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 $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_class->get_meta_instance
+                   ->get_slot_value($_[0], $attr_name); 
+    }; 
+}
+
+sub generate_writer_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;    
+    my $attr_name  = $self->name;
+    return sub { 
+        $meta_class->get_meta_instance
+                   ->set_slot_value($_[0], $attr_name, $_[1]);
+    };
+}
+
+sub generate_predicate_method {
+    my $self = shift;
+    my $meta_class = $self->associated_class;   
+    my $attr_name  = $self->name;
+    return sub { 
+        defined $meta_class->get_meta_instance
+                           ->get_slot_value($_[0], $attr_name) ? 1 : 0;
+    };   
+}
+
+package # hide the package from PAUSE
     InsideOutClass::Instance;
 
 use strict;
@@ -40,12 +113,6 @@ sub is_slot_initialized {
        return exists $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} ? 1 : 0;
 }
 
-sub inline_slot_access {
-    my ($self, $instance, $slot_name) = @_;
-    $slot_name =~ s/\'//g;
-    ('$' . $self->{meta}->name . '::' . $slot_name . '{Scalar::Util::refaddr(' . $instance . ')}');
-}
-
 1;
 
 __END__
@@ -61,7 +128,8 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec
   package Foo;
   
   use metaclass (
-    ':instance_metaclass' => 'InsideOutClass::Instance'
+    ':attribute_metaclass' => 'InsideOutClass::Attribute',
+    ':instance_metaclass'  => 'InsideOutClass::Instance'
   );
   
   __PACKAGE__->meta->add_attribute('foo' => (
index c05aa2d..21c5ef8 100644 (file)
@@ -71,9 +71,7 @@ sub initialize_instance_slot {
     if (!defined $val && defined $self->{default}) {
         $val = $self->default($instance);
     }
-    $self->associated_class
-         ->get_meta_instance
-         ->set_slot_value($instance, $self->name, $val);
+    $meta_instance->set_slot_value($instance, $self->name, $val);
 }
 
 # NOTE:
@@ -133,82 +131,44 @@ sub detach_from_class {
 ## Method generation helpers
 
 sub generate_accessor_method {
-    my $self = shift;
-    #my $meta_class = $self->associated_class;  
-    my $meta_instance = $self->associated_class->get_meta_instance;  
+    my $self = shift; 
     my $attr_name  = $self->name;
-    #return sub {
-    #    my $meta_instance = $meta_class->get_meta_instance;
-    #    $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
-    #    $meta_instance->get_slot_value($_[0], $attr_name);
-    #};
-    
-    my $code = "sub {\n"
-    . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') 
-    . " if scalar(\@_) == 2;\n"
-    . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') 
-    . "\n}";
-    my $sub = eval $code;
-    confess "Could not eval code:\n$code\nbecause: $@" if $@;
-    return $sub;
+    return sub {
+        my $meta_instance = Class::MOP::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);
+    };
 }
 
 sub generate_reader_method {
     my $self = shift;
-    #my $meta_class = $self->associated_class;    
-    my $meta_instance = $self->associated_class->get_meta_instance;
     my $attr_name  = $self->name;
-    #return sub { 
-    #    confess "Cannot assign a value to a read-only accessor" if @_ > 1;
-    #    $meta_class->get_meta_instance
-    #               ->get_slot_value($_[0], $attr_name); 
-    #}; 
-    
-    my $code = "sub {\n"
-    . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' . "\n"
-    . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') 
-    . "\n}";
-    my $sub = eval $code;
-    confess "Could not eval code:\n$code\nbecause: $@" if $@;
-    return $sub;      
+    return sub { 
+        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
+                         ->get_meta_instance
+                         ->get_slot_value($_[0], $attr_name); 
+    };   
 }
 
 sub generate_writer_method {
     my $self = shift;
-    #my $meta_class = $self->associated_class;    
-    my $meta_instance = $self->associated_class->get_meta_instance;
     my $attr_name  = $self->name;
-    #return sub { 
-    #    $meta_class->get_meta_instance
-    #               ->set_slot_value($_[0], $attr_name, $_[1]);
-    #};
-    
-    my $code = "sub {\n"
-    . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') 
-    . "\n}";
-    my $sub = eval $code;
-    confess "Could not eval code:\n$code\nbecause: $@" if $@;
-    return $sub;    
+    return sub { 
+        Class::MOP::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_class = $self->associated_class;   
-    my $meta_instance = $self->associated_class->get_meta_instance; 
     my $attr_name  = $self->name;
-    #return sub { 
-    #    defined $meta_class->get_meta_instance
-    #                       ->get_slot_value($_[0], $attr_name) ? 1 : 0;
-    #};
-    
-    my $code = "sub {\n"
-    . 'defined '
-    . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') 
-    . ' ? 1 : 0;'
-    . "\n}";
-    my $sub = eval $code;
-    confess "Could not eval code:\n$code\nbecause: $@" if $@;
-    return $sub;    
+    return sub { 
+        defined Class::MOP::Class->initialize(Scalar::Util::blessed($_[0]))
+                                 ->get_meta_instance
+                                 ->get_slot_value($_[0], $attr_name) ? 1 : 0;
+    };
 }
 
 sub process_accessors {
index ffd36eb..4788dfc 100644 (file)
@@ -18,6 +18,7 @@ BEGIN {
     use warnings;    
     
     use metaclass (
+        ':attribute_metaclass' => 'InsideOutClass::Attribute',
         ':instance_metaclass'  => 'InsideOutClass::Instance'
     );
     
@@ -54,7 +55,8 @@ BEGIN {
     use strict;
     use warnings;
     use metaclass (     
-        ':instance_metaclass' => 'InsideOutClass::Instance'
+        ':attribute_metaclass' => 'InsideOutClass::Attribute',
+        ':instance_metaclass'  => 'InsideOutClass::Instance'
     );
     
     Baz->meta->add_attribute('bling' => (
index a7b24e9..17add18 100644 (file)
@@ -17,7 +17,6 @@ BEGIN {
     use strict;
     use warnings;    
     use metaclass (
-        ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',
         ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
     );
     
@@ -53,8 +52,7 @@ BEGIN {
     
     use strict;
     use warnings;
-    use metaclass (
-        ':attribute_metaclass' => 'ArrayBasedStorage::Attribute',        
+    use metaclass (        
         ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
     );