Refactor install_accessor() and related stuff

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 0ee8400..9ffac52 100644 (file)
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -9,6 +9,7 @@ use Mouse::Util qw(:meta);
 use Mouse::Meta::TypeConstraint;
 use Mouse::Meta::Method::Accessor;
 
+
 sub _process_options{
     my($class, $name, $args) = @_;
 
@@ -304,21 +305,6 @@ sub coerce_constraint { # DEPRECATED
     return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $type, $_[1]);
 }
 
-sub _canonicalize_handles {
-    my $self    = shift;
-    my $handles = shift;
-
-    if (ref($handles) eq 'HASH') {
-        return %$handles;
-    }
-    elsif (ref($handles) eq 'ARRAY') {
-        return map { $_ => $_ } @$handles;
-    }
-    else {
-        $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
-    }
-}
-
 sub clone_and_inherit_options{
     my($self, %args) = @_;
 
@@ -375,7 +361,7 @@ sub get_read_method_ref{
             $metaclass->name->can($reader);
         }
         else{
-            Mouse::Meta::Method::Accessor->_generate_reader($self, undef, $metaclass);
+            $self->accessor_metaclass->_generate_reader($self, $metaclass);
         }
     };
 }
@@ -392,32 +378,64 @@ sub get_write_method_ref{
             $metaclass->name->can($reader);
         }
         else{
-            Mouse::Meta::Method::Accessor->_generate_writer($self, undef, $metaclass);
+            $self->accessor_metaclass->_generate_writer($self, $metaclass);
         }
     };
 }
 
+sub _canonicalize_handles {
+    my($self, $handles) = @_;
+
+    if (ref($handles) eq 'HASH') {
+        return %$handles;
+    }
+    elsif (ref($handles) eq 'ARRAY') {
+        return map { $_ => $_ } @$handles;
+    }
+    else {
+        $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
+    }
+}
+
+
 sub associate_method{
     my ($attribute, $method) = @_;
     $attribute->{associated_methods}++;
     return;
 }
 
+sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
+
 sub install_accessors{
     my($attribute) = @_;
 
-    my $metaclass       = $attribute->{associated_class};
+    my $metaclass      = $attribute->{associated_class};
+    my $accessor_class = $attribute->accessor_metaclass;
 
-    foreach my $type(qw(accessor reader writer predicate clearer handles)){
+    foreach my $type(qw(accessor reader writer predicate clearer)){
         if(exists $attribute->{$type}){
-            my $installer    = '_generate_' . $type;
+            my $generator = '_generate_' . $type;
+            my $code      = $accessor_class->$generator($attribute, $metaclass);
+            $metaclass->add_method($attribute->{$type} => $code);
+            $attribute->associate_method($code);
+        }
+    }
 
-            Mouse::Meta::Method::Accessor->$installer($attribute, $attribute->{$type}, $metaclass);
+    # install delegation
+    if(exists $attribute->{handles}){
+        my %handles = $attribute->_canonicalize_handles($attribute->{handles});
+        my $reader  = $attribute->get_read_method_ref;
 
-            $attribute->{associated_methods}++;
+        while(my($handle_name, $method_to_call) = each %handles){
+            my $code = $accessor_class->_generate_delegation($attribute, $metaclass,
+                $reader, $handle_name, $method_to_call);
+
+            $metaclass->add_method($handle_name => $code);
+            $attribute->associate_method($code);
         }
     }
 
+
     if($attribute->can('create') != \&create){
         # backword compatibility
         $attribute->create($metaclass, $attribute->name, %{$attribute});

diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index cdc2bd4..7be4ec9 100755 (executable)
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -4,7 +4,7 @@ use warnings;
 use Scalar::Util qw(blessed);
 
 sub _generate_accessor{
-    my (undef, $attribute, $method_name, $class, $type) = @_;
+    my (undef, $attribute, $class, $type) = @_;
 
     my $name          = $attribute->name;
     my $default       = $attribute->default;
@@ -126,10 +126,6 @@ sub _generate_accessor{
     };
     die $e if $e;
 
-    if(defined $method_name){
-        $class->add_method($method_name => $code);
-    }
-
     return $code;
 }
 
@@ -145,58 +141,44 @@ sub _generate_writer{
 
 
 sub _generate_predicate {
-    my (undef, $attribute, $method_name, $class) = @_;
+    my (undef, $attribute, $class) = @_;
 
     my $slot = $attribute->name;
-
-    $class->add_method($method_name => sub{
+    return sub{
         return exists $_[0]->{$slot};
-    });
-    return;
+    };
 }
 
 sub _generate_clearer {
-    my (undef, $attribute, $method_name, $class) = @_;
+    my (undef, $attribute, $class) = @_;
 
     my $slot = $attribute->name;
 
-    $class->add_method($method_name => sub{
+   return sub{
         delete $_[0]->{$slot};
-    });
-    return;
+    };
 }
 
-sub _generate_handles {
-    my (undef, $attribute, $handles, $class) = @_;
-
-    my $reader  = $attribute->reader || $attribute->accessor
-        or $class->throw_error("You must pass a reader method for '".$attribute->name."'");
-
-    my %handles = $attribute->_canonicalize_handles($handles);
-
-    foreach my $handle_name (keys %handles) {
-        my $method_to_call = $handles{$handle_name};
-
-        my $code = sub {
-            my $instance = shift;
-            my $proxy    = $instance->$reader();
-
-            my $error = !defined($proxy)                ? ' is not defined'
-                      : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
-                                                        : undef;
-            if ($error) {
-                $instance->meta->throw_error(
-                    "Cannot delegate $handle_name to $method_to_call because "
-                        . "the value of "
-                        . $attribute->name
-                        . $error
-                 );
-            }
-            $proxy->$method_to_call(@_);
-        };
-        $class->add_method($handle_name => $code);
-    }
-    return;
+sub _generate_delegation{
+    my (undef, $attribute, $class, $reader, $handle_name, $method_to_call) = @_;
+
+    return sub {
+        my $instance = shift;
+        my $proxy    = $instance->$reader();
+
+        my $error = !defined($proxy)                ? ' is not defined'
+                  : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
+                                                    : undef;
+        if ($error) {
+            $instance->meta->throw_error(
+                "Cannot delegate $handle_name to $method_to_call because "
+                    . "the value of "
+                    . $attribute->name
+                    . $error
+             );
+        }
+        $proxy->$method_to_call(@_);
+    };
 }