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=0f0d088391ff7a9d0036df6d90470f571d6ccd25;hp=e283a231c54f7fd642e1eeae081d9e6865fb21cb;hb=80efe91126e926233fade8bdd58288929286fc09;hpb=5176a3e41f75dc3f0de6049ac642087580f94680 diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index e283a23..0f0d088 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -5,13 +5,9 @@ use Carp (); use Mouse::Meta::TypeConstraint; -#use Mouse::Meta::Method::Accessor; -use Mouse::Meta::Method::Delegation; - sub _process_options{ my($class, $name, $args) = @_; - # XXX: for backward compatibility (with method modifiers) if($class->can('canonicalize_args') != \&canonicalize_args){ %{$args} = $class->canonicalize_args($name, %{$args}); @@ -304,46 +300,64 @@ sub get_parent_args { # DEPRECATED sub get_read_method { - $_[0]->reader || $_[0]->accessor + return $_[0]->reader || $_[0]->accessor } sub get_write_method { - $_[0]->writer || $_[0]->accessor + return $_[0]->writer || $_[0]->accessor } -sub get_read_method_ref{ - my($self) = @_; +sub _get_accessor_method_ref { + my($self, $type, $generator) = @_; - $self->{_read_method_ref} ||= do{ - my $metaclass = $self->associated_class - or $self->throw_error('No asocciated class for ' . $self->name); + my $metaclass = $self->associated_class + || $self->throw_error('No asocciated class for ' . $self->name); - my $reader = $self->{reader} || $self->{accessor}; - if($reader){ - $metaclass->name->can($reader); - } - else{ - $self->accessor_metaclass->_generate_reader($self, $metaclass); - } - }; + my $accessor = $self->$type(); + if($accessor){ + return $metaclass->get_method_body($accessor); + } + else{ + return $self->accessor_metaclass->$generator($self, $metaclass); + } +} + +sub get_read_method_ref{ + my($self) = @_; + return $self->{_read_method_ref} ||= $self->_get_accessor_method_ref('get_read_method', '_generate_reader'); } sub get_write_method_ref{ my($self) = @_; + return $self->{_write_method_ref} ||= $self->_get_accessor_method_ref('get_write_method', '_generate_writer'); +} - $self->{_write_method_ref} ||= do{ - my $metaclass = $self->associated_class - or $self->throw_error('No asocciated class for ' . $self->name); +sub set_value { + my($self, $object, $value) = @_; + return $self->get_write_method_ref()->($object, $value); +} - my $reader = $self->{writer} || $self->{accessor}; - if($reader){ - $metaclass->name->can($reader); - } - else{ - $self->accessor_metaclass->_generate_writer($self, $metaclass); - } - }; +sub get_value { + my($self, $object) = @_; + return $self->get_read_method_ref()->($object); } +sub has_value { + my($self, $object) = @_; + my $accessor_ref = $self->{_predicate_ref} + ||= $self->_get_accessor_method_ref('predicate', '_generate_predicate'); + + return $accessor_ref->($object); +} + +sub clear_value { + my($self, $object) = @_; + my $accessor_ref = $self->{_crealer_ref} + ||= $self->_get_accessor_method_ref('clearer', '_generate_clearer'); + + return $accessor_ref->($object); +} + + sub _canonicalize_handles { my($self, $handles) = @_; @@ -398,6 +412,8 @@ sub install_accessors{ my %handles = $attribute->_canonicalize_handles($attribute->{handles}); my $reader = $attribute->get_read_method_ref; + Mouse::Util::load_class($delegation_class); + while(my($handle_name, $method_to_call) = each %handles){ my $code = $delegation_class->_generate_delegation($attribute, $metaclass, $reader, $handle_name, $method_to_call); @@ -431,7 +447,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass =head1 VERSION -This document describes Mouse version 0.42 +This document describes Mouse version 0.44 =head1 METHODS