Switch to Mouse::Exporter

[gitmo/Mouse.git] / lib / Mouse / Meta / Method / Accessor.pm

diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index 621a259..6e1055c 100755 (executable)
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -1,10 +1,9 @@
 package Mouse::Meta::Method::Accessor;
-use strict;
-use warnings;
+use Mouse::Util; # enables strict and 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;
@@ -24,7 +23,7 @@ sub _generate_accessor{
 
     my $accessor = 
         '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
-        sprintf("sub %s {\n", defined($method_name) ? $class->name . '::' . $method_name : '');
+        "sub {\n";
 
     if ($type eq 'accessor' || $type eq 'writer') {
         if($type eq 'accessor'){
@@ -126,7 +125,7 @@ sub _generate_accessor{
     };
     die $e if $e;
 
-    return $code; # returns a CODE ref unless $method_name is passed
+    return $code;
 }
 
 sub _generate_reader{
@@ -141,58 +140,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(@_);
+    };
 }