working-on-it

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

diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod
index 8268d4c..aa174db 100644 (file)
--- a/examples/ArrayBasedStorage.pod
+++ b/examples/ArrayBasedStorage.pod
@@ -1,5 +1,76 @@
 
 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;
 
 use strict;
@@ -26,6 +97,8 @@ sub create_instance {
 
 # operations on meta instance
 
+sub get_slot_index_map { (shift)->{slot_index_map} }
+
 sub get_all_slots {
     my $self = shift;
     return sort @{$self->{slots}};