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=13b44954c5042e659610816dcaf21f02d0db29fd;hp=51b08670f70e0338af416f735163696202903528;hb=a133bcea30632f3bdb815d5001e364675dc14028;hpb=37dc67cb9daf91c9530e5ffc762de36cb0432c7f diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 51b0867..13b4495 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -1,11 +1,14 @@ package Mouse::Meta::TypeConstraint; use strict; use warnings; -use Carp (); use overload '""' => sub { shift->{name} }, # stringify to tc name fallback => 1; +use Carp (); + +use Mouse::Util qw(:meta); + sub new { my $class = shift; my %args = @_; @@ -31,23 +34,23 @@ sub check { } sub validate { - my ($self, $value) = @_; - if ($self->{_compiled_type_constraint}->($value)) { - return undef; - } - else { - $self->get_message($value); - } + 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; +sub assert_valid { + my ($self, $value) = @_; + + my $error = $self->validate($value); + return 1 if ! defined $error; - Carp::confess($error); -} + Carp::confess($error); +} sub message { @@ -69,12 +72,19 @@ 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__ =head1 NAME -Mouse::Meta::TypeConstraint - The Mouse Type Constraint Metaclass +Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass =head1 DESCRIPTION @@ -96,5 +106,9 @@ Don't use this. =back +=head1 SEE ALSO + +L + =cut