X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=7b8732d9d8eadc7679b294bf8ee110984d6f943e;hb=1d86420d34a7bbe8596b08035d7fb6c8c81d00a3;hp=538e3b288a6c45b1a82223783e36f8ca12653380;hpb=29607c0291634fac077d6e1c75e1491ba455c010;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 538e3b2..7b8732d 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -1,6 +1,8 @@ package Mouse::Meta::TypeConstraint; use strict; use warnings; +use Carp (); + use overload '""' => sub { shift->{name} }, # stringify to tc name fallback => 1; @@ -28,6 +30,26 @@ sub check { $self->{_compiled_type_constraint}->(@_); } +sub validate { + my ($self, $value) = @_; + if ($self->{_compiled_type_constraint}->($value)) { + return undef; + } + else { + $self->get_message($value); + } +} + +sub assert_valid { + my ($self, $value) = @_; + + my $error = $self->validate($value); + return 1 if ! defined $error; + + Carp::confess($error); +} + + sub message { return $_[0]->{message}; } @@ -47,6 +69,13 @@ sub get_message { } } +sub is_a_type_of{ + my($self, $tc_name) = @_; + + return $self->name eq $tc_name + || $self->name =~ /\A $tc_name \[/xms; # "ArrayRef" =~ "ArrayRef[Foo]" +} + 1; __END__