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=3ea2ca78e85c4bdc23d14856531c2c62eabec515;hp=28bdec35fd04aeea489b08b11dd6216015a3a0b6;hb=060f922893d1a0308a393260b65ec172dca9dfe2;hpb=6a97bbdad44391f2a587165cb81fcf8aedc642ac

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 28bdec3..3ea2ca7 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -8,11 +8,9 @@ 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});
@@ -205,7 +203,7 @@ sub canonicalize_args{ # DEPRECATED
 
     Carp::cluck("$self->canonicalize_args has been deprecated."
         . "Use \$self->_process_options instead.")
-            if _MOUSE_VERBOSE;
+            if Mouse::Util::_MOUSE_VERBOSE;
 
     return %args;
 }
@@ -215,7 +213,7 @@ sub create { # DEPRECATED
 
     Carp::cluck("$self->create has been deprecated."
         . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
-            if _MOUSE_VERBOSE;
+            if Mouse::Util::_MOUSE_VERBOSE;
 
     # noop
     return $self;
@@ -284,7 +282,7 @@ sub clone_parent { # DEPRECATED
 
     Carp::cluck("$self->clone_parent has been deprecated."
         . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
-        if _MOUSE_VERBOSE;
+        if Mouse::Util::_MOUSE_VERBOSE;
 
     $self->clone_and_inherited_args($class, $name, %args);
 }
@@ -305,46 +303,66 @@ 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_accessor_method_ref {
+    my($self, $type, $generator) = @_;
+
+    my $metaclass = $self->associated_class
+        || $self->throw_error('No asocciated class for ' . $self->name);
+
+    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) = @_;
 
-    $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{
-            $self->accessor_metaclass->_generate_reader($self, $metaclass);
-        }
-    };
+    return $self->{_read_method_ref} ||= $self->_get_accessor_method_ref('get_read_method', '_generate_reader');
 }
 
 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);
+    return $self->{_write_method_ref} ||= $self->_get_accessor_method_ref('get_write_method', '_generate_writer');
+}
 
-        my $reader = $self->{writer} || $self->{accessor};
-        if($reader){
-            $metaclass->name->can($reader);
-        }
-        else{
-            $self->accessor_metaclass->_generate_writer($self, $metaclass);
-        }
-    };
+sub set_value {
+    my($self, $object, $value) = @_;
+    return $self->get_write_method_ref()->($object, $value);
+}
+
+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) = @_;
 
@@ -360,7 +378,7 @@ sub _canonicalize_handles {
 
         my $meta = Mouse::Meta::Class->initialize("$class_or_role"); # "" for stringify
         return map  { $_ => $_ }
-               grep { $_ ne 'meta' && !Mouse::Object->can($_) && $_ =~ $handles }
+               grep { !Mouse::Object->can($_) && $_ =~ $handles }
                    Mouse::Util::is_a_metarole($meta)
                         ? $meta->get_method_list
                         : $meta->get_all_method_names;
@@ -376,7 +394,6 @@ sub associate_method{
     return;
 }
 
-
 sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' }
 
 sub install_accessors{
@@ -409,7 +426,6 @@ sub install_accessors{
         }
     }
 
-
     if($attribute->can('create') != \&create){
         # backword compatibility
         $attribute->create($metaclass, $attribute->name, %{$attribute});
@@ -426,7 +442,6 @@ sub throw_error{
 }
 
 1;
-
 __END__
 
 =head1 NAME
@@ -435,7 +450,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_04
+This document describes Mouse version 0.44
 
 =head1 METHODS