X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=30b0f06a2e98ea061352f823a8e8ac9f83619d36;hp=538e3b288a6c45b1a82223783e36f8ca12653380;hb=bc71de540020f1b2b75bafd69e2021c103e1c4e3;hpb=29607c0291634fac077d6e1c75e1491ba455c010 diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 538e3b2..30b0f06 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -1,9 +1,14 @@ package Mouse::Meta::TypeConstraint; use strict; use warnings; + use overload '""' => sub { shift->{name} }, # stringify to tc name fallback => 1; +use Carp (); + +use Mouse::Util (); + sub new { my $class = shift; my %args = @_; @@ -28,6 +33,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 +72,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__