X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=03b290771f2e5be024d9d3305aaa6150ec453c68;hp=4c248501b1835ca425f0adf52174db5a30231438;hb=2a464664052830d5fad036569d5ccb3964c7f592;hpb=cfa6d970245f1bbc9330c0e4bb3342356a43ac16 diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 4c24850..03b2907 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -185,9 +185,6 @@ sub builder { $_[0]->{builder} } sub should_auto_deref { $_[0]->{auto_deref} } sub should_coerce { $_[0]->{coerce} } -sub get_read_method { $_[0]->{reader} || $_[0]->{accessor} } -sub get_write_method { $_[0]->{writer} || $_[0]->{accessor} } - # predicates sub has_accessor { exists $_[0]->{accessor} } @@ -356,6 +353,44 @@ sub get_parent_args { $self->throw_error("Could not find an attribute by the name of '$name' to inherit from"); } + +#sub get_read_method { $_[0]->{reader} || $_[0]->{accessor} } +#sub get_write_method { $_[0]->{writer} || $_[0]->{accessor} } + +sub get_read_method_ref{ + my($self) = @_; + + $self->{_read_method_ref} ||= do{ + my $metaclass = $self->associated_class + or $self->throw_error('No asocciated class for ' . $self->name); + + my $reader = $self->{reader} || $self->{accessor}; + if($reader){ + $metaclass->name->can($reader); + } + else{ + Mouse::Meta::Method::Accessor->_generate_reader($self, undef, $metaclass); + } + }; +} + +sub get_write_method_ref{ + my($self) = @_; + + $self->{_write_method_ref} ||= do{ + my $metaclass = $self->associated_class + or $self->throw_error('No asocciated class for ' . $self->name); + + my $reader = $self->{writer} || $self->{accessor}; + if($reader){ + $metaclass->name->can($reader); + } + else{ + Mouse::Meta::Method::Accessor->_generate_writer($self, undef, $metaclass); + } + }; +} + sub associate_method{ my ($attribute, $method) = @_; $attribute->{associated_methods}++; @@ -369,7 +404,7 @@ sub install_accessors{ foreach my $type(qw(accessor reader writer predicate clearer handles)){ if(exists $attribute->{$type}){ - my $installer = '_install_' . $type; + my $installer = '_generate_' . $type; Mouse::Meta::Method::Accessor->$installer($attribute, $attribute->{$type}, $metaclass);