X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FArrayBasedStorage.pod;h=bff9baaec231d2ea62041ea11e578135ca0c5e28;hb=41fc2d0fd29483cb704e06198bfaabbcd3e09d08;hp=bc5a19b9ddc87008b65f79c58db7b8dc835667d3;hpb=1a09d9cce4930577a39060a03029a32cd51d41c7;p=gitmo%2FClass-MOP.git diff --git a/examples/ArrayBasedStorage.pod b/examples/ArrayBasedStorage.pod index bc5a19b..bff9baa 100644 --- a/examples/ArrayBasedStorage.pod +++ b/examples/ArrayBasedStorage.pod @@ -4,10 +4,12 @@ package # hide the package from PAUSE use strict; use warnings; +use Scalar::Util qw/refaddr/; use Carp 'confess'; our $VERSION = '0.01'; +my $unbound = \'empty-slot-value'; use base 'Class::MOP::Instance'; @@ -15,13 +17,15 @@ sub new { my ($class, $meta, @attrs) = @_; my $self = $class->SUPER::new($meta, @attrs); my $index = 0; - $self->{slot_index_map} = { map { $_ => $index++ } $self->get_all_slots }; + $self->{'slot_index_map'} = { map { $_ => $index++ } $self->get_all_slots }; return $self; } sub create_instance { my $self = shift; - $self->bless_instance_structure([]); + my $instance = $self->bless_instance_structure([]); + $self->initialize_all_slots($instance); + return $instance; } sub clone_instance { @@ -31,7 +35,17 @@ sub clone_instance { # operations on meta instance -sub get_slot_index_map { (shift)->{slot_index_map} } +sub get_slot_index_map { (shift)->{'slot_index_map'} } + +sub initialize_slot { + my ($self, $instance, $slot_name) = @_; + $self->set_slot_value($instance, $slot_name, $unbound); +} + +sub deinitialize_slot { + my ( $self, $instance, $slot_name ) = @_; + $self->set_slot_value($instance, $slot_name, $unbound); +} sub get_all_slots { my $self = shift; @@ -40,21 +54,26 @@ sub get_all_slots { sub get_slot_value { my ($self, $instance, $slot_name) = @_; - return $instance->[ $self->{slot_index_map}->{$slot_name} ]; + my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ]; + return $value unless ref $value; + refaddr $value eq refaddr $unbound ? undef : $value; } sub set_slot_value { my ($self, $instance, $slot_name, $value) = @_; - $instance->[ $self->{slot_index_map}->{$slot_name} ] = $value; + $instance->[ $self->{'slot_index_map'}->{$slot_name} ] = $value; } sub is_slot_initialized { - # NOTE: - # maybe use CLOS's *special-unbound-value* - # for this ? - confess "Cannot really tell this for sure"; + my ($self, $instance, $slot_name) = @_; + # NOTE: maybe use CLOS's *special-unbound-value* for this? + my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ]; + return 1 unless ref $value; + refaddr $value eq refaddr $unbound ? 0 : 1; } +sub is_dependent_on_superclasses { 1 } + 1; __END__ @@ -104,7 +123,7 @@ Yuval Kogman Enothingmuch@woobling.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006-2008 by Infinity Interactive, Inc. L