X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=632da0209e34bed321428ca83fdded28e7bacaeb;hb=8aeb5bfd7b7da4622832804b39ee0179e816f7a1;hp=e6d999087d11c1961081fa5afc7c95a6a7547708;hpb=92d8204181e20d7b6a0144fca0a99095a7788ff4;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index e6d9990..632da02 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -5,9 +5,11 @@ use strict;
 use warnings;
 
 use Scalar::Util 'blessed', 'weaken';
+use List::MoreUtils 'any';
+use Try::Tiny;
 use overload     ();
 
-our $VERSION   = '0.87';
+our $VERSION   = '0.94';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -15,37 +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',
-    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',
@@ -57,7 +30,7 @@ __PACKAGE__->meta->add_attribute('traits' => (
 # for metatrait aliases.
 sub does {
     my ($self, $role_name) = @_;
-    my $name = eval {
+    my $name = try {
         Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
     };
     return 0 if !defined($name); # failed to load class
@@ -163,7 +136,7 @@ my @legal_options_for_inheritance = qw(
     documentation lazy handles
     builder type_constraint
     definition_context
-    lazy_build
+    lazy_build weak_ref
 );
 
 sub legal_options_for_inheritance { @legal_options_for_inheritance }
@@ -317,7 +290,7 @@ sub _process_options {
 
     if (exists $options->{isa}) {
         if (exists $options->{does}) {
-            if (eval { $options->{isa}->can('does') }) {
+            if (try { $options->{isa}->can('does') }) {
                 ($options->{isa}->does($options->{does}))
                     || $class->throw_error("Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)", data => $options);
             }
@@ -425,8 +398,10 @@ sub initialize_instance_slot {
     $val = $self->_coerce_and_verify( $val, $instance );
 
     $self->set_initial_value($instance, $val);
-    $meta_instance->weaken_slot_value($instance, $self->name)
-        if ref $val && $self->is_weak_ref;
+
+    if ( ref $val && $self->is_weak_ref ) {
+        $self->_weaken_value($instance);
+    }
 }
 
 sub _call_builder {
@@ -492,22 +467,33 @@ sub set_value {
 
     $value = $self->_coerce_and_verify( $value, $instance );
 
-    my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
-                                         ->get_meta_instance;
+    my @old;
+    if ( $self->has_trigger && $self->has_value($instance) ) {
+        @old = $self->get_value($instance, 'for trigger');
+    }
 
-    $meta_instance->set_slot_value($instance, $attr_name, $value);
+    $self->SUPER::set_value($instance, $value);
 
-    if (ref $value && $self->is_weak_ref) {
-        $meta_instance->weaken_slot_value($instance, $attr_name);
+    if ( ref $value && $self->is_weak_ref ) {
+        $self->_weaken_value($instance);
     }
 
     if ($self->has_trigger) {
-        $self->trigger->($instance, $value);
+        $self->trigger->($instance, $value, @old);
     }
 }
 
+sub _weaken_value {
+    my ( $self, $instance ) = @_;
+
+    my $meta_instance = Class::MOP::Class->initialize( blessed($instance) )
+        ->get_meta_instance;
+
+    $meta_instance->weaken_slot_value( $instance, $self->name );
+}
+
 sub get_value {
-    my ($self, $instance) = @_;
+    my ($self, $instance, $for_trigger) = @_;
 
     if ($self->is_lazy) {
         unless ($self->has_value($instance)) {
@@ -524,7 +510,7 @@ sub get_value {
         }
     }
 
-    if ($self->should_auto_deref) {
+    if ( $self->should_auto_deref && ! $for_trigger ) {
 
         my $type_constraint = $self->type_constraint;
 
@@ -556,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;
 }
 
@@ -601,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
@@ -617,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
@@ -630,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);
@@ -642,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);
     }
 }
@@ -681,10 +677,11 @@ sub _canonicalize_handles {
         (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
             || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles);
 
-        return map { $_ => $_ } (
+        return map { $_ => $_ }
+            grep { $_ ne 'meta' } (
             $role_meta->get_method_list,
             map { $_->name } $role_meta->get_required_method_list,
-        );
+            );
     }
 }
 
@@ -723,18 +720,20 @@ sub _get_delegate_method_list {
 sub delegation_metaclass { 'Moose::Meta::Method::Delegation' }
 
 sub _make_delegation_method {
-    my ( $self, $handle_name, $method_to_call ) = @_;
+    my ( $self, $handle_name, $method_to_call, $is_inline ) = @_;
 
-    my $method_body;
+    my @curried_arguments;
 
-    $method_body = $method_to_call
-        if 'CODE' eq ref($method_to_call);
+    ($method_to_call, @curried_arguments) = @$method_to_call
+        if 'ARRAY' eq ref($method_to_call);
 
     return $self->delegation_metaclass->new(
         name               => $handle_name,
         package_name       => $self->associated_class->name,
         attribute          => $self,
         delegate_to_method => $method_to_call,
+        curried_arguments  => \@curried_arguments,
+        is_inline          => $is_inline,
     );
 }
 
@@ -1130,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
 
@@ -1142,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>