1 package Mouse::Meta::TypeConstraint;
2 use Mouse::Util qw(:meta); # enables strict and warnings
5 'bool' => sub { 1 }, # always true
7 '""' => sub { $_[0]->name }, # stringify to tc name
9 '|' => sub { # or-combination
10 require Mouse::Util::TypeConstraints;
11 return Mouse::Util::TypeConstraints::find_or_parse_type_constraint(
20 my $null_check = sub { 1 };
23 my($class, %args) = @_;
25 $args{name} = '__ANON__' if !defined $args{name};
27 my $check = delete $args{optimized};
29 if($args{_compiled_type_constraint}){
30 Carp::cluck("'_compiled_type_constraint' has been deprecated, use 'optimized' instead")
33 $check = $args{_compiled_type_constraint};
37 $args{hand_optimized_type_constraint} = $check;
38 $args{compiled_type_constraint} = $check;
41 $check = $args{constraint};
43 if(defined($check) && ref($check) ne 'CODE'){
44 Carp::confess("Constraint for $args{name} is not a CODE reference");
47 $args{package_defined_in} ||= caller;
49 my $self = bless \%args, $class;
50 $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint};
52 if($self->{type_constraints}){ # Union
54 foreach my $type(@{$self->{type_constraints}}){
55 if($type->has_coercion){
56 push @coercions, $type;
60 $self->{_compiled_type_coercion} = sub {
62 foreach my $type(@coercions){
63 my $value = $type->coerce($thing);
64 return $value if $self->check($value);
74 sub create_child_type{
77 return ref($self)->new(
78 # a child inherits its parent's attributes
81 # but does not inherit 'compiled_type_constraint' and 'hand_optimized_type_constraint'
82 compiled_type_constraint => undef,
83 hand_optimized_type_constraint => undef,
85 # and is given child-specific args, of course.
94 sub compile_type_constraint{
99 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
100 if($parent->{hand_optimized_type_constraint}){
101 unshift @checks, $parent->{hand_optimized_type_constraint};
102 last; # a hand optimized constraint must include all the parents
104 elsif($parent->{constraint}){
105 unshift @checks, $parent->{constraint};
110 if($self->{constraint}){
111 push @checks, $self->{constraint};
114 if($self->{type_constraints}){ # Union
115 my @types = map{ $_->_compiled_type_constraint } @{ $self->{type_constraints} };
117 foreach my $c(@types){
118 return 1 if $c->($_[0]);
125 $self->{compiled_type_constraint} = $null_check;
129 $self->{compiled_type_constraint} = sub{
136 $self->{compiled_type_constraint} = sub{
139 foreach my $c(@checks){
140 return undef if !$c->(@args);
148 sub _add_type_coercions{
151 my $coercions = ($self->{_coercion_map} ||= []);
152 my %has = map{ $_->[0] => undef } @{$coercions};
154 for(my $i = 0; $i < @_; $i++){
156 my $action = $_[++$i];
158 if(exists $has{$from}){
159 Carp::confess("A coercion action already exists for '$from'");
162 my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from)
163 or Carp::confess("Could not find the type constraint ($from) to coerce from");
165 push @{$coercions}, [ $type => $action ];
169 if(exists $self->{type_constraints}){ # union type
170 Carp::confess("Cannot add additional type coercions to Union types");
173 $self->{_compiled_type_coercion} = sub {
175 foreach my $pair (@{$coercions}) {
\r
176 #my ($constraint, $converter) = @$pair;
\r
177 if ($pair->[0]->check($thing)) {
\r
179 return $pair->[1]->($thing);
190 return $self->_compiled_type_constraint->(@_);
196 return $_[0] if $self->_compiled_type_constraint->(@_);
198 my $coercion = $self->_compiled_type_coercion;
199 return $coercion ? $coercion->(@_) : $_[0];
203 my ($self, $value) = @_;
204 if ( my $msg = $self->message ) {
206 return $msg->($value);
209 $value = ( defined $value ? overload::StrVal($value) : 'undef' );
210 return "Validation failed for '$self' failed with value $value";
215 my($self, $other) = @_;
217 # ->is_a_type_of('__ANON__') is always false
218 return 0 if !ref($other) && $other eq '__ANON__';
220 (my $other_name = $other) =~ s/\s+//g;
222 return 1 if $self->name eq $other_name;
224 if(exists $self->{type_constraints}){ # union
225 foreach my $type(@{$self->{type_constraints}}){
226 return 1 if $type->name eq $other_name;
230 for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
231 return 1 if $parent->name eq $other_name;
237 # See also Moose::Meta::TypeConstraint::Parameterizable
239 my($self, $param, $name) = @_;
242 require Mouse::Util::TypeConstraints;
243 $param = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($param);
246 $name ||= sprintf '%s[%s]', $self->name, $param->name;
248 my $generator = $self->{constraint_generator}
249 || Carp::confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
251 return Mouse::Meta::TypeConstraint->new(
254 constraint => $generator->($param),
256 type => 'Parameterized',
265 Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass
269 This document describes Mouse version 0.40_03
273 For the most part, the only time you will ever encounter an
274 instance of this class is if you are doing some serious deep
275 introspection. This API should not be considered final, but
276 it is B<highly unlikely> that this will matter to a regular
293 L<Moose::Meta::TypeConstraint>