X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=23324b2bfb9c33c264e7b00b8cff725cec3041c1;hb=6361ccf5f1b303625c83d93a3099ce51b5a74c95;hp=9dbc1c298bd1e14fa05c13c781e7232b4019b831;hpb=8de73ff1824ee835a072b36cd603deb7037983b5;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 9dbc1c2..23324b2 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -6,9 +6,10 @@ use warnings;
 
 use Scalar::Util 'blessed', 'weaken', 'reftype';
 use Carp         'confess';
+use Sub::Name    'subname';
 use overload     ();
 
-our $VERSION   = '0.15';
+our $VERSION   = '0.16';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -178,13 +179,14 @@ sub _process_options {
     if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
         confess("You can not use lazy_build and default for the same attribute")
             if exists $options->{default};
-        $options->{lazy} = 1;
-        $options->{required} = 1;
-            $options->{builder}   ||= "_build_${name}";
-        if($name =~ /^_/){
+        $options->{lazy}      = 1;
+        $options->{required}  = 1;
+        $options->{builder} ||= "_build_${name}";
+        if ($name =~ /^_/) {
             $options->{clearer}   ||= "_clear${name}";
             $options->{predicate} ||= "_has${name}";
-        } else {
+        } 
+        else {
             $options->{clearer}   ||= "clear_${name}";
             $options->{predicate} ||= "has_${name}";
         }
@@ -206,7 +208,7 @@ sub initialize_instance_slot {
     my $value_is_set;
     if (exists $params->{$init_arg}) {
         $val = $params->{$init_arg};
-        $value_is_set = 1;
+        $value_is_set = 1;    
     }
     else {
         # skip it if it's lazy
@@ -220,11 +222,13 @@ sub initialize_instance_slot {
         if ($self->has_default) {
             $val = $self->default($instance);
             $value_is_set = 1;
-        } elsif ($self->has_builder) {
-            if(my $builder = $instance->can($self->builder)){
+        } 
+        elsif ($self->has_builder) {
+            if (my $builder = $instance->can($self->builder)){
                 $val = $instance->$builder;
                 $value_is_set = 1;
-            } else {
+            } 
+            else {
                 confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
             }
         }
@@ -244,16 +248,14 @@ sub initialize_instance_slot {
                        $type_constraint->name .
                        ") with '" .
                        (defined $val
-                           ? (blessed($val) && overload::Overloaded($val)
-                                ? overload::StrVal($val)
-                                : $val)
+                           ? overload::StrVal($val)
                            : 'undef') .
                        "'";
     }
 
     $meta_instance->set_slot_value($instance, $self->name, $val);
     $meta_instance->weaken_slot_value($instance, $self->name)
-      if ref $val && $self->is_weak_ref;
+        if ref $val && $self->is_weak_ref;
 }
 
 ## Slot management
@@ -280,11 +282,7 @@ sub set_value {
                . $type_constraint->name
                . ") with "
                . (defined($value)
-                    ? ("'" .
-                        (blessed($value) && overload::Overloaded($value)
-                            ? overload::StrVal($value)
-                            : $value)
-                        . "'")
+                    ? ("'" . overload::StrVal($value) . "'")
                     : "undef")
           if defined($value);
     }
@@ -313,12 +311,19 @@ sub get_value {
                 $self->set_value($instance, $default);
             }
             if ( $self->has_builder ){
-                if(my $builder = $instance->can($self->builder)){
+                if (my $builder = $instance->can($self->builder)){
                     $self->set_value($instance, $instance->$builder);
-                } else {
-                    confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
+                } 
+                else {
+                    confess(blessed($instance) 
+                          . " does not support builder method '"
+                          . $self->builder 
+                          . "' for attribute '" 
+                          . $self->name 
+                          . "'");
                 }
-            } else {
+            } 
+            else {
                 $self->set_value($instance, undef);
             }
         }
@@ -375,6 +380,8 @@ sub install_accessors {
         my $associated_class = $self->associated_class;
         foreach my $handle (keys %handles) {
             my $method_to_call = $handles{$handle};
+            my $class_name = $associated_class->name;
+            my $name = "${class_name}::${handle}";
 
             (!$associated_class->has_method($handle))
                 || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
@@ -384,20 +391,19 @@ sub install_accessors {
             # any of these methods, as they will
             # override the ones in your class, which
             # is almost certainly not what you want.
-            next if $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
+
+            # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
+            #cluck("Not delegating method '$handle' because it is a core method") and
+            next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
 
             if ((reftype($method_to_call) || '') eq 'CODE') {
-                $associated_class->add_method($handle => $method_to_call);
+                $associated_class->add_method($handle => subname $name, $method_to_call);
             }
             else {
-                $associated_class->add_method($handle => sub {
-                    # FIXME
-                    # we should check for lack of
-                    # a callable return value from
-                    # the accessor here
+                $associated_class->add_method($handle => subname $name, sub {
                     my $proxy = (shift)->$accessor();
                     @_ = ($proxy, @_);
-                    goto &{ $proxy->can($method_to_call) };
+                    goto &{ $proxy->can($method_to_call) || return };
                 });
             }
         }
@@ -541,7 +547,7 @@ value fails to pass, the set operation dies with a L<Carp/confess>.
 Any coercion to convert values is done before checking the type constraint.
 
 To check a value against a type constraint before setting it, fetch the
-attribute instance using L<Moose::Meta::Attribute/find_attribute_by_name>,
+attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
 and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
 for an example.
@@ -670,7 +676,7 @@ Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>