X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FAttribute.pm;h=bc897ab667fd310fe875441e7985f0a3e6dd3a2a;hp=36c907a4546f141083f92249e156bb2e112ab078;hb=3301fa546394abbef62f5a7f9bbfc1c49ae6eb50;hpb=5aa30cedaeea188c11688187a689d70f4b7698d2 diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm index 36c907a..bc897ab 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,16 +19,19 @@ sub new { sub name { $_[0]->{name} } sub class { $_[0]->{class} } +sub _is_metadata { $_[0]->{is} } +sub is_required { $_[0]->{required} } sub default { $_[0]->{default} } +sub is_lazy { $_[0]->{lazy} } sub predicate { $_[0]->{predicate} } sub clearer { $_[0]->{clearer} } sub handles { $_[0]->{handles} } sub 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 has_name { exists $_[0]->{name} } -sub has_class { exists $_[0]->{class} } sub has_default { exists $_[0]->{default} } sub has_predicate { exists $_[0]->{predicate} } sub has_clearer { exists $_[0]->{clearer} } @@ -35,31 +39,36 @@ 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} } 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];'; if ($constraint) { - $accessor .= 'Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $_") unless $constraint->();' + $accessor .= 'do { + my $display = defined($_) ? $_ : "undef"; + Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display") unless $constraint->(); + };' } $accessor .= '$self->{$key} = $_;'; - if ($attribute->{weak_ref}) { + if ($attribute->weak_ref) { $accessor .= 'Scalar::Util::weaken($self->{$key});'; } @@ -72,9 +81,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});'; @@ -88,7 +97,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}) }'; @@ -97,7 +106,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}) }'; @@ -106,12 +115,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; @@ -153,22 +162,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'; @@ -188,7 +198,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 { @@ -203,6 +213,7 @@ sub verify_type_constraint { return 1 if $constraint->($_); my $name = $self->name; + local $_ = "undef" unless defined($_); Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $_"); }