1 package Mouse::Meta::TypeConstraint;
6 '""' => sub { shift->{name} }, # stringify to tc name
10 use Scalar::Util qw(blessed reftype);
12 use Mouse::Util qw(:meta);
14 my $null_check = sub { 1 };
17 my($class, %args) = @_;
19 $args{name} = '__ANON__' if !defined $args{name};
21 my $check = $args{_compiled_type_constraint} || $args{constraint};
25 $check = $check->{_compiled_type_constraint};
28 if(defined($check) && ref($check) ne 'CODE'){
29 confess("Type constraint for $args{name} is not a CODE reference");
32 my $self = bless \%args, $class;
33 $self->{_compiled_type_constraint} ||= $self->_compile();
38 sub create_child_type{
40 return ref($self)->new(@_, parent => $self);
43 sub name { $_[0]->{name} }
44 sub parent { $_[0]->{parent} }
45 sub message { $_[0]->{message} }
49 $self->{_compiled_type_constraint}->(@_);
53 my ($self, $value) = @_;
54 if ($self->{_compiled_type_constraint}->($value)) {
58 $self->get_message($value);
63 my ($self, $value) = @_;
65 my $error = $self->validate($value);
66 return 1 if ! defined $error;
72 my ($self, $value) = @_;
73 if ( my $msg = $self->message ) {
75 return $msg->($value);
78 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
80 "Validation failed for '"
82 . "' failed with value $value";
87 my($self, $other) = @_;
89 # ->is_a_type_of('__ANON__') is always false
90 return 0 if !blessed($other) && $other eq '__ANON__';
92 (my $other_name = $other) =~ s/\s+//g;
94 return 1 if $self->name eq $other_name;
96 if(exists $self->{type_constraints}){ # union
97 foreach my $type(@{$self->{type_constraints}}){
98 return 1 if $type->name eq $other_name;
102 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
103 return 1 if $parent->name eq $other_name;
114 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
115 if($parent->{constraint}){
116 push @checks, $parent->{constraint};
118 elsif($parent->{_compiled_type_constraint} && $parent->{_compiled_type_constraint} != $null_check){
119 # hand-optimized constraint
120 push @checks, $parent->{_compiled_type_constraint};
125 if($self->{constraint}){
126 push @checks, $self->{constraint};
144 foreach my $c(@checks){
145 return undef if !$c->(@args);
157 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
161 For the most part, the only time you will ever encounter an
162 instance of this class is if you are doing some serious deep
163 introspection. This API should not be considered final, but
164 it is B<highly unlikely> that this will matter to a regular
181 L<Moose::Meta::TypeConstraint>