Created
March 9, 2009 04:02
-
-
Save tokuhirom/76093 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm | |
index 20e8006..bbb7b72 100644 | |
--- a/lib/Mouse/Meta/Attribute.pm | |
+++ b/lib/Mouse/Meta/Attribute.pm | |
@@ -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"); | |
} | |
diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm | |
index a11479d..f75c525 100644 | |
--- a/lib/Mouse/Meta/Method/Constructor.pm | |
+++ b/lib/Mouse/Meta/Method/Constructor.pm | |
@@ -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) | |
} | |
}"; | |
diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm | |
index 6410243..d81d5d0 100644 | |
--- a/lib/Mouse/Util/TypeConstraints.pm | |
+++ b/lib/Mouse/Util/TypeConstraints.pm | |
@@ -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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment