X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=5e2563c87156b7d7eec723571785b023934b58fa;hb=2d711cc8f03b6d8cbfe53f9628883ff33582ed03;hp=06774488db658e640ba39d730092f14034ee8d54;hpb=2bab2be690fec92f81ec4174ae83e09bde362ca7;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 0677448..5e2563c 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -61,7 +61,7 @@ sub clone { } sub initialize_instance_slot { - my ($self, $class, $meta_instance, $params) = @_; + my ($self, $instance, $params) = @_; my $init_arg = $self->{init_arg}; # try to fetch the init arg from the %params ... my $val; @@ -69,9 +69,11 @@ sub initialize_instance_slot { # 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($meta_instance->get_instance); - } - $meta_instance->add_slot($self->name, $val); + $val = $self->default($instance); + } + + my $meta_instance = $self->associated_class->get_meta_instance; + $meta_instance->set_slot_value_with_init( $instance, $self->slot_name, $val ); } # NOTE: @@ -124,39 +126,65 @@ sub detach_from_class { $self->{associated_class} = undef; } +# slot management + +sub slot_name { # when attr <-> slot mapping is 1:1 + my $self = shift; + $self->name; +} + +# slot alocation + +sub allocate_slots { + my $self = shift; + my $meta_instance = $self->associated_class->get_meta_instance; + $meta_instance->add_slot( $self->slot_name ); +} + +sub deallocate_slots { + my $self = shift; + my $meta_instance = $self->associated_class->get_meta_instance; + $meta_instance->remove_slot( $self->slot_name ); +} + ## Method generation helpers sub generate_accessor_method { my ($self, $attr_name) = @_; - my $meta_instance = $self->associated_class->instance_metaclass; + my $meta_instance = $self->associated_class->get_meta_instance; + my $slot_name = $self->slot_name; + sub { - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; - $meta_instance->get_slot_value($_[0], $attr_name); + $meta_instance->set_slot_value($_[0], $slot_name, $_[1]) if scalar(@_) == 2; + $meta_instance->get_slot_value($_[0], $slot_name); }; } sub generate_reader_method { my ($self, $attr_name) = @_; - my $meta_instance = $self->associated_class->instance_metaclass; + my $meta_instance = $self->associated_class->get_meta_instance; + my $slot_name = $self->slot_name; sub { confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $meta_instance->get_slot_value($_[0], $attr_name); + $meta_instance->get_slot_value($_[0], $slot_name); }; } sub generate_writer_method { my ($self, $attr_name) = @_; - my $meta_instance = $self->associated_class->instance_metaclass; + my $meta_instance = $self->associated_class->get_meta_instance; + my $slot_name = $self->slot_name; sub { - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]); + $meta_instance->set_slot_value($_[0], $slot_name, $_[1]); }; } sub generate_predicate_method { my ($self, $attr_name) = @_; - my $meta_instance = $self->associated_class->instance_metaclass; + my $meta_instance = $self->associated_class->get_meta_instance; + my $slot_name = $self->slot_name; sub { - $meta_instance->has_slot_value($_[0], $attr_name); + defined $meta_instance->get_slot_value($_[0], $slot_name); }; } @@ -458,6 +486,12 @@ These are all basic predicate methods for the values passed into C. =item B +=item B + +=item B + +=item B + =back =head2 Attribute Accessor generation