X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FAttribute.pm;h=da448b50bb38bf0fa30c1905513e1a6af2ab5401;hb=ccea8101f730f46ee7e85769b6472cf91d0f5240;hp=41a56df0a6599013884870a92ea942b7c7deea5f;hpb=c3398f5bd45f2851b7cd40ca9823bcf7d2378469;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Attribute.pm b/lib/Mouse/Attribute.pm index 41a56df..da448b5 100644 --- a/lib/Mouse/Attribute.pm +++ b/lib/Mouse/Attribute.pm @@ -9,41 +9,70 @@ sub new { my $class = shift; my %args = @_; - $args{init_arg} ||= $args{name}; + $args{init_arg} = $args{name} + unless exists $args{init_arg}; $args{is} ||= ''; bless \%args, $class; } -sub name { $_[0]->{name} } -sub class { $_[0]->{class} } -sub default { $_[0]->{default} } -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 name { $_[0]->{name} } +sub class { $_[0]->{class} } +sub default { $_[0]->{default} } +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 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} } +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 generate_accessor { my $attribute = shift; - my $key = $attribute->{init_arg}; - my $default = $attribute->{default}; - my $trigger = $attribute->{trigger}; + my $name = $attribute->{name}; + my $key = $attribute->{init_arg}; + my $default = $attribute->{default}; + my $trigger = $attribute->{trigger}; + my $type = $attribute->{type_constraint}; + + my $constraint = sub { + return unless $type; + + my $checker = Mouse::TypeRegistry->optimized_constraints->{$type}; + return $checker if $checker; + + confess "Unable to parse type constraint '$type'"; + }->(); my $accessor = 'sub { my $self = shift;'; if ($attribute->{is} eq 'rw') { $accessor .= 'if (@_) { - $self->{$key} = $_[0];'; + 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 .= '$self->{$key} = $_;'; if ($attribute->{weak_ref}) { $accessor .= 'Scalar::Util::weaken($self->{$key});'; } if ($trigger) { - $accessor .= '$trigger->($self, $_[0], $attribute);'; + $accessor .= '$trigger->($self, $_, $attribute);'; } $accessor .= '}'; @@ -124,9 +153,13 @@ sub create { if exists($args{handles}) && ref($args{handles}) ne 'HASH'; + $args{type_constraint} = delete $args{isa}; + my $attribute = $self->new(%args, name => $name, class => $class); my $meta = $class->meta; + $meta->add_attribute($attribute); + # install an accessor if ($attribute->{is} eq 'rw' || $attribute->{is} eq 'ro') { my $accessor = $attribute->generate_accessor; @@ -134,8 +167,6 @@ sub create { *{ $class . '::' . $name } = $accessor; } - $meta->add_attribute($attribute); - for my $method (qw/predicate clearer/) { if (exists $attribute->{$method}) { my $generator = "generate_$method";