1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
8 use Mouse::Meta::TypeConstraint;
11 as where message from via type subtype coerce class_type role_type enum
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' },
67 while (my ($name, $code) = each %TYPE) {
68 $TYPE{$name} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $name );
71 sub optimized_constraints { \%TYPE }
72 my @TYPE_KEYS = keys %TYPE;
73 sub list_all_builtin_type_constraints { @TYPE_KEYS }
75 @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
80 my($name, %conf) = @_;
81 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
82 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
84 my $constraint = $conf{where} || do {
85 my $as = delete $conf{as} || 'Any';
86 if (! exists $TYPE{$as}) {
87 $TYPE{$as} = _build_type_constraint($as);
92 $TYPE_SOURCE{$name} = $pkg;
93 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
95 _compiled_type_constraint => sub {
97 if (ref $constraint eq 'CODE') {
100 $constraint->check($_[0])
108 my($name, %conf) = @_;
109 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
110 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
112 my $constraint = $conf{where};
113 my $as_constraint = find_or_create_isa_type_constraint($conf{as} || 'Any');
115 $TYPE_SOURCE{$name} = $pkg;
116 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
118 _compiled_type_constraint => (
122 $as_constraint->check($_[0]) && $constraint->($_[0])
126 $as_constraint->check($_[0]);
135 my($name, %conf) = @_;
137 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
140 unless ($COERCE{$name}) {
142 $COERCE_KEYS{$name} = [];
144 while (my($type, $code) = each %conf) {
145 Carp::croak "A coercion action already exists for '$type'"
146 if $COERCE{$name}->{$type};
148 if (! $TYPE{$type}) {
149 # looks parameterized
150 if ($type =~ /^[^\[]+\[.+\]$/) {
151 $TYPE{$type} = _build_type_constraint($type);
153 Carp::croak "Could not find the type constraint ($type) to coerce from"
157 push @{ $COERCE_KEYS{$name} }, $type;
158 $COERCE{$name}->{$type} = $code;
163 my($name, $conf) = @_;
164 if ($conf && $conf->{class}) {
165 # No, you're using this wrong
166 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
167 subtype($name, as => $conf->{class});
170 $name => where => sub { $_->isa($name) }
176 my($name, $conf) = @_;
177 my $role = $conf->{role};
179 $name => where => sub {
180 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
181 $_->meta->does_role($role);
186 # this is an original method for Mouse
187 sub typecast_constraints {
188 my($class, $pkg, $types, $value) = @_;
191 for my $type ( split /\|/, $types ) {
192 next unless $COERCE{$type};
193 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
195 next unless $TYPE{$coerce_type}->check($value);
197 $_ = $COERCE{$type}->{$coerce_type}->($value);
198 return $_ if $types->check($_);
206 # enum ['small', 'medium', 'large']
207 if (ref($_[0]) eq 'ARRAY') {
208 my @elements = @{ shift @_ };
210 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
212 enum($name, @elements);
216 # enum size => 'small', 'medium', 'large'
218 my %is_valid = map { $_ => 1 } @_;
221 $name => where => sub { $is_valid{$_} }
225 sub _build_type_constraint {
230 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
235 if ($constraint eq 'Maybe') {
236 $parent = _build_type_constraint('Undef');
238 $parent = _build_type_constraint($constraint);
240 my $child = _build_type_constraint($param);
241 if ($constraint eq 'ArrayRef') {
243 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
245 " if (\$parent->check(\$_[0])) {\n" .
246 " foreach my \$e (\@{\$_[0]}) {\n" .
247 " return () unless \$child->check(\$e);\n" .
254 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
255 } elsif ($constraint eq 'HashRef') {
257 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
259 " if (\$parent->check(\$_[0])) {\n" .
260 " foreach my \$e (values \%{\$_[0]}) {\n" .
261 " return () unless \$child->check(\$e);\n" .
268 $code = eval $code_str or Carp::confess($@);
269 } elsif ($constraint eq 'Maybe') {
271 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
273 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
276 $code = eval $code_str or Carp::confess($@);
278 Carp::confess("Support for parameterized types other than ArrayRef or HashRef is not implemented yet");
280 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
282 $code = $TYPE{ $spec };
285 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
287 " Scalar::Util::blessed(\$_[0]) && \$_[0]->isa('$spec');\n" .
290 $code = eval $code_str or Carp::confess($@);
291 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
294 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
297 sub find_type_constraint {
298 my $type_constraint = shift;
299 return $TYPE{$type_constraint};
302 sub find_or_create_isa_type_constraint {
303 my $type_constraint = shift;
307 $type_constraint =~ s/\s+//g;
309 $code = $TYPE{$type_constraint};
311 my @type_constraints = split /\|/, $type_constraint;
312 if (@type_constraints == 1) {
313 $code = $TYPE{$type_constraints[0]} ||
314 _build_type_constraint($type_constraints[0]);
316 my @code_list = map {
317 $TYPE{$_} || _build_type_constraint($_)
319 $code = Mouse::Meta::TypeConstraint->new(
320 _compiled_type_constraint => sub {
322 for my $code (@code_list) {
323 return 1 if $code->check($_[0]);
327 name => $type_constraint,
340 Mouse::Util::TypeConstraints - simple type constraints
344 =head2 optimized_constraints -> HashRef[CODE]
346 Returns the simple type constraints that Mouse understands.
352 =item B<subtype 'Name' => as 'Parent' => where { } ...>
354 =item B<subtype as 'Parent' => where { } ...>
356 =item B<class_type ($class, ?$options)>
358 =item B<role_type ($role, ?$options)>
360 =item B<enum (\@values)>