Made the delegation closure have useful error trace information.

[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 8f638f7..632da02 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -5,10 +5,11 @@ use strict;
 use warnings;
 
 use Scalar::Util 'blessed', 'weaken';
+use List::MoreUtils 'any';
 use Try::Tiny;
 use overload     ();
 
-our $VERSION   = '0.92';
+our $VERSION   = '0.94';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -16,38 +17,8 @@ use Moose::Meta::Method::Delegation;
 use Moose::Util ();
 use Moose::Util::TypeConstraints ();
 
-use base 'Class::MOP::Attribute';
-
-# options which are not directly used
-# but we store them for metadata purposes
-__PACKAGE__->meta->add_attribute('isa'  => (reader    => '_isa_metadata'));
-__PACKAGE__->meta->add_attribute('does' => (reader    => '_does_metadata'));
-__PACKAGE__->meta->add_attribute('is'   => (reader    => '_is_metadata'));
-
-# these are actual options for the attrs
-__PACKAGE__->meta->add_attribute('required'   => (reader => 'is_required'      ));
-__PACKAGE__->meta->add_attribute('lazy'       => (reader => 'is_lazy'          ));
-__PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build'    ));
-__PACKAGE__->meta->add_attribute('coerce'     => (reader => 'should_coerce'    ));
-__PACKAGE__->meta->add_attribute('weak_ref'   => (reader => 'is_weak_ref'      ));
-__PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
-__PACKAGE__->meta->add_attribute('type_constraint' => (
-    reader    => 'type_constraint',
-    predicate => 'has_type_constraint',
-));
-__PACKAGE__->meta->add_attribute('trigger' => (
-    reader    => 'trigger',
-    predicate => 'has_trigger',
-));
-__PACKAGE__->meta->add_attribute('handles' => (
-    reader    => 'handles',
-    writer    => '_set_handles',
-    predicate => 'has_handles',
-));
-__PACKAGE__->meta->add_attribute('documentation' => (
-    reader    => 'documentation',
-    predicate => 'has_documentation',
-));
+use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore';
+
 __PACKAGE__->meta->add_attribute('traits' => (
     reader    => 'applied_traits',
     predicate => 'has_applied_traits',
@@ -571,7 +542,7 @@ sub accessor_metaclass { 'Moose::Meta::Method::Accessor' }
 sub install_accessors {
     my $self = shift;
     $self->SUPER::install_accessors(@_);
-    $self->install_delegation if $self->has_handles;
+    $self->install_delegation(@_);
     return;
 }
 
@@ -616,6 +587,9 @@ sub remove_accessors {
 
 sub install_delegation {
     my $self = shift;
+    my $inline = shift;
+
+    return unless $self->has_handles;
 
     # NOTE:
     # Here we canonicalize the 'handles' option
@@ -632,8 +606,12 @@ sub install_delegation {
         my $class_name = $associated_class->name;
         my $name = "${class_name}::${handle}";
 
-            (!$associated_class->has_method($handle))
-                || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method_name => $handle);
+        if ($associated_class->has_method($handle)) {
+            $self->throw_error(
+                "You cannot overwrite a locally defined method ($handle) with a delegation",
+                method_name => $handle
+            ) unless $inline;
+        }
 
         # NOTE:
         # handles is not allowed to delegate
@@ -645,7 +623,7 @@ sub install_delegation {
         #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);
 
-        my $method = $self->_make_delegation_method($handle, $method_to_call);
+        my $method = $self->_make_delegation_method($handle, $method_to_call, $inline);
 
         $self->associated_class->add_method($method->name, $method);
         $self->associate_method($method);
@@ -657,6 +635,9 @@ sub remove_delegation {
     my %handles = $self->_canonicalize_handles;
     my $associated_class = $self->associated_class;
     foreach my $handle (keys %handles) {
+        next unless any { $handle eq $_ }
+                    map { $_->name }
+                    @{ $self->associated_methods };
         $self->associated_class->remove_method($handle);
     }
 }
@@ -739,12 +720,7 @@ sub _get_delegate_method_list {
 sub delegation_metaclass { 'Moose::Meta::Method::Delegation' }
 
 sub _make_delegation_method {
-    my ( $self, $handle_name, $method_to_call ) = @_;
-
-    my $method_body;
-
-    $method_body = $method_to_call
-        if 'CODE' eq ref($method_to_call);
+    my ( $self, $handle_name, $method_to_call, $is_inline ) = @_;
 
     my @curried_arguments;
 
@@ -757,6 +733,7 @@ sub _make_delegation_method {
         attribute          => $self,
         delegate_to_method => $method_to_call,
         curried_arguments  => \@curried_arguments,
+        is_inline          => $is_inline,
     );
 }
 
@@ -1152,9 +1129,7 @@ Returns true if this attribute has any traits applied.
 
 =head1 BUGS
 
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
+See L<Moose/BUGS> for details on reporting bugs.
 
 =head1 AUTHOR
 
@@ -1164,7 +1139,7 @@ Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>