yuval-wins

[gitmo/Class-MOP.git] / examples / InsideOutClass.pod

diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod
index b0f805f..fdd1691 100644 (file)
--- a/examples/InsideOutClass.pod
+++ b/examples/InsideOutClass.pod
@@ -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' => (