X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FAttribute.pm;h=08eab3101e1d5fcb3caa8eba0eb9ebb8a8f43509;hb=ab27a55e79fe77296eeebfbba1adbd3155f1a746;hp=923bff288fae265e0d0084dee31fe61edbb8fb0a;hpb=de9a434a5cdc3c564b6f4cb93bb053f2eed20a03;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm index 923bff2..08eab31 100644 --- a/lib/Mouse/Attribute.pm +++ b/lib/Mouse/Attribute.pm @@ -4,6 +4,7 @@ use strict; use warnings; use Carp 'confess'; +use Scalar::Util 'blessed'; sub new { my $class = shift; @@ -18,9 +19,10 @@ sub new { sub name { $_[0]->{name} } sub class { $_[0]->{class} } -sub required { $_[0]->{required} } +sub _is_metadata { $_[0]->{is} } +sub is_required { $_[0]->{required} } sub default { $_[0]->{default} } -sub lazy { $_[0]->{lazy} } +sub is_lazy { $_[0]->{lazy} } sub predicate { $_[0]->{predicate} } sub clearer { $_[0]->{clearer} } sub handles { $_[0]->{handles} } @@ -34,8 +36,6 @@ sub has_default { exists $_[0]->{default} } sub has_predicate { exists $_[0]->{predicate} } sub has_clearer { exists $_[0]->{clearer} } sub has_handles { exists $_[0]->{handles} } -sub has_weak_ref { exists $_[0]->{weak_ref} } -sub has_init_arg { exists $_[0]->{init_arg} } sub has_type_constraint { exists $_[0]->{type_constraint} } sub has_trigger { exists $_[0]->{trigger} } sub has_builder { exists $_[0]->{builder} } @@ -43,17 +43,17 @@ sub has_builder { exists $_[0]->{builder} } sub generate_accessor { my $attribute = shift; - my $name = $attribute->{name}; - my $key = $attribute->{init_arg}; - my $default = $attribute->{default}; - my $trigger = $attribute->{trigger}; - my $type = $attribute->{type_constraint}; + my $name = $attribute->name; + my $key = $attribute->init_arg; + my $default = $attribute->default; + my $trigger = $attribute->trigger; + my $type = $attribute->type_constraint; my $constraint = $attribute->find_type_constraint; my $accessor = 'sub { my $self = shift;'; - if ($attribute->{is} eq 'rw') { + if ($attribute->_is_metadata eq 'rw') { $accessor .= 'if (@_) { local $_ = $_[0];'; @@ -66,7 +66,7 @@ sub generate_accessor { $accessor .= '$self->{$key} = $_;'; - if ($attribute->{weak_ref}) { + if ($attribute->weak_ref) { $accessor .= 'Scalar::Util::weaken($self->{$key});'; } @@ -79,9 +79,9 @@ sub generate_accessor { else { } - if ($attribute->{lazy}) { + if ($attribute->is_lazy) { $accessor .= '$self->{$key} = '; - $accessor .= ref($attribute->{default}) eq 'CODE' + $accessor .= ref($default) eq 'CODE' ? '$default->($self)' : '$default'; $accessor .= ' if !exists($self->{$key});'; @@ -95,7 +95,7 @@ sub generate_accessor { sub generate_predicate { my $attribute = shift; - my $key = $attribute->{init_arg}; + my $key = $attribute->init_arg; my $predicate = 'sub { exists($_[0]->{$key}) }'; @@ -104,7 +104,7 @@ sub generate_predicate { sub generate_clearer { my $attribute = shift; - my $key = $attribute->{init_arg}; + my $key = $attribute->init_arg; my $predicate = 'sub { delete($_[0]->{$key}) }'; @@ -113,12 +113,12 @@ sub generate_clearer { sub generate_handles { my $attribute = shift; - my $reader = $attribute->{name}; + my $reader = $attribute->name; my %method_map; - for my $local_method (keys %{ $attribute->{handles} }) { - my $remote_method = $attribute->{handles}{$local_method}; + for my $local_method (keys %{ $attribute->handles }) { + my $remote_method = $attribute->handles->{$local_method}; my $method = 'sub { my $self = shift; @@ -160,22 +160,23 @@ sub create { $meta->add_attribute($attribute); # install an accessor - if ($attribute->{is} eq 'rw' || $attribute->{is} eq 'ro') { + if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') { my $accessor = $attribute->generate_accessor; no strict 'refs'; *{ $class . '::' . $name } = $accessor; } for my $method (qw/predicate clearer/) { - if (exists $attribute->{$method}) { + my $predicate = "has_$method"; + if ($attribute->$predicate) { my $generator = "generate_$method"; my $coderef = $attribute->$generator; no strict 'refs'; - *{ $class . '::' . $attribute->{$method} } = $coderef; + *{ $class . '::' . $attribute->$method } = $coderef; } } - if ($attribute->{handles}) { + if ($attribute->has_handles) { my $method_map = $attribute->generate_handles; for my $method_name (keys %$method_map) { no strict 'refs'; @@ -195,7 +196,7 @@ sub find_type_constraint { my $checker = Mouse::TypeRegistry->optimized_constraints->{$type}; return $checker if $checker; - confess "Unable to parse type constraint '$type'"; + return sub { blessed($_) && blessed($_) eq $type }; } sub verify_type_constraint { @@ -237,18 +238,42 @@ installed. Some error checking is done. =head2 class -> OwnerClass -=head2 default -> Value +=head2 is_required -> Bool -=head2 predicate -> MethodName +=head2 default -> Item -=head2 clearer -> MethodName +=head2 has_default -> Bool + +=head2 is_lazy -> Bool + +=head2 predicate -> MethodName | Undef + +=head2 has_predicate -> Bool + +=head2 clearer -> MethodName | Undef + +=head2 has_clearer -> Bool =head2 handles -> { LocalName => RemoteName } +=head2 has_handles -> Bool + =head2 weak_ref -> Bool =head2 init_arg -> Str +=head2 type_constraint -> Str + +=head2 has_type_constraint -> Bool + +=head2 trigger => CODE | Undef + +=head2 has_trigger -> Bool + +=head2 builder => MethodName | Undef + +=head2 has_builder -> Bool + Informational methods. =head2 generate_accessor -> CODE