X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=d38af3b8e91502efb02954036fa292508b123639;hb=825f7cdadcd71fb73aa7f6fa7c29b4f2d0c25366;hp=ad3033950f889123b98c0e7a2f9493cf7210b832;hpb=503ed64839f2938fc29e8bfbfb21f631a0c4ccda;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index ad30339..d38af3b 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -79,17 +79,29 @@ sub new {
     }
 
     my $self = bless $args, $class;
-
-    # extra attributes
     if($class ne __PACKAGE__){
         $class->meta->_initialize_object($self, $args);
     }
-
     return $self;
 }
 
-sub has_read_method      { $_[0]->has_reader || $_[0]->has_accessor }
-sub has_write_method     { $_[0]->has_writer || $_[0]->has_accessor }
+sub has_read_method   { $_[0]->has_reader || $_[0]->has_accessor }
+sub has_write_method  { $_[0]->has_writer || $_[0]->has_accessor }
+
+sub get_read_method   { $_[0]->reader || $_[0]->accessor }
+sub get_write_method  { $_[0]->writer || $_[0]->accessor }
+
+sub get_read_method_ref{
+    my($self) = @_;
+    return $self->{_read_method_ref}
+        ||= $self->_get_accessor_method_ref('get_read_method', '_generate_reader');
+}
+
+sub get_write_method_ref{
+    my($self) = @_;
+    return $self->{_write_method_ref}
+        ||= $self->_get_accessor_method_ref('get_write_method', '_generate_writer');
+}
 
 sub interpolate_class{
     my($class, $args) = @_;
@@ -125,22 +137,6 @@ sub interpolate_class{
     return( $class, @traits );
 }
 
-sub _coerce_and_verify {
-    #my($self, $value, $instance) = @_;
-    my($self, $value) = @_;
-
-    my $type_constraint = $self->{type_constraint};
-    return $value if !defined $type_constraint;
-
-    if ($self->should_coerce && $type_constraint->has_coercion) {
-        $value = $type_constraint->coerce($value);
-    }
-
-    $self->verify_against_type_constraint($value);
-
-    return $value;
-}
-
 sub verify_against_type_constraint {
     my ($self, $value) = @_;
 
@@ -199,12 +195,6 @@ sub clone_and_inherit_options{
     return $attribute_class->new($self->name, $args);
 }
 
-sub get_read_method {
-    return $_[0]->reader || $_[0]->accessor
-}
-sub get_write_method {
-    return $_[0]->writer || $_[0]->accessor
-}
 
 sub _get_accessor_method_ref {
     my($self, $type, $generator) = @_;
@@ -221,16 +211,6 @@ sub _get_accessor_method_ref {
     }
 }
 
-sub get_read_method_ref{
-    my($self) = @_;
-    return $self->{_read_method_ref} ||= $self->_get_accessor_method_ref('get_read_method', '_generate_reader');
-}
-
-sub get_write_method_ref{
-    my($self) = @_;
-    return $self->{_write_method_ref} ||= $self->_get_accessor_method_ref('get_write_method', '_generate_writer');
-}
-
 sub set_value {
     my($self, $object, $value) = @_;
     return $self->get_write_method_ref()->($object, $value);
@@ -257,7 +237,6 @@ sub clear_value {
     return $accessor_ref->($object);
 }
 
-
 sub associate_method{
     #my($attribute, $method_name) = @_;
     my($attribute) = @_;
@@ -282,7 +261,7 @@ sub install_accessors{
 
     # install delegation
     if(exists $attribute->{handles}){
-        my %handles = $attribute->_canonicalize_handles($attribute->{handles});
+        my %handles = $attribute->_canonicalize_handles();
 
         while(my($handle, $method_to_call) = each %handles){
             if($metaclass->has_method($handle)) {
@@ -305,48 +284,53 @@ sub delegation_metaclass() { ## no critic
 }
 
 sub _canonicalize_handles {
-    my($self, $handles) = @_;
+    my($self) = @_;
+    my $handles = $self->{handles};
 
-    if (ref($handles) eq 'HASH') {
+    my $handle_type = ref $handles;
+    if ($handle_type eq 'HASH') {
         return %$handles;
     }
-    elsif (ref($handles) eq 'ARRAY') {
+    elsif ($handle_type eq 'ARRAY') {
         return map { $_ => $_ } @$handles;
     }
-    elsif ( ref($handles) eq 'CODE' ) {
-        my $class_or_role = ( $self->{isa} || $self->{does} )
-            || $self->throw_error( "Cannot find delegate metaclass for attribute " . $self->name );
-        return $handles->( $self, Mouse::Meta::Class->initialize("$class_or_role"));
-    }
-    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
+    elsif ($handle_type eq 'Regexp') {
+        my $meta = $self->_find_delegate_metaclass();
         return map  { $_ => $_ }
                grep { !Mouse::Object->can($_) && $_ =~ $handles }
                    Mouse::Util::is_a_metarole($meta)
                         ? $meta->get_method_list
                         : $meta->get_all_method_names;
     }
+    elsif ($handle_type eq 'CODE') {
+        return $handles->( $self, $self->_find_delegate_metaclass() );
+    }
     else {
         $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
     }
 }
 
+sub _find_delegate_metaclass {
+    my($self) = @_;
+    my $meta;
+    if($self->{isa}) {
+        $meta = Mouse::Meta::Class->initialize("$self->{isa}");
+    }
+    elsif($self->{does}) {
+        $meta = Mouse::Util::get_metaclass_by_name("$self->{does}");
+    }
+    defined($meta) or $self->throw_error(
+        "Cannot find delegate metaclass for attribute " . $self->name);
+    return $meta;
+}
+
+
 sub _make_delegation_method {
     my($self, $handle, $method_to_call) = @_;
     return Mouse::Util::load_class($self->delegation_metaclass)
         ->_generate_delegation($self, $handle, $method_to_call);
 }
 
-sub throw_error{
-    my $self = shift;
-
-    my $metaclass = (ref $self && $self->associated_class) || 'Mouse::Meta::Class';
-    $metaclass->throw_error(@_, depth => 1);
-}
-
 1;
 __END__
 
@@ -356,7 +340,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.67
+This document describes Mouse version 0.74
 
 =head1 DESCRIPTION