From: 大沢 和宏 Date: Fri, 5 Dec 2008 16:55:16 +0000 (+0000) Subject: optimize for constructor and attribute X-Git-Tag: 0.19~136^2~24 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b3b74cc602b1f2490396e407aa38970b5aa6921a;p=gitmo%2FMouse.git optimize for constructor and attribute --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index f8ab85e..9f68070 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -48,9 +48,6 @@ 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; @@ -69,7 +66,6 @@ sub generate_accessor { my $name = $attribute->name; my $default = $attribute->default; - my $type = $attribute->type_constraint_as_string; my $constraint = $attribute->find_type_constraint; my $builder = $attribute->builder; my $trigger = $attribute->trigger; @@ -89,16 +85,15 @@ sub generate_accessor { if ($constraint) { $accessor .= 'my $val = '; if ($should_coerce) { - $accessor .= '$attribute->coerce_constraint('.$value.');'; + $accessor .= 'Mouse::TypeRegistry->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{find_type_constraint}, $attribute->{type_constraint}, '.$value.');'; } else { $accessor .= $value.';'; } $accessor .= 'local $_ = $val;'; $accessor .= ' unless ($constraint->()) { - my $display = defined($_) ? overload::StrVal($_) : "undef"; - Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display"); - }' . "\n"; + $attribute->verify_type_constraint_error($name, $_, $attribute->type_constraint); + }' . "\n"; $value = '$val'; } @@ -337,9 +332,12 @@ sub verify_type_constraint { return 1 if $_[0]->{find_type_constraint}->($_); my $self = shift; - my $type = $self->type_constraint_as_string; + $self->verify_type_constraint_error($self->name, $_, $self->type_constraint); +} - my $name = $self->name; +sub verify_type_constraint_error { + my($self, $name, $value, $type) = @_; + $type = ref($type) eq 'ARRAY' ? join '|', @{ $type } : $type; my $display = defined($_) ? overload::StrVal($_) : 'undef'; Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display"); } diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 2a9bf6c..7568dcd 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -40,15 +40,16 @@ sub _generate_processattrs { my $set_value = do { my @code; - if ($attr->should_coerce) { - push @code, "my \$value = \$attrs[$index]->coerce_constraint( \$args->{'$from'});"; + if ($attr->should_coerce && $attr->type_constraint) { + push @code, "my \$value = Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, \$args->{'$from'});"; } else { push @code, "my \$value = \$args->{'$from'};"; } if ($attr->has_type_constraint) { - push @code, "\$attrs[$index]->verify_type_constraint( \$value );"; + push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; } push @code, "\$instance->{'$key'} = \$value;"; @@ -58,7 +59,7 @@ sub _generate_processattrs { } if ( $attr->has_trigger ) { - push @code, "\$attrs[$index]->trigger->( \$instance, \$value, \$attrs[$index] );"; + push @code, "\$attrs[$index]->{trigger}->( \$instance, \$value, \$attrs[$index] );"; } join "\n", @code; @@ -74,14 +75,14 @@ sub _generate_processattrs { push @code, "my \$value = "; - if ($attr->should_coerce) { - push @code, "\$attrs[$index]->coerce_constraint("; + if ($attr->should_coerce && $attr->type_constraint) { + push @code, "Mouse::TypeRegistry->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{find_type_constraint}, \$attrs[$index]->{type_constraint}, "; } if ($attr->has_builder) { push @code, "\$instance->$builder"; } elsif (ref($default) eq 'CODE') { - push @code, "\$attrs[$index]->default()->(\$instance)"; + push @code, "\$attrs[$index]->{default}->(\$instance)"; } elsif (!defined($default)) { push @code, 'undef'; @@ -101,7 +102,8 @@ sub _generate_processattrs { } if ($attr->has_type_constraint) { - push @code, "\$attrs[$index]->verify_type_constraint(\$value);"; + push @code, "{local \$_ = \$value; unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {"; + push @code, "\$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)}}"; } push @code, "\$instance->{'$key'} = \$value;"; diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm index f11a831..4a97237 100644 --- a/lib/Mouse/TypeRegistry.pm +++ b/lib/Mouse/TypeRegistry.pm @@ -93,7 +93,7 @@ sub _subtype { Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg"; }; my $as = $conf{as}; - my $stuff = $conf{where} || optimized_constraints()->{$as}; + my $stuff = $conf{where} || $SUBTYPE{$as}; $SUBTYPE{$name} = $stuff; } @@ -102,9 +102,8 @@ sub _coerce { my($name, %conf) = @_; Carp::croak "Cannot find type '$name', perhaps you forgot to load it." - unless optimized_constraints()->{$name}; + unless $SUBTYPE{$name}; - my $subtypes = optimized_constraints(); unless ($COERCE{$name}) { $COERCE{$name} = {}; $COERCE_KEYS{$name} = []; @@ -114,7 +113,7 @@ sub _coerce { if $COERCE{$name}->{$type}; Carp::croak "Could not find the type constraint ($type) to coerce from" - unless $subtypes->{$type}; + unless $SUBTYPE{$type}; push @{ $COERCE_KEYS{$name} }, $type; $COERCE{$name}->{$type} = $code; @@ -146,16 +145,15 @@ sub _role_type { sub typecast_constraints { my($class, $pkg, $type_constraint, $types, $value) = @_; + local $_; for my $type (ref($types) eq 'ARRAY' ? @{ $types } : ( $types )) { next unless $COERCE{$type}; - for my $coerce_type (@{ $COERCE_KEYS{$type}}) { - local $_ = $value; - if ($SUBTYPE{$coerce_type}->()) { - local $_ = $value; - local $_ = $COERCE{$type}->{$coerce_type}->(); - return $_ if $type_constraint->(); - } + $_ = $value; + next unless $SUBTYPE{$coerce_type}->(); + $_ = $value; + $_ = $COERCE{$type}->{$coerce_type}->(); + return $_ if $type_constraint->(); } } return $value;