X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=df19986c32a0be5c46401b1a096913e3f5507030;hp=5bb0da11b9bb4ccb3a22af19bb20b073ac696900;hb=2b68f76d78d96325821e9a6360c3639f8c5637df;hpb=a25ca8d637c040b2f929b1a23dd62ff63d85f5d1

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 5bb0da1..df19986 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{
@@ -156,48 +158,8 @@ sub new {
     return $self;
 }
 
-# readers
-
-sub name                 { $_[0]->{name}                   }
-sub associated_class     { $_[0]->{associated_class}       }
-
-sub accessor             { $_[0]->{accessor}               }
-sub reader               { $_[0]->{reader}                 }
-sub writer               { $_[0]->{writer}                 }
-sub predicate            { $_[0]->{predicate}              }
-sub clearer              { $_[0]->{clearer}                }
-sub handles              { $_[0]->{handles}                }
-
-sub _is_metadata         { $_[0]->{is}                     }
-sub is_required          { $_[0]->{required}               }
-sub default              { $_[0]->{default}                }
-sub is_lazy              { $_[0]->{lazy}                   }
-sub is_lazy_build        { $_[0]->{lazy_build}             }
-sub is_weak_ref          { $_[0]->{weak_ref}               }
-sub init_arg             { $_[0]->{init_arg}               }
-sub type_constraint      { $_[0]->{type_constraint}        }
-
-sub trigger              { $_[0]->{trigger}                }
-sub builder              { $_[0]->{builder}                }
-sub should_auto_deref    { $_[0]->{auto_deref}             }
-sub should_coerce        { $_[0]->{coerce}                 }
-
-# predicates
-
-sub has_accessor         { exists $_[0]->{accessor}        }
-sub has_reader           { exists $_[0]->{reader}          }
-sub has_writer           { exists $_[0]->{writer}          }
-sub has_predicate        { exists $_[0]->{predicate}       }
-sub has_clearer          { exists $_[0]->{clearer}         }
-sub has_handles          { exists $_[0]->{handles}         }
-
-sub has_default          { exists $_[0]->{default}         }
-sub has_type_constraint  { exists $_[0]->{type_constraint} }
-sub has_trigger          { exists $_[0]->{trigger}         }
-sub has_builder          { exists $_[0]->{builder}         }
-
-sub has_read_method      { exists $_[0]->{reader} || exists $_[0]->{accessor} }
-sub has_write_method     { exists $_[0]->{writer} || exists $_[0]->{accessor} }
+sub has_read_method      { $_[0]->has_reader || $_[0]->has_accessor }
+sub has_write_method     { $_[0]->has_writer || $_[0]->has_accessor }
 
 sub _create_args { # DEPRECATED
     $_[0]->{_create_args} = $_[1] if @_ > 1;
@@ -305,7 +267,13 @@ sub clone_and_inherit_options{
     my($attribute_class, @traits) = ref($self)->interpolate_class(\%args);
 
     $args{traits} = \@traits if @traits;
-    return $attribute_class->new($self->name, %{$self}, %args);
+    # do not inherit the 'handles' attribute
+    foreach my $name(keys %{$self}){
+        if(!exists $args{$name} && $name ne 'handles'){
+            $args{$name} = $self->{$name};
+        }
+    }
+    return $attribute_class->new($self->name, %args);
 }
 
 sub clone_parent { # DEPRECATED
@@ -337,10 +305,10 @@ sub get_parent_args { # DEPRECATED
 
 
 sub get_read_method {
-    $_[0]->{reader} || $_[0]->{accessor}
+    $_[0]->reader || $_[0]->accessor
 }
 sub get_write_method {
-    $_[0]->{writer} || $_[0]->{accessor}
+    $_[0]->writer || $_[0]->accessor
 }
 
 sub get_read_method_ref{
@@ -393,26 +361,28 @@ sub _canonicalize_handles {
         my $meta = Mouse::Meta::Class->initialize("$class_or_role"); # "" for stringify
         return map  { $_ => $_ }
                grep { $_ ne 'meta' && !Mouse::Object->can($_) && $_ =~ $handles }
-                   $meta->isa('Mouse::Meta::Class') ? $meta->get_all_method_names : $meta->get_method_list;
+                   Mouse::Util::TypeConstraints::_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) = @_;
     $attribute->{associated_methods}++;
     return;
 }
 
-sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' }
+
+sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' }
 
 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)){
@@ -426,11 +396,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);
@@ -464,7 +435,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.37_06
+This document describes Mouse version 0.40_03
 
 =head1 METHODS