X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=32616b09bc2788d4ec4e17cabbb877876ec92fb0;hp=0faa17cc473e9998c8a922addedad6f840d13b2e;hb=619338ac4245c7c523d67645d6cd51cb982d4841;hpb=f48920c11c806b2a1fd60be145ff2cdf79750878 diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 0faa17c..32616b0 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -76,7 +76,7 @@ sub get_code_ref{ return *{$package . '::' . $name}{CODE}; } -sub _generate_isa_predicate_for { +sub generate_isa_predicate_for { my($for_class, $name) = @_; my $predicate = sub{ Scalar::Util::blessed($_[0]) && $_[0]->isa($for_class) }; @@ -124,6 +124,41 @@ sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } sub ClassName { Mouse::Util::is_class_loaded($_[0]) } sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') } +sub _parameterize_ArrayRef_for { + my($type_parameter) = @_; + my $check = $type_parameter->_compiled_type_constraint; + + return sub { + foreach my $value (@{$_}) { + return undef unless $check->($value); + } + return 1; + } +} + +sub _parameterize_HashRef_for { + my($type_parameter) = @_; + my $check = $type_parameter->_compiled_type_constraint; + + return sub { + foreach my $value(values %{$_}){ + return undef unless $check->($value); + } + return 1; + }; +} + +# 'Maybe' type accepts 'Any', so it requires parameters +sub _parameterize_Maybe_for { + my($type_parameter) = @_; + my $check = $type_parameter->_compiled_type_constraint; + + return sub{ + return !defined($_) || $check->($_); + }; +}; + + package Mouse::Meta::Module;