1 package Mouse::Util::TypeConstraints;
7 use Scalar::Util qw/blessed looks_like_number openhandle/;
9 use Mouse::Util qw(does_role);
10 use Mouse::Meta::Module; # class_of
11 use Mouse::Meta::TypeConstraint;
14 as where message from via type subtype coerce class_type role_type enum
27 return(where => $_[0])
30 return(message => $_[0])
41 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
42 Undef => sub { !defined($_[0]) },
43 Defined => sub { defined($_[0]) },
44 Value => sub { defined($_[0]) && !ref($_[0]) },
45 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
46 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
47 Str => sub { defined($_[0]) && !ref($_[0]) },
48 Ref => sub { ref($_[0]) },
50 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
51 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
52 HashRef => sub { ref($_[0]) eq 'HASH' },
53 CodeRef => sub { ref($_[0]) eq 'CODE' },
54 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
55 GlobRef => sub { ref($_[0]) eq 'GLOB' },
58 ref($_[0]) eq 'GLOB' && openhandle($_[0])
60 blessed($_[0]) && $_[0]->isa("IO::Handle")
63 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
65 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
66 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
69 while (my ($name, $code) = each %builtins) {
70 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
72 _compiled_type_constraint => $code,
74 $TYPE_SOURCE{$name} = __PACKAGE__;
77 sub optimized_constraints { \%TYPE }
79 my @builtins = keys %TYPE;
80 sub list_all_builtin_type_constraints { @builtins }
82 sub list_all_type_constraints { keys %TYPE }
89 if(@_ == 1 && ref $_[0]){ # type { where => ... }
92 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
96 elsif(@_ % 2){ # odd number of arguments
104 $name = '__ANON__' if !defined $name;
108 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
109 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} || do {
113 my $as = delete $conf{as} || 'Any';
114 ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
117 my $tc = Mouse::Meta::TypeConstraint->new(
119 _compiled_type_constraint => sub {
121 return &{$constraint};
125 $TYPE_SOURCE{$name} = $pkg;
135 if(@_ == 1 && ref $_[0]){ # type { where => ... }
138 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
142 elsif(@_ % 2){ # odd number of arguments
150 $name = '__ANON__' if !defined $name;
154 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
155 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
158 my $constraint = delete $conf{where};
159 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
160 ->{_compiled_type_constraint};
162 my $tc = Mouse::Meta::TypeConstraint->new(
164 _compiled_type_constraint => (
168 $as_constraint->($_[0]) && $constraint->($_[0])
172 $as_constraint->($_[0]);
178 $TYPE_SOURCE{$name} = $pkg;
187 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
190 unless ($COERCE{$name}) {
192 $COERCE_KEYS{$name} = [];
195 while (my($type, $code) = splice @_, 0, 2) {
196 Carp::croak "A coercion action already exists for '$type'"
197 if $COERCE{$name}->{$type};
199 if (! $TYPE{$type}) {
200 # looks parameterized
201 if ($type =~ /^[^\[]+\[.+\]$/) {
202 $TYPE{$type} = _build_type_constraint($type);
204 Carp::croak "Could not find the type constraint ($type) to coerce from"
208 push @{ $COERCE_KEYS{$name} }, $type;
209 $COERCE{$name}->{$type} = $code;
215 my($name, $conf) = @_;
216 if ($conf && $conf->{class}) {
217 # No, you're using this wrong
218 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
219 subtype $name, as => $conf->{class};
223 where => sub { blessed($_) && $_->isa($name) },
229 my($name, $conf) = @_;
230 my $role = $conf->{role};
232 $name => where => sub { does_role($_, $role) },
236 # this is an original method for Mouse
237 sub typecast_constraints {
238 my($class, $pkg, $types, $value) = @_;
239 Carp::croak("wrong arguments count") unless @_==4;
242 for my $type ( split /\|/, $types ) {
243 next unless $COERCE{$type};
244 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
246 next unless $TYPE{$coerce_type}->check($value);
248 $_ = $COERCE{$type}->{$coerce_type}->($value);
249 return $_ if $types->check($_);
257 # enum ['small', 'medium', 'large']
258 if (ref($_[0]) eq 'ARRAY') {
259 my @elements = @{ shift @_ };
261 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
263 enum($name, @elements);
267 # enum size => 'small', 'medium', 'large'
269 my %is_valid = map { $_ => 1 } @_;
272 $name => where => sub { $is_valid{$_} }
276 sub _build_type_constraint {
281 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
286 if ($constraint eq 'Maybe') {
287 $parent = _build_type_constraint('Undef');
289 $parent = _build_type_constraint($constraint);
291 my $child = _build_type_constraint($param);
292 if ($constraint eq 'ArrayRef') {
294 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
296 " if (\$parent->check(\$_[0])) {\n" .
297 " foreach my \$e (\@{\$_[0]}) {\n" .
298 " return () unless \$child->check(\$e);\n" .
305 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
306 } elsif ($constraint eq 'HashRef') {
308 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
310 " if (\$parent->check(\$_[0])) {\n" .
311 " foreach my \$e (values \%{\$_[0]}) {\n" .
312 " return () unless \$child->check(\$e);\n" .
319 $code = eval $code_str or Carp::confess($@);
320 } elsif ($constraint eq 'Maybe') {
322 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
324 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
327 $code = eval $code_str or Carp::confess($@);
329 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
331 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
333 $code = $TYPE{ $spec };
335 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
336 require Mouse::Meta::Role;
337 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
340 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
342 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
345 $code = eval $code_str or Carp::confess($@);
346 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
349 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
352 sub find_type_constraint {
354 if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
362 sub find_or_create_isa_type_constraint {
363 my $type_constraint = shift;
365 Carp::confess("Got isa => type_constraints, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef and Maybe (rt.cpan.org #39795)")
366 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
374 $type_constraint =~ s/\s+//g;
376 $code = $TYPE{$type_constraint};
378 my @type_constraints = split /\|/, $type_constraint;
379 if (@type_constraints == 1) {
380 $code = $TYPE{$type_constraints[0]} ||
381 _build_type_constraint($type_constraints[0]);
383 my @code_list = map {
384 $TYPE{$_} || _build_type_constraint($_)
386 $code = Mouse::Meta::TypeConstraint->new(
387 _compiled_type_constraint => sub {
389 for my $code (@code_list) {
390 return 1 if $code->check($_[0]);
394 name => $type_constraint,
407 Mouse::Util::TypeConstraints - Type constraint system for Mouse
411 use Mouse::Util::TypeConstraints;
417 subtype 'NaturalLessThanTen'
420 => message { "This number ($_) is not less than ten!" };
426 enum 'RGBColors' => qw(red green blue);
428 no Mouse::Util::TypeConstraints;
432 This module provides Mouse with the ability to create custom type
433 constraints to be used in attribute definition.
435 =head2 Important Caveat
437 This is B<NOT> a type system for Perl 5. These are type constraints,
438 and they are not used by Mouse unless you tell it to. No type
439 inference is performed, expressions are not typed, etc. etc. etc.
441 A type constraint is at heart a small "check if a value is valid"
442 function. A constraint can be associated with an attribute. This
443 simplifies parameter validation, and makes your code clearer to read,
444 because you can refer to constraints by name.
446 =head2 Slightly Less Important Caveat
448 It is B<always> a good idea to quote your type names.
450 This prevents Perl from trying to execute the call as an indirect
451 object call. This can be an issue when you have a subtype with the
452 same name as a valid class.
456 subtype DateTime => as Object => where { $_->isa('DateTime') };
458 will I<just work>, while this:
461 subtype DateTime => as Object => where { $_->isa('DateTime') };
463 will fail silently and cause many headaches. The simple way to solve
464 this, as well as future proof your subtypes from classes which have
465 yet to have been created, is to quote the type name:
468 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
470 =head2 Default Type Constraints
472 This module also provides a simple hierarchy for Perl 5 types, here is
473 that hierarchy represented visually.
498 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
499 parameterized, this means you can say:
501 ArrayRef[Int] # an array of integers
502 HashRef[CodeRef] # a hash of str to CODE ref mappings
503 Maybe[Str] # value may be a string, may be undefined
505 If Mouse finds a name in brackets that it does not recognize as an
506 existing type, it assumes that this is a class name, for example
507 C<ArrayRef[DateTime]>.
509 B<NOTE:> Unless you parameterize a type, then it is invalid to include
510 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
511 name, I<not> as a parameterization of C<ArrayRef>.
513 B<NOTE:> The C<Undef> type constraint for the most part works
514 correctly now, but edge cases may still exist, please use it
517 B<NOTE:> The C<ClassName> type constraint does a complex package
518 existence check. This means that your class B<must> be loaded for this
519 type constraint to pass.
521 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
522 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
523 constraint checks that an I<object does> the named role.
525 =head2 Type Constraint Naming
527 Type name declared via this module can only contain alphanumeric
528 characters, colons (:), and periods (.).
530 Since the types created by this module are global, it is suggested
531 that you namespace your types just as you would namespace your
532 modules. So instead of creating a I<Color> type for your
533 B<My::Graphics> module, you would call the type
534 I<My::Graphics::Types::Color> instead.
536 =head2 Use with Other Constraint Modules
538 This module can play nicely with other constraint modules with some
539 slight tweaking. The C<where> clause in types is expected to be a
540 C<CODE> reference which checks it's first argument and returns a
541 boolean. Since most constraint modules work in a similar way, it
542 should be simple to adapt them to work with Mouse.
544 For instance, this is how you could use it with
545 L<Declare::Constraints::Simple> to declare a completely new type.
547 type 'HashOfArrayOfObjects',
551 -values => IsArrayRef(IsObject)
555 Here is an example of using L<Test::Deep> and it's non-test
556 related C<eq_deeply> function.
558 type 'ArrayOfHashOfBarsAndRandomNumbers'
561 array_each(subhashof({
563 random_number => ignore()
569 =head2 optimized_constraints -> HashRef[CODE]
571 Returns the simple type constraints that Mouse understands.
577 =item B<subtype 'Name' => as 'Parent' => where { } ...>
579 =item B<subtype as 'Parent' => where { } ...>
581 =item B<class_type ($class, ?$options)>
583 =item B<role_type ($role, ?$options)>
585 =item B<enum (\@values)>
591 Much of this documentation was taken from L<Moose::Util::TypeConstraints>