From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 30 Apr 2006 18:25:12 +0000 (+0000)
Subject: Refactor default delegator filtering
X-Git-Tag: 0_09_03~50
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7e5ab3798d951410bf9aa3c83025d61febe7ffd9;p=gitmo%2FMoose.git

Refactor default delegator filtering
---

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index d254c69..9be7804 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -288,14 +288,15 @@ sub generate_writer_method {
 }
 
 sub generate_reader_method {
-    my ($self, $attr_name) = @_; 
+    my $self = shift;
+    my $attr_name = $self->name;
     my $code = 'sub {'
     . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
     . ($self->is_lazy ? 
             '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
             . 'unless exists $_[0]->{$attr_name};'
             : '')
-    . '$_[0]->{$attr_name};'
+    . 'return $_[0]->{$attr_name};'
     . '}';
     my $sub = eval $code;
     confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 81852e7..7858736 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -92,29 +92,46 @@ sub add_attribute {
 
     if ( @delegations ) {
         my $attr = $self->get_attribute( $name );
-        $self->generate_delgate_method( $attr, $_ ) for @delegations;
+        $self->generate_delgate_method( $attr, $_ ) for $self->filter_delegations( $attr, @delegations );
     }
 
     return $ret;
 }
 
+sub filter_delegations {
+    my ( $self, $attr, @delegations ) = @_;
+    grep {
+        my $new_name = $_->{new_name} || $_->{name};
+        no warnings "uninitialized";
+        !$self->name->can( $new_name ) and
+        $attr->accessor ne $new_name and
+        $attr->reader ne $new_name and
+        $attr->writer ne $new_name
+    } @delegations;
+}
+
 sub generate_delgate_method {
     my ( $self, $attr, $method ) = @_;
 
     # FIXME like generated accessors these methods must be regenerated
     # FIXME the reader may not work for subclasses with weird instances
 
-    my $reader = $attr->generate_reader_method( $attr->name ); # FIXME no need for attr name
-
-    my $method_name = $method->{name};
-    my $new_name = $method->{new_name} || $method_name;
-
-    $self->add_method( $new_name, sub {
-        if ( Scalar::Util::blessed( my $delegate = shift->$reader ) ) {
-            return $delegate->$method_name( @_ );
-        }
-        return;
-    });
+    my $make = $method->{generator} || sub {
+        my ( $self, $attr, $method )  =@_;
+    
+        my $method_name = $method->{name};
+        my $reader = $attr->generate_reader_method();
+
+        return sub {
+            if ( Scalar::Util::blessed( my $delegate = shift->$reader ) ) {
+                return $delegate->$method_name( @_ );
+            }
+            return;
+        };
+    };
+
+    my $new_name = $method->{new_name} || $method->{name};
+    $self->add_method( $new_name, $make->( $self, $attr, $method  ) );
 }
 
 sub compute_delegation {
@@ -132,8 +149,7 @@ sub compute_delegation {
 
 sub get_delegatable_methods {
     my ( $self, @names_or_hashes ) = @_;
-    my @hashes = map { ref($_) ? $_ : { name => $_ } } @names_or_hashes;
-    return grep { !$self->name->can( $_->{name} ) } @hashes;
+    map { ref($_) ? $_ : { name => $_ } } @names_or_hashes;
 }
 
 sub generate_delegation_list {