optimize for constructor and attribute

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index f8ab85e..9f68070 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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;