X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=06774488db658e640ba39d730092f14034ee8d54;hb=2bab2be690fec92f81ec4174ae83e09bde362ca7;hp=fa13bf3870aab31292b01e92b5f4b3b83af4ab10;hpb=013b1897ada42ebdd970371868cc3679d3a49344;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index fa13bf3..0677448 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype', 'weaken'; -our $VERSION = '0.04'; +our $VERSION = '0.08'; sub meta { require Class::MOP::Class; @@ -60,6 +60,20 @@ sub clone { return bless { %{$self}, %options } => blessed($self); } +sub initialize_instance_slot { + my ($self, $class, $meta_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($meta_instance->get_instance); + } + $meta_instance->add_slot($self->name, $val); +} + # NOTE: # the next bunch of methods will get bootstrapped # away in the Class::MOP bootstrapping section @@ -114,25 +128,36 @@ sub detach_from_class { sub generate_accessor_method { my ($self, $attr_name) = @_; + my $meta_instance = $self->associated_class->instance_metaclass; sub { - $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2; - $_[0]->{$attr_name}; + $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, $attr_name) = @_; - sub { $_[0]->{$attr_name} }; + my $meta_instance = $self->associated_class->instance_metaclass; + sub { + confess "Cannot assign a value to a read-only accessor" if @_ > 1; + $meta_instance->get_slot_value($_[0], $attr_name); + }; } sub generate_writer_method { my ($self, $attr_name) = @_; - sub { $_[0]->{$attr_name} = $_[1] }; + my $meta_instance = $self->associated_class->instance_metaclass; + sub { + $meta_instance->set_slot_value($_[0], $attr_name, $_[1]); + }; } sub generate_predicate_method { my ($self, $attr_name) = @_; - sub { defined $_[0]->{$attr_name} ? 1 : 0 }; + my $meta_instance = $self->associated_class->instance_metaclass; + sub { + $meta_instance->has_slot_value($_[0], $attr_name); + }; } sub process_accessors { @@ -260,8 +285,6 @@ An attribute must (at the very least), have a C<$name>. All other C<%options> are contained added as key-value pairs. Acceptable keys are as follows: -=item B - =over 4 =item I @@ -372,6 +395,10 @@ defined, and false (C<0>) otherwise. =back +=item B + +=item B + =back =head2 Informational