1 package Mouse::Meta::TypeConstraint;
2 use Mouse::Util qw(:meta); # enables strict and warnings
6 'bool' => sub (){ 1 }, # always true
7 '""' => sub { $_[0]->name }, # stringify to tc name
8 '0+' => sub { Scalar::Util::refaddr($_[0]) },
9 '|' => sub { # or-combination
10 require Mouse::Util::TypeConstraints;
11 return Mouse::Util::TypeConstraints::find_or_parse_type_constraint(
20 my %args = @_ == 1 ? %{$_[0]} : @_;
22 $args{name} = '__ANON__' if !defined $args{name};
24 my $check = delete $args{optimized};
27 $args{hand_optimized_type_constraint} = $check;
28 $args{compiled_type_constraint} = $check;
31 $check = $args{constraint};
33 if(defined($check) && ref($check) ne 'CODE'){
34 $class->throw_error("Constraint for $args{name} is not a CODE reference");
37 my $self = bless \%args, $class;
38 $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint};
40 $self->_compile_union_type_coercion() if $self->{type_constraints};
44 sub create_child_type{
46 return ref($self)->new(
47 # a child inherits its parent's attributes
50 # but does not inherit 'compiled_type_constraint' and 'hand_optimized_type_constraint'
51 compiled_type_constraint => undef,
52 hand_optimized_type_constraint => undef,
54 # and is given child-specific args, of course.
70 sub __is_parameterized;
72 sub _compiled_type_constraint;
73 sub _compiled_type_coercion;
75 sub compile_type_constraint;
78 sub _add_type_coercions{
81 my $coercions = ($self->{coercion_map} ||= []);
82 my %has = map{ $_->[0] => undef } @{$coercions};
84 for(my $i = 0; $i < @_; $i++){
86 my $action = $_[++$i];
88 if(exists $has{$from}){
89 $self->throw_error("A coercion action already exists for '$from'");
92 my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from)
93 or $self->throw_error("Could not find the type constraint ($from) to coerce from");
95 push @{$coercions}, [ $type => $action ];
99 if(exists $self->{type_constraints}){ # union type
100 $self->throw_error("Cannot add additional type coercions to Union types");
103 $self->_compile_type_coercion();
108 sub _compile_type_coercion {
111 my @coercions = @{$self->{coercion_map}};
113 $self->{_compiled_type_coercion} = sub {
115 foreach my $pair (@coercions) {
116 #my ($constraint, $converter) = @$pair;
117 if ($pair->[0]->check($thing)) {
119 return $pair->[1]->($thing);
127 sub _compile_union_type_coercion {
131 foreach my $type(@{$self->{type_constraints}}){
132 if($type->has_coercion){
133 push @coercions, $type;
137 $self->{_compiled_type_coercion} = sub {
139 foreach my $type(@coercions){
140 my $value = $type->coerce($thing);
141 return $value if $self->check($value);
152 my $coercion = $self->_compiled_type_coercion;
154 $self->throw_error("Cannot coerce without a type coercion");
157 return $_[0] if $self->check(@_);
159 return $coercion->(@_);
163 my ($self, $value) = @_;
164 if ( my $msg = $self->message ) {
166 return $msg->($value);
169 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
170 return "Validation failed for '$self' with value $value";
175 my($self, $other) = @_;
177 # ->is_a_type_of('__ANON__') is always false
178 return 0 if !ref($other) && $other eq '__ANON__';
180 (my $other_name = $other) =~ s/\s+//g;
182 return 1 if $self->name eq $other_name;
184 if(exists $self->{type_constraints}){ # union
185 foreach my $type(@{$self->{type_constraints}}){
186 return 1 if $type->name eq $other_name;
190 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
191 return 1 if $parent->name eq $other_name;
197 # See also Moose::Meta::TypeConstraint::Parameterizable
199 my($self, $param, $name) = @_;
202 require Mouse::Util::TypeConstraints;
203 $param = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($param);
206 $name ||= sprintf '%s[%s]', $self->name, $param->name;
208 my $generator = $self->{constraint_generator}
209 || $self->throw_error("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
211 return Mouse::Meta::TypeConstraint->new(
214 type_parameter => $param,
215 constraint => $generator->($param), # must be 'constraint', not 'optimized'
220 my ($self, $value) = @_;
222 if(!$self->check($value)){
223 $self->throw_error($self->get_message($value));
229 require Mouse::Meta::Module;
230 goto &Mouse::Meta::Module::throw_error;
238 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
242 This document describes Mouse version 0.68
246 For the most part, the only time you will ever encounter an
247 instance of this class is if you are doing some serious deep
248 introspection. This API should not be considered final, but
249 it is B<highly unlikely> that this will matter to a regular
266 L<Moose::Meta::TypeConstraint>