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};
24 Carp::cluck("'constraint' must be a CODE reference");
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{
41 return ref($self)->new(
42 %{$self}, # pass the inherit parent attributes
43 _compiled_type_constraint => undef, # ... other than compiled type constraint
45 parent => $self # ... and the parent
49 sub name { $_[0]->{name} }
50 sub parent { $_[0]->{parent} }
51 sub message { $_[0]->{message} }
55 $self->{_compiled_type_constraint}->(@_);
59 my ($self, $value) = @_;
60 if ($self->{_compiled_type_constraint}->($value)) {
64 $self->get_message($value);
69 my ($self, $value) = @_;
71 my $error = $self->validate($value);
72 return 1 if ! defined $error;
78 my ($self, $value) = @_;
79 if ( my $msg = $self->message ) {
81 return $msg->($value);
84 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
86 "Validation failed for '"
88 . "' failed with value $value";
93 my($self, $other) = @_;
95 # ->is_a_type_of('__ANON__') is always false
96 return 0 if !blessed($other) && $other eq '__ANON__';
98 (my $other_name = $other) =~ s/\s+//g;
100 return 1 if $self->name eq $other_name;
102 if(exists $self->{type_constraints}){ # union
103 foreach my $type(@{$self->{type_constraints}}){
104 return 1 if $type->name eq $other_name;
108 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
109 return 1 if $parent->name eq $other_name;
120 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
121 if($parent->{constraint}){
122 push @checks, $parent->{constraint};
124 elsif($parent->{_compiled_type_constraint} && $parent->{_compiled_type_constraint} != $null_check){
125 # hand-optimized constraint
126 push @checks, $parent->{_compiled_type_constraint};
131 if($self->{constraint}){
132 push @checks, $self->{constraint};
150 foreach my $c(@checks){
151 return undef if !$c->(@args);
163 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
167 For the most part, the only time you will ever encounter an
168 instance of this class is if you are doing some serious deep
169 introspection. This API should not be considered final, but
170 it is B<highly unlikely> that this will matter to a regular
187 L<Moose::Meta::TypeConstraint>