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=211cd52e87e0dfada0c2233a4edb3093122f889d;hb=f7e41edaceee0d549a2d664378cfcf85dcf9454b;hpb=9f74c4013f93b795e432e1818c3ebf13f5afb9f0 diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 211cd52..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{ @@ -156,48 +158,8 @@ sub new { return $self; } -# readers - -sub name { $_[0]->{name} } -sub associated_class { $_[0]->{associated_class} } - -sub accessor { $_[0]->{accessor} } -sub reader { $_[0]->{reader} } -sub writer { $_[0]->{writer} } -sub predicate { $_[0]->{predicate} } -sub clearer { $_[0]->{clearer} } -sub handles { $_[0]->{handles} } - -sub _is_metadata { $_[0]->{is} } -sub is_required { $_[0]->{required} } -sub default { $_[0]->{default} } -sub is_lazy { $_[0]->{lazy} } -sub is_lazy_build { $_[0]->{lazy_build} } -sub is_weak_ref { $_[0]->{weak_ref} } -sub init_arg { $_[0]->{init_arg} } -sub type_constraint { $_[0]->{type_constraint} } - -sub trigger { $_[0]->{trigger} } -sub builder { $_[0]->{builder} } -sub should_auto_deref { $_[0]->{auto_deref} } -sub should_coerce { $_[0]->{coerce} } - -# predicates - -sub has_accessor { exists $_[0]->{accessor} } -sub has_reader { exists $_[0]->{reader} } -sub has_writer { exists $_[0]->{writer} } -sub has_predicate { exists $_[0]->{predicate} } -sub has_clearer { exists $_[0]->{clearer} } -sub has_handles { exists $_[0]->{handles} } - -sub has_default { exists $_[0]->{default} } -sub has_type_constraint { exists $_[0]->{type_constraint} } -sub has_trigger { exists $_[0]->{trigger} } -sub has_builder { exists $_[0]->{builder} } - -sub has_read_method { exists $_[0]->{reader} || exists $_[0]->{accessor} } -sub has_write_method { exists $_[0]->{writer} || exists $_[0]->{accessor} } +sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor } +sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor } sub _create_args { # DEPRECATED $_[0]->{_create_args} = $_[1] if @_ > 1; @@ -243,17 +205,17 @@ 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; } -sub create { +sub create { # DEPRECATED my ($self, $class, $name, %args) = @_; 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; @@ -263,15 +225,12 @@ sub _coerce_and_verify { my($self, $value, $instance) = @_; my $type_constraint = $self->{type_constraint}; - - return $value if !$type_constraint; + return $value if !defined $type_constraint; if ($self->should_coerce && $type_constraint->has_coercion) { $value = $type_constraint->coerce($value); } - return $value if $type_constraint->check($value); - $self->verify_against_type_constraint($value); return $value; @@ -281,7 +240,7 @@ sub verify_against_type_constraint { my ($self, $value) = @_; my $type_constraint = $self->{type_constraint}; - return 1 if !$type_constraint;; + return 1 if !$type_constraint; return 1 if $type_constraint->check($value); $self->verify_type_constraint_error($self->name, $value, $type_constraint); @@ -289,7 +248,8 @@ sub verify_against_type_constraint { sub verify_type_constraint_error { my($self, $name, $value, $type) = @_; - $self->throw_error("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value)); + $self->throw_error("Attribute ($name) does not pass the type constraint because: " + . $type->get_message($value)); } sub coerce_constraint { # DEPRECATED @@ -307,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 @@ -318,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); } @@ -338,11 +304,11 @@ sub get_parent_args { # DEPRECATED } -sub get_read_method { # DEPRECATED - $_[0]->{reader} || $_[0]->{accessor} +sub get_read_method { + $_[0]->reader || $_[0]->accessor } -sub get_write_method { # DEPRECATED - $_[0]->{writer} || $_[0]->{accessor} +sub get_write_method { + $_[0]->writer || $_[0]->accessor } sub get_read_method_ref{ @@ -388,24 +354,35 @@ sub _canonicalize_handles { elsif (ref($handles) eq 'ARRAY') { return map { $_ => $_ } @$handles; } + 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 + return map { $_ => $_ } + 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"); } } - sub associate_method{ - my ($attribute, $method) = @_; + my ($attribute, $method_name) = @_; $attribute->{associated_methods}++; return; } -sub accessor_metaclass(){ 'Mouse::Meta::Method::Accessor' } + +sub delegation_metaclass() { 'Mouse::Meta::Method::Delegation' } sub install_accessors{ my($attribute) = @_; - my $metaclass = $attribute->{associated_class}; + my $metaclass = $attribute->associated_class; my $accessor_class = $attribute->accessor_metaclass; foreach my $type(qw(accessor reader writer predicate clearer)){ @@ -413,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); } } @@ -455,6 +433,10 @@ __END__ Mouse::Meta::Attribute - The Mouse attribute metaclass +=head1 VERSION + +This document describes Mouse version 0.40_08 + =head1 METHODS =head2 C<< new(%options) -> Mouse::Meta::Attribute >> @@ -561,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 >> @@ -578,13 +560,13 @@ on success, otherwise Ces. Creates a new attribute in the owner class, inheriting options from parent classes. Accessors and helper methods are installed. Some error checking is done. -=head2 C<< get_read_method_ref >> - -=head2 C<< get_write_method_ref >> - -Returns the subroutine reference of a method suitable for reading or -writing the attribute's value in the associated class. These methods -always return a subroutine reference, regardless of whether or not the +=head2 C<< get_read_method_ref >> + +=head2 C<< get_write_method_ref >> + +Returns the subroutine reference of a method suitable for reading or +writing the attribute's value in the associated class. These methods +always return a subroutine reference, regardless of whether or not the attribute is read- or write-only. =head1 SEE ALSO