much faster impl. for constructor/accessor. this is a same behavior with Moose.
Tokuhiro Matsuno [Mon, 9 Mar 2009 16:07:30 +0000 (01:07 +0900)]
lib/Mouse/Meta/Attribute.pm
lib/Mouse/Meta/Method/Constructor.pm
lib/Mouse/Util/TypeConstraints.pm

index 6c90b30..b3e3e50 100644 (file)
@@ -86,10 +86,9 @@ sub generate_accessor {
             } else {
                 $accessor .= $value.';';
             }
-            $accessor .= 'local $_ = $val;';
             $accessor .= '
-                unless ($constraint->()) {
-                    $attribute->verify_type_constraint_error($name, $_, $attribute->type_constraint);
+                unless ($constraint->($val)) {
+                    $attribute->verify_type_constraint_error($name, $val, $attribute->type_constraint);
                 }' . "\n";
             $value = '$val';
         }
@@ -237,7 +236,7 @@ sub _build_type_constraint {
     } else {
         $code = $optimized_constraints->{ $spec };
         if (! $code) {
-            $code = sub { Scalar::Util::blessed($_) && $_->isa($spec) };
+            $code = sub { Scalar::Util::blessed($_[0]) && $_[0]->isa($spec) };
             $optimized_constraints->{$spec} = $code;
         }
     }
@@ -275,8 +274,9 @@ sub create {
                 _build_type_constraint($_)
             } @type_constraints;
             $code = sub {
+                local $_ = $_[0];
                 for my $code (@code_list) {
-                    return 1 if $code->();
+                    return 1 if $code->($_);
                 }
                 return 0;
             };
@@ -389,7 +389,7 @@ sub verify_against_type_constraint {
 sub verify_type_constraint_error {
     my($self, $name, $value, $type) = @_;
     $type = ref($type) eq 'ARRAY' ? join '|', @{ $type } : $type;
-    my $display = defined($_) ? overload::StrVal($_) : 'undef';
+    my $display = defined($value) ? overload::StrVal($value) : 'undef';
     Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display");
 }
 
index dfbeb29..4c22fd8 100644 (file)
@@ -50,8 +50,7 @@ sub _generate_processattrs {
 
             if ($attr->has_type_constraint) {
                 $code .= "{
-                    local \$_ = \$value;
-                    unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {
+                    unless (\$attrs[$index]->{find_type_constraint}->(\$value)) {
                         \$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)
                     }
                 }";
@@ -106,8 +105,7 @@ sub _generate_processattrs {
 
                 if ($attr->has_type_constraint) {
                     $code .= "{
-                        local \$_ = \$value;
-                        unless (\$attrs[$index]->{find_type_constraint}->(\$_)) {
+                        unless (\$attrs[$index]->{find_type_constraint}->(\$value)) {
                             \$attrs[$index]->verify_type_constraint_error('$key', \$_, \$attrs[$index]->type_constraint)
                         }
                     }";
index 6410243..d81d5d0 100644 (file)
@@ -38,31 +38,31 @@ my $optimized_constraints_base;
         Any        => sub { 1 },
         Item       => sub { 1 },
         Bool       => sub {
-            !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0'
+            !defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'
         },
-        Undef      => sub { !defined($_) },
-        Defined    => sub { defined($_) },
-        Value      => sub { defined($_) && !ref($_) },
-        Num        => sub { !ref($_) && looks_like_number($_) },
-        Int        => sub { defined($_) && !ref($_) && /^-?[0-9]+$/ },
-        Str        => sub { defined($_) && !ref($_) },
-        ClassName  => sub { Mouse::is_class_loaded($_) },
-        Ref        => sub { ref($_) },
-
-        ScalarRef  => sub { ref($_) eq 'SCALAR' },
-        ArrayRef   => sub { ref($_) eq 'ARRAY'  },
-        HashRef    => sub { ref($_) eq 'HASH'   },
-        CodeRef    => sub { ref($_) eq 'CODE'   },
-        RegexpRef  => sub { ref($_) eq 'Regexp' },
-        GlobRef    => sub { ref($_) eq 'GLOB'   },
+        Undef      => sub { !defined($_[0]) },
+        Defined    => sub { defined($_[0]) },
+        Value      => sub { defined($_[0]) && !ref($_[0]) },
+        Num        => sub { !ref($_[0]) && looks_like_number($_[0]) },
+        Int        => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
+        Str        => sub { defined($_[0]) && !ref($_[0]) },
+        ClassName  => sub { Mouse::is_class_loaded($_[0]) },
+        Ref        => sub { ref($_[0]) },
+
+        ScalarRef  => sub { ref($_[0]) eq 'SCALAR' },
+        ArrayRef   => sub { ref($_[0]) eq 'ARRAY'  },
+        HashRef    => sub { ref($_[0]) eq 'HASH'   },
+        CodeRef    => sub { ref($_[0]) eq 'CODE'   },
+        RegexpRef  => sub { ref($_[0]) eq 'Regexp' },
+        GlobRef    => sub { ref($_[0]) eq 'GLOB'   },
 
         FileHandle => sub {
-            ref($_) eq 'GLOB' && openhandle($_)
+            ref($_[0]) eq 'GLOB' && openhandle($_[0])
             or
-            blessed($_) && $_->isa("IO::Handle")
+            blessed($_[0]) && $_[0]->isa("IO::Handle")
         },
 
-        Object     => sub { blessed($_) && blessed($_) ne 'Regexp' },
+        Object     => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
     );
 
     sub optimized_constraints { \%TYPE }
@@ -81,7 +81,7 @@ sub type {
     my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
 
     $TYPE_SOURCE{$name} = $pkg;
-    $TYPE{$name} = $constraint;
+    $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
 }
 
 sub subtype {
@@ -102,9 +102,9 @@ sub subtype {
     $TYPE_SOURCE{$name} = $pkg;
 
     if ($as = $TYPE{$as}) {
-        $TYPE{$name} = sub { $as->($_) && $constraint->($_) };
+        $TYPE{$name} = sub { local $_=$_[0]; $as->($_) && $constraint->($_) };
     } else {
-        $TYPE{$name} = $constraint;
+        $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
     }
 }
 
@@ -164,10 +164,10 @@ sub typecast_constraints {
         next unless $COERCE{$type};
         for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
             $_ = $value;
-            next unless $TYPE{$coerce_type}->();
+            next unless $TYPE{$coerce_type}->($value);
             $_ = $value;
-            $_ = $COERCE{$type}->{$coerce_type}->();
-            return $_ if $type_constraint->();
+            $_ = $COERCE{$type}->{$coerce_type}->($value);
+            return $_ if $type_constraint->($_);
         }
     }
     return $value;
@@ -208,6 +208,22 @@ Mouse::Util::TypeConstraints - simple type constraints
 
 Returns the simple type constraints that Mouse understands.
 
+=head1 FUNCTIONS
+
+=over 4
+
+=item B<subtype 'Name' => as 'Parent' => where { } ...>
+
+=item B<subtype as 'Parent' => where { } ...>
+
+=item B<class_type ($class, ?$options)>
+
+=item B<role_type ($role, ?$options)>
+
+=item B<enum (\@values)>
+
+=back
+
 =cut