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(
17 my($class, %args) = @_;
19 $args{name} = '__ANON__' if !defined $args{name};
21 my $check = delete $args{optimized};
24 $args{hand_optimized_type_constraint} = $check;
25 $args{compiled_type_constraint} = $check;
28 $check = $args{constraint};
30 if(defined($check) && ref($check) ne 'CODE'){
31 $class->throw_error("Constraint for $args{name} is not a CODE reference");
34 my $self = bless \%args, $class;
35 $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint};
37 $self->_compile_union_type_coercion() if $self->{type_constraints};
41 sub create_child_type{
43 return ref($self)->new(
44 # a child inherits its parent's attributes
47 # but does not inherit 'compiled_type_constraint' and 'hand_optimized_type_constraint'
48 compiled_type_constraint => undef,
49 hand_optimized_type_constraint => undef,
51 # 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;
75 sub _add_type_coercions{
78 my $coercions = ($self->{coercion_map} ||= []);
79 my %has = map{ $_->[0] => undef } @{$coercions};
81 for(my $i = 0; $i < @_; $i++){
83 my $action = $_[++$i];
85 if(exists $has{$from}){
86 $self->throw_error("A coercion action already exists for '$from'");
89 my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from)
90 or $self->throw_error("Could not find the type constraint ($from) to coerce from");
92 push @{$coercions}, [ $type => $action ];
96 if(exists $self->{type_constraints}){ # union type
97 $self->throw_error("Cannot add additional type coercions to Union types");
100 $self->_compile_type_coercion();
105 sub _compile_type_coercion {
108 my @coercions = @{$self->{coercion_map}};
110 $self->{_compiled_type_coercion} = sub {
112 foreach my $pair (@coercions) {
113 #my ($constraint, $converter) = @$pair;
114 if ($pair->[0]->check($thing)) {
116 return $pair->[1]->($thing);
124 sub _compile_union_type_coercion {
128 foreach my $type(@{$self->{type_constraints}}){
129 if($type->has_coercion){
130 push @coercions, $type;
134 $self->{_compiled_type_coercion} = sub {
136 foreach my $type(@coercions){
137 my $value = $type->coerce($thing);
138 return $value if $self->check($value);
149 my $coercion = $self->_compiled_type_coercion;
151 $self->throw_error("Cannot coerce without a type coercion");
154 return $_[0] if $self->check(@_);
156 return $coercion->(@_);
160 my ($self, $value) = @_;
161 if ( my $msg = $self->message ) {
163 return $msg->($value);
166 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
167 return "Validation failed for '$self' failed with value $value";
172 my($self, $other) = @_;
174 # ->is_a_type_of('__ANON__') is always false
175 return 0 if !ref($other) && $other eq '__ANON__';
177 (my $other_name = $other) =~ s/\s+//g;
179 return 1 if $self->name eq $other_name;
181 if(exists $self->{type_constraints}){ # union
182 foreach my $type(@{$self->{type_constraints}}){
183 return 1 if $type->name eq $other_name;
187 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
188 return 1 if $parent->name eq $other_name;
194 # See also Moose::Meta::TypeConstraint::Parameterizable
196 my($self, $param, $name) = @_;
199 require Mouse::Util::TypeConstraints;
200 $param = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($param);
203 $name ||= sprintf '%s[%s]', $self->name, $param->name;
205 my $generator = $self->{constraint_generator}
206 || $self->throw_error("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
208 return Mouse::Meta::TypeConstraint->new(
211 type_parameter => $param,
212 constraint => $generator->($param), # must be 'constraint', not 'optimized'
217 my ($self, $value) = @_;
219 if(!$self->check($value)){
220 $self->throw_error($self->get_message($value));
226 require Mouse::Meta::Module;
227 goto &Mouse::Meta::Module::throw_error;
235 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
239 This document describes Mouse version 0.57
243 For the most part, the only time you will ever encounter an
244 instance of this class is if you are doing some serious deep
245 introspection. This API should not be considered final, but
246 it is B<highly unlikely> that this will matter to a regular
263 L<Moose::Meta::TypeConstraint>