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 enum
33 my $optimized_constraints;
34 my $optimized_constraints_base;
36 no warnings 'uninitialized';
41 !defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'
43 Undef => sub { !defined($_[0]) },
44 Defined => sub { defined($_[0]) },
45 Value => sub { defined($_[0]) && !ref($_[0]) },
46 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
47 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
48 Str => sub { defined($_[0]) && !ref($_[0]) },
49 ClassName => sub { Mouse::is_class_loaded($_[0]) },
50 Ref => sub { ref($_[0]) },
52 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
53 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
54 HashRef => sub { ref($_[0]) eq 'HASH' },
55 CodeRef => sub { ref($_[0]) eq 'CODE' },
56 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
57 GlobRef => sub { ref($_[0]) eq 'GLOB' },
60 ref($_[0]) eq 'GLOB' && openhandle($_[0])
62 blessed($_[0]) && $_[0]->isa("IO::Handle")
65 Object => sub { blessed($_[0]) && blessed($_[0]) 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} = sub { local $_=$_[0]; $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 {
94 my $as = delete $conf{as} || 'Any';
95 if (! exists $TYPE{$as}) { # Perhaps it's a parameterized source?
96 Mouse::Meta::Attribute::_build_type_constraint($as);
100 my $as = $conf{as} || '';
102 $TYPE_SOURCE{$name} = $pkg;
104 if ($as = $TYPE{$as}) {
105 $TYPE{$name} = sub { local $_=$_[0]; $as->($_) && $constraint->($_) };
107 $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
112 my($name, %conf) = @_;
114 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
117 unless ($COERCE{$name}) {
119 $COERCE_KEYS{$name} = [];
121 while (my($type, $code) = each %conf) {
122 Carp::croak "A coercion action already exists for '$type'"
123 if $COERCE{$name}->{$type};
125 if (! $TYPE{$type}) {
126 # looks parameterized
127 if ($type =~ /^[^\[]+\[.+\]$/) {
128 Mouse::Meta::Attribute::_build_type_constraint($type);
130 Carp::croak "Could not find the type constraint ($type) to coerce from"
134 push @{ $COERCE_KEYS{$name} }, $type;
135 $COERCE{$name}->{$type} = $code;
141 my($name, $conf) = @_;
142 my $class = $conf->{class};
144 $name => where => sub { $_->isa($class) }
149 my($name, $conf) = @_;
150 my $role = $conf->{role};
152 $name => where => sub {
153 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
154 $_->meta->does_role($role);
159 sub typecast_constraints {
160 my($class, $pkg, $type_constraint, $types, $value) = @_;
163 for my $type (ref($types) eq 'ARRAY' ? @{ $types } : ( $types )) {
164 next unless $COERCE{$type};
165 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
167 next unless $TYPE{$coerce_type}->($value);
169 $_ = $COERCE{$type}->{$coerce_type}->($value);
170 return $_ if $type_constraint->($_);
178 # enum ['small', 'medium', 'large']
179 if (ref($_[0]) eq 'ARRAY') {
180 my @elements = @{ shift @_ };
182 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
184 enum($name, @elements);
188 # enum size => 'small', 'medium', 'large'
190 my %is_valid = map { $_ => 1 } @_;
193 $name => where => sub { $is_valid{$_} }
203 Mouse::Util::TypeConstraints - simple type constraints
207 =head2 optimized_constraints -> HashRef[CODE]
209 Returns the simple type constraints that Mouse understands.
215 =item B<subtype 'Name' => as 'Parent' => where { } ...>
217 =item B<subtype as 'Parent' => where { } ...>
219 =item B<class_type ($class, ?$options)>
221 =item B<role_type ($role, ?$options)>
223 =item B<enum (\@values)>