From: gfx <gfuji@cpan.org>
Date: Mon, 26 Oct 2009 07:50:10 +0000 (+0900)
Subject: Split accessor generators into Accessor.pm and Delegation.pm
X-Git-Tag: 0.40_01~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7d8d49b322c4d0f274aaafb049b324e1de6b552;p=gitmo%2FMouse.git

Split accessor generators into Accessor.pm and Delegation.pm
---

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 77be3b4..5c87356 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -4,7 +4,9 @@ use Mouse::Util qw(:meta); # enables strict and warnings
 use Carp ();
 
 use Mouse::Meta::TypeConstraint;
-use Mouse::Meta::Method::Accessor;
+
+#use Mouse::Meta::Method::Accessor;
+use Mouse::Meta::Method::Delegation;
 
 
 sub _process_options{
@@ -368,6 +370,9 @@ sub associate_method{
     return;
 }
 
+
+sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' }
+
 sub install_accessors{
     my($attribute) = @_;
 
@@ -385,11 +390,12 @@ 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;
 
         while(my($handle_name, $method_to_call) = each %handles){
-            my $code = $accessor_class->_generate_delegation($attribute, $metaclass,
+            my $code = $delegation_class->_generate_delegation($attribute, $metaclass,
                 $reader, $handle_name, $method_to_call);
 
             $metaclass->add_method($handle_name => $code);
diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index 9f8e407..c4f7356 100755
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -166,29 +166,6 @@ sub _generate_clearer {
     };
 }
 
-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(@_);
-    };
-}
-
-
 1;
 __END__
 
diff --git a/lib/Mouse/Meta/Method/Delegation.pm b/lib/Mouse/Meta/Method/Delegation.pm
new file mode 100644
index 0000000..18174a8
--- /dev/null
+++ b/lib/Mouse/Meta/Method/Delegation.pm
@@ -0,0 +1,43 @@
+package Mouse::Meta::Method::Delegation;
+use Mouse::Util; # enables strict and warnings
+use Scalar::Util qw(blessed);
+
+sub _generate_delegation{
+    my (undef, $attribute, $metaclass, $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(@_);
+    };
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Mouse::Meta::Method::Delegation - A Mouse method generator for delegation methods
+
+=head1 VERSION
+
+This document describes Mouse version 0.40_01
+
+=head1 SEE ALSO
+
+L<Moose::Meta::Method::Delegation>
+
+=cut
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index 4ce4c1d..de57492 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -155,6 +155,7 @@ sub get_roles { $_[0]->{roles} }
 package
     Mouse::Meta::Attribute;
 
+use Mouse::Meta::Method::Accessor;
 
 # readers
 
diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 44ccf84..c34ad16 100644
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -192,12 +192,6 @@ BOOT:
 
 MODULE = Mouse  PACKAGE = Mouse::Meta::Method::Accessor::XS
 
-BOOT:
-{
-    AV* const isa = get_av("Mouse::Meta::Method::Accessor::XS::ISA", TRUE);
-    av_push(isa, newSVpvs("Mouse::Meta::Method::Accessor"));
-}
-
 CV*
 _generate_accessor(klass, SV* attr, metaclass)
 CODE: