1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
10 as where message from via type subtype coerce class_type role_type
33 my $optimized_constraints;
34 my $optimized_constraints_base;
36 no warnings 'uninitialized';
41 !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0'
43 Undef => sub { !defined($_) },
44 Defined => sub { defined($_) },
45 Value => sub { defined($_) && !ref($_) },
46 Num => sub { !ref($_) && looks_like_number($_) },
47 Int => sub { defined($_) && !ref($_) && /^-?[0-9]+$/ },
48 Str => sub { defined($_) && !ref($_) },
49 ClassName => sub { Mouse::is_class_loaded($_) },
50 Ref => sub { ref($_) },
52 ScalarRef => sub { ref($_) eq 'SCALAR' },
53 ArrayRef => sub { ref($_) eq 'ARRAY' },
54 HashRef => sub { ref($_) eq 'HASH' },
55 CodeRef => sub { ref($_) eq 'CODE' },
56 RegexpRef => sub { ref($_) eq 'Regexp' },
57 GlobRef => sub { ref($_) eq 'GLOB' },
60 ref($_) eq 'GLOB' && openhandle($_)
62 blessed($_) && $_->isa("IO::Handle")
65 Object => sub { blessed($_) && blessed($_) ne 'Regexp' },
68 sub optimized_constraints { \%TYPE }
69 my @TYPE_KEYS = keys %TYPE;
70 sub list_all_builtin_type_constraints { @TYPE_KEYS }
72 @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
77 my($name, %conf) = @_;
78 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
79 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
81 my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
83 $TYPE_SOURCE{$name} = $pkg;
84 $TYPE{$name} = $constraint;
89 my($name, %conf) = @_;
90 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
91 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
93 my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
94 my $as = $conf{as} || '';
96 $TYPE_SOURCE{$name} = $pkg;
98 if ($as = $TYPE{$as}) {
99 $TYPE{$name} = sub { $as->($_) && $constraint->($_) };
101 $TYPE{$name} = $constraint;
106 my($name, %conf) = @_;
108 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
111 unless ($COERCE{$name}) {
113 $COERCE_KEYS{$name} = [];
115 while (my($type, $code) = each %conf) {
116 Carp::croak "A coercion action already exists for '$type'"
117 if $COERCE{$name}->{$type};
119 Carp::croak "Could not find the type constraint ($type) to coerce from"
122 push @{ $COERCE_KEYS{$name} }, $type;
123 $COERCE{$name}->{$type} = $code;
129 my($name, $conf) = @_;
130 my $class = $conf->{class};
132 $name => where => sub { $_->isa($class) }
137 my($name, $conf) = @_;
138 my $role = $conf->{role};
140 $name => where => sub {
141 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
142 $_->meta->does_role($role);
147 sub typecast_constraints {
148 my($class, $pkg, $type_constraint, $types, $value) = @_;
151 for my $type (ref($types) eq 'ARRAY' ? @{ $types } : ( $types )) {
152 next unless $COERCE{$type};
153 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
155 next unless $TYPE{$coerce_type}->();
157 $_ = $COERCE{$type}->{$coerce_type}->();
158 return $_ if $type_constraint->();
170 Mouse::Util::TypeConstraints - simple type constraints
174 =head2 optimized_constraints -> HashRef[CODE]
176 Returns the simple type constraints that Mouse understands.