From: gfx <gfuji@cpan.org>
Date: Sat, 19 Dec 2009 06:27:16 +0000 (+0900)
Subject: Change the internal delegation code
X-Git-Tag: 0.45~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=cbb8105898bb0faa7eee06ef890d2ec0c131dff7

Change the internal delegation code
---

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 0f0d088..98dd81b 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -358,39 +358,12 @@ sub clear_value {
 }
 
 
-sub _canonicalize_handles {
-    my($self, $handles) = @_;
-
-    if (ref($handles) eq 'HASH') {
-        return %$handles;
-    }
-    elsif (ref($handles) eq 'ARRAY') {
-        return map { $_ => $_ } @$handles;
-    }
-    elsif (ref($handles) eq 'Regexp') {
-        my $class_or_role = ($self->{isa} || $self->{does})
-            || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)");
-
-        my $meta = Mouse::Meta::Class->initialize("$class_or_role"); # "" for stringify
-        return map  { $_ => $_ }
-               grep { !Mouse::Object->can($_) && $_ =~ $handles }
-                   Mouse::Util::is_a_metarole($meta)
-                        ? $meta->get_method_list
-                        : $meta->get_all_method_names;
-    }
-    else {
-        $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
-    }
-}
-
 sub associate_method{
     my ($attribute, $method_name) = @_;
     $attribute->{associated_methods}++;
     return;
 }
 
-sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' }
-
 sub install_accessors{
     my($attribute) = @_;
 
@@ -408,18 +381,14 @@ sub install_accessors{
 
     # install delegation
     if(exists $attribute->{handles}){
-        my $delegation_class = $attribute->delegation_metaclass;
         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);
+        while(my($handle, $method_to_call) = each %handles){
+            $metaclass->add_method($handle =>
+                $attribute->_make_delegation_method(
+                    $handle, $method_to_call));
 
-            $metaclass->add_method($handle_name => $code);
-            $attribute->associate_method($handle_name);
+            $attribute->associate_method($handle);
         }
     }
 
@@ -431,6 +400,41 @@ sub install_accessors{
     return;
 }
 
+sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' }
+
+sub _canonicalize_handles {
+    my($self, $handles) = @_;
+
+    if (ref($handles) eq 'HASH') {
+        return %$handles;
+    }
+    elsif (ref($handles) eq 'ARRAY') {
+        return map { $_ => $_ } @$handles;
+    }
+    elsif (ref($handles) eq 'Regexp') {
+        my $class_or_role = ($self->{isa} || $self->{does})
+            || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)");
+
+        my $meta = Mouse::Meta::Class->initialize("$class_or_role"); # "" for stringify
+        return map  { $_ => $_ }
+               grep { !Mouse::Object->can($_) && $_ =~ $handles }
+                   Mouse::Util::is_a_metarole($meta)
+                        ? $meta->get_method_list
+                        : $meta->get_all_method_names;
+    }
+    else {
+        $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
+    }
+}
+
+sub _make_delegation_method {
+    my($self, $handle, $method_to_call) = @_;
+    my $delegator = $self->delegation_metaclass;
+    Mouse::Util::load_class($delegator);
+
+    return $delegator->_generate_delegation($self, $handle, $method_to_call);
+}
+
 sub throw_error{
     my $self = shift;
 
diff --git a/lib/Mouse/Meta/Method/Delegation.pm b/lib/Mouse/Meta/Method/Delegation.pm
index b44214c..6acee73 100644
--- a/lib/Mouse/Meta/Method/Delegation.pm
+++ b/lib/Mouse/Meta/Method/Delegation.pm
@@ -3,8 +3,9 @@ use Mouse::Util qw(:meta); # enables strict and warnings
 use Scalar::Util;
 
 sub _generate_delegation{
-    my (undef, $attribute, $metaclass, $reader, $handle_name, $method_to_call) = @_;
+    my (undef, $attribute, $handle_name, $method_to_call) = @_;
 
+    my $reader = $attribute->get_read_method_ref();
     return sub {
         my $instance = shift;
         my $proxy    = $instance->$reader();