X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=479c43c945ca0203c5363fe0fb73989d0fe3037a;hb=2b9094e8e533f1635eae1481eef711828f521508;hp=8f81bc027a9a6643a4cfa7b0a5161e78c3d14957;hpb=adebd0a83f0b7b52be8834444b40eedd0ddc2d66;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 8f81bc0..479c43c 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -47,11 +47,6 @@ sub has_type_constraint { exists $_[0]->{type_constraint} } sub has_trigger { exists $_[0]->{trigger} } sub has_builder { exists $_[0]->{builder} } -sub find_type_constraint { $_[0]->{find_type_constraint} } -sub type_constraint_as_string { - ref($_[0]->{type_constraint}) eq 'ARRAY' ? join '|', @{ $_[0]->{type_constraint} } : $_[0]->{type_constraint} -} - sub _create_args { $_[0]->{_create_args} = $_[1] if @_ > 1; $_[0]->{_create_args} @@ -69,7 +64,7 @@ sub generate_accessor { my $name = $attribute->name; my $default = $attribute->default; - my $type = $attribute->type_constraint_as_string; + my $type = $attribute->type_constraint; my $constraint = $attribute->find_type_constraint; my $builder = $attribute->builder; my $trigger = $attribute->trigger; @@ -87,12 +82,10 @@ sub generate_accessor { my $value = '$_[1]'; if ($constraint) { - $accessor .= 'local $_ = '.$self.'->{'.$key.'} = '; if ($should_coerce) { - $accessor .= '$attribute->coerce_constraint('.$value.');'; - } else { - $accessor .= $value.';'; + $accessor .= $value.' = $attribute->coerce_constraint('.$value.');'; } + $accessor .= 'local $_ = '.$value.';'; $accessor .= ' unless ($constraint->()) { my $display = defined($_) ? overload::StrVal($_) : "undef"; @@ -104,6 +97,8 @@ sub generate_accessor { # this setter $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; + $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n"; + if ($is_weak) { $accessor .= 'Mouse::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; } @@ -130,8 +125,7 @@ sub generate_accessor { } if ($should_deref) { - my $type_constraint = $attribute->type_constraint; - if (!ref($type_constraint) && $type_constraint eq 'ArrayRef') { + if ($attribute->type_constraint eq 'ArrayRef') { $accessor .= 'if (wantarray) { return @{ '.$self.'->{'.$key.'} || [] }; }'; @@ -207,33 +201,8 @@ sub create { $args{should_coerce} = delete $args{coerce} if exists $args{coerce}; - if (exists $args{isa}) { - my $type_constraint = delete $args{isa}; - $type_constraint =~ s/\s//g; - my @type_constraints = split /\|/, $type_constraint; - - my $code; - my $optimized_constraints = Mouse::TypeRegistry->optimized_constraints; - if (@type_constraints == 1) { - $code = $optimized_constraints->{$type_constraints[0]} || - sub { Mouse::Util::blessed($_) && Mouse::Util::blessed($_) eq $type_constraints[0] }; - $args{type_constraint} = $type_constraints[0]; - } else { - my @code_list = map { - my $type = $_; - $optimized_constraints->{$type} || - sub { Mouse::Util::blessed($_) && Mouse::Util::blessed($_) eq $type } - } @type_constraints; - $code = sub { - for my $code (@code_list) { - return 1 if $code->(); - } - return 0; - }; - $args{type_constraint} = \@type_constraints; - } - $args{find_type_constraint} = $code; - } + $args{type_constraint} = delete $args{isa} + if exists $args{isa}; my $attribute = $self->new(%args); @@ -326,11 +295,23 @@ sub validate_args { return 1; } +sub find_type_constraint { + my $self = shift; + my $type = $self->type_constraint; + + return unless $type; + + my $checker = Mouse::TypeRegistry->optimized_constraints()->{$type}; + return $checker if $checker; + + return sub { Mouse::Util::blessed($_) && Mouse::Util::blessed($_) eq $type }; +} + sub verify_type_constraint { my $self = shift; local $_ = shift; - my $type = $self->type_constraint_as_string + my $type = $self->type_constraint or return 1; my $constraint = $self->find_type_constraint; @@ -345,7 +326,7 @@ sub coerce_constraint { my($self, $value) = @_; my $type = $self->type_constraint or return $value; - return Mouse::TypeRegistry->typecast_constraints($self->associated_class->name, $self->find_type_constraint, $type, $value); + return Mouse::TypeRegistry->typecast_constraints($self->associated_class->name, $type, $value); } sub _canonicalize_handles {