1 package Mouse::Meta::TypeConstraint;
2 use Mouse::Util qw(:meta); # enables strict and warnings
5 'bool' => sub (){ 1 }, # always true
6 '""' => sub { $_[0]->name }, # stringify to tc name
7 '|' => sub { # or-combination
8 require Mouse::Util::TypeConstraints;
9 return Mouse::Util::TypeConstraints::find_or_parse_type_constraint(
19 my($class, %args) = @_;
21 $args{name} = '__ANON__' if !defined $args{name};
23 my $check = delete $args{optimized};
26 $args{hand_optimized_type_constraint} = $check;
27 $args{compiled_type_constraint} = $check;
30 $check = $args{constraint};
32 if(defined($check) && ref($check) ne 'CODE'){
33 Carp::confess("Constraint for $args{name} is not a CODE reference");
36 my $self = bless \%args, $class;
37 $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint};
39 $self->_compile_union_type_coercion() if $self->{type_constraints};
43 sub create_child_type{
45 return ref($self)->new(
46 # a child inherits its parent's attributes
49 # but does not inherit 'compiled_type_constraint' and 'hand_optimized_type_constraint'
50 compiled_type_constraint => undef,
51 hand_optimized_type_constraint => undef,
53 # and is given child-specific args, of course.
67 sub __is_parameterized;
69 sub _compiled_type_constraint;
70 sub _compiled_type_coercion;
72 sub compile_type_constraint;
74 sub _add_type_coercions{
77 my $coercions = ($self->{coercion_map} ||= []);
78 my %has = map{ $_->[0] => undef } @{$coercions};
80 for(my $i = 0; $i < @_; $i++){
82 my $action = $_[++$i];
84 if(exists $has{$from}){
85 Carp::confess("A coercion action already exists for '$from'");
88 my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from)
89 or Carp::confess("Could not find the type constraint ($from) to coerce from");
91 push @{$coercions}, [ $type => $action ];
95 if(exists $self->{type_constraints}){ # union type
96 Carp::confess("Cannot add additional type coercions to Union types");
99 $self->_compile_type_coercion();
104 sub _compile_type_coercion {
107 my @coercions = @{$self->{coercion_map}};
109 $self->{_compiled_type_coercion} = sub {
111 foreach my $pair (@coercions) {
112 #my ($constraint, $converter) = @$pair;
113 if ($pair->[0]->check($thing)) {
115 return $pair->[1]->($thing);
123 sub _compile_union_type_coercion {
127 foreach my $type(@{$self->{type_constraints}}){
128 if($type->has_coercion){
129 push @coercions, $type;
133 $self->{_compiled_type_coercion} = sub {
135 foreach my $type(@coercions){
136 my $value = $type->coerce($thing);
137 return $value if $self->check($value);
147 return $self->_compiled_type_constraint->(@_);
153 my $coercion = $self->_compiled_type_coercion;
155 Carp::confess("Cannot coerce without a type coercion");
158 return $_[0] if $self->_compiled_type_constraint->(@_);
160 return $coercion->(@_);
164 my ($self, $value) = @_;
165 if ( my $msg = $self->message ) {
167 return $msg->($value);
170 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
171 return "Validation failed for '$self' failed with value $value";
176 my($self, $other) = @_;
178 # ->is_a_type_of('__ANON__') is always false
179 return 0 if !ref($other) && $other eq '__ANON__';
181 (my $other_name = $other) =~ s/\s+//g;
183 return 1 if $self->name eq $other_name;
185 if(exists $self->{type_constraints}){ # union
186 foreach my $type(@{$self->{type_constraints}}){
187 return 1 if $type->name eq $other_name;
191 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
192 return 1 if $parent->name eq $other_name;
198 # See also Moose::Meta::TypeConstraint::Parameterizable
200 my($self, $param, $name) = @_;
203 require Mouse::Util::TypeConstraints;
204 $param = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($param);
207 $name ||= sprintf '%s[%s]', $self->name, $param->name;
209 my $generator = $self->{constraint_generator}
210 || Carp::confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
212 return Mouse::Meta::TypeConstraint->new(
215 type_parameter => $param,
216 constraint => $generator->($param), # must be 'constraint', not 'optimized'
221 my ($self, $value) = @_;
223 if(!$self->_compiled_type_constraint->($value)){
224 Carp::confess($self->get_message($value));
234 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
238 This document describes Mouse version 0.50_07
242 For the most part, the only time you will ever encounter an
243 instance of this class is if you are doing some serious deep
244 introspection. This API should not be considered final, but
245 it is B<highly unlikely> that this will matter to a regular
262 L<Moose::Meta::TypeConstraint>