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=a4827e866074b05aa4a8ef6a2d49f8462133f3d4;hp=2eb2b6bd92b3e16219838fb8aba540b40979fff4;hb=f7e41edaceee0d549a2d664378cfcf85dcf9454b;hpb=935400114c35ad1b2481c48ff471e180e9c93d93 diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 2eb2b6b..a4827e8 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{ @@ -203,7 +205,7 @@ sub canonicalize_args{ # DEPRECATED Carp::cluck("$self->canonicalize_args has been deprecated." . "Use \$self->_process_options instead.") - if _MOUSE_VERBOSE; + if Mouse::Util::_MOUSE_VERBOSE; return %args; } @@ -213,7 +215,7 @@ sub create { # DEPRECATED Carp::cluck("$self->create has been deprecated." . "Use \$meta->add_attribute and \$attr->install_accessors instead.") - if _MOUSE_VERBOSE; + if Mouse::Util::_MOUSE_VERBOSE; # noop return $self; @@ -265,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 @@ -276,7 +284,7 @@ sub clone_parent { # DEPRECATED Carp::cluck("$self->clone_parent has been deprecated." . "Use \$meta->add_attribute and \$attr->install_accessors instead.") - if _MOUSE_VERBOSE; + if Mouse::Util::_MOUSE_VERBOSE; $self->clone_and_inherited_args($class, $name, %args); } @@ -352,8 +360,10 @@ 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; + grep { !Mouse::Object->can($_) && $_ =~ $handles } + Mouse::Util::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"); @@ -361,11 +371,14 @@ sub _canonicalize_handles { } sub associate_method{ - my ($attribute, $method) = @_; + my ($attribute, $method_name) = @_; $attribute->{associated_methods}++; return; } + +sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' } + sub install_accessors{ my($attribute) = @_; @@ -377,21 +390,22 @@ sub install_accessors{ my $generator = '_generate_' . $type; my $code = $accessor_class->$generator($attribute, $metaclass); $metaclass->add_method($attribute->{$type} => $code); - $attribute->associate_method($code); + $attribute->associate_method($attribute->{$type}); } } # 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); - $attribute->associate_method($code); + $attribute->associate_method($handle_name); } } @@ -421,7 +435,7 @@ Mouse::Meta::Attribute - The Mouse attribute metaclass =head1 VERSION -This document describes Mouse version 0.40 +This document describes Mouse version 0.40_08 =head1 METHODS @@ -529,12 +543,12 @@ is equivalent to this: =back -=head2 C<< associate_method(Method) >> +=head2 C<< associate_method(MethodName) >> Associates a method with the attribute. Typically, this is called internally when an attribute generates its accessors. -Currently the argument I is ignored in Mouse. +Currently the argument I is ignored in Mouse. =head2 C<< verify_against_type_constraint(Item) -> TRUE | ERROR >>