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 = delete $conf{where};
113 my $as_constraint = find_or_create_isa_type_constraint(delete $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]);
136 my($name, %conf) = @_;
138 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
141 unless ($COERCE{$name}) {
143 $COERCE_KEYS{$name} = [];
145 while (my($type, $code) = each %conf) {
146 Carp::croak "A coercion action already exists for '$type'"
147 if $COERCE{$name}->{$type};
149 if (! $TYPE{$type}) {
150 # looks parameterized
151 if ($type =~ /^[^\[]+\[.+\]$/) {
152 $TYPE{$type} = _build_type_constraint($type);
154 Carp::croak "Could not find the type constraint ($type) to coerce from"
158 unshift @{ $COERCE_KEYS{$name} }, $type;
159 $COERCE{$name}->{$type} = $code;
164 my($name, $conf) = @_;
165 if ($conf && $conf->{class}) {
166 # No, you're using this wrong
167 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
168 subtype($name, as => $conf->{class});
171 $name => where => sub { $_->isa($name) }
177 my($name, $conf) = @_;
178 my $role = $conf->{role};
180 $name => where => sub {
181 return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
182 $_->meta->does_role($role);
187 # this is an original method for Mouse
188 sub typecast_constraints {
189 my($class, $pkg, $types, $value) = @_;
190 Carp::croak("wrong arguments count") unless @_==4;
193 for my $type ( split /\|/, $types ) {
194 next unless $COERCE{$type};
195 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
197 next unless $TYPE{$coerce_type}->check($value);
199 $_ = $COERCE{$type}->{$coerce_type}->($value);
200 return $_ if $types->check($_);
208 # enum ['small', 'medium', 'large']
209 if (ref($_[0]) eq 'ARRAY') {
210 my @elements = @{ shift @_ };
212 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
214 enum($name, @elements);
218 # enum size => 'small', 'medium', 'large'
220 my %is_valid = map { $_ => 1 } @_;
223 $name => where => sub { $is_valid{$_} }
227 sub _build_type_constraint {
232 if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
237 if ($constraint eq 'Maybe') {
238 $parent = _build_type_constraint('Undef');
240 $parent = _build_type_constraint($constraint);
242 my $child = _build_type_constraint($param);
243 if ($constraint eq 'ArrayRef') {
245 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
247 " if (\$parent->check(\$_[0])) {\n" .
248 " foreach my \$e (\@{\$_[0]}) {\n" .
249 " return () unless \$child->check(\$e);\n" .
256 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
257 } elsif ($constraint eq 'HashRef') {
259 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
261 " if (\$parent->check(\$_[0])) {\n" .
262 " foreach my \$e (values \%{\$_[0]}) {\n" .
263 " return () unless \$child->check(\$e);\n" .
270 $code = eval $code_str or Carp::confess($@);
271 } elsif ($constraint eq 'Maybe') {
273 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
275 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
278 $code = eval $code_str or Carp::confess($@);
280 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
282 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
284 $code = $TYPE{ $spec };
286 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
287 require Mouse::Meta::Role;
288 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
291 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
293 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
296 $code = eval $code_str or Carp::confess($@);
297 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
300 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
303 sub find_type_constraint {
304 my $type_constraint = shift;
305 return $TYPE{$type_constraint};
308 sub find_or_create_isa_type_constraint {
309 my $type_constraint = shift;
311 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)")
312 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
320 $type_constraint =~ s/\s+//g;
322 $code = $TYPE{$type_constraint};
324 my @type_constraints = split /\|/, $type_constraint;
325 if (@type_constraints == 1) {
326 $code = $TYPE{$type_constraints[0]} ||
327 _build_type_constraint($type_constraints[0]);
329 my @code_list = map {
330 $TYPE{$_} || _build_type_constraint($_)
332 $code = Mouse::Meta::TypeConstraint->new(
333 _compiled_type_constraint => sub {
335 for my $code (@code_list) {
336 return 1 if $code->check($_[0]);
340 name => $type_constraint,
353 Mouse::Util::TypeConstraints - Type constraint system for Mouse
357 use Mouse::Util::TypeConstraints;
363 subtype 'NaturalLessThanTen'
366 => message { "This number ($_) is not less than ten!" };
372 enum 'RGBColors' => qw(red green blue);
374 no Mouse::Util::TypeConstraints;
378 This module provides Mouse with the ability to create custom type
379 constraints to be used in attribute definition.
381 =head2 Important Caveat
383 This is B<NOT> a type system for Perl 5. These are type constraints,
384 and they are not used by Mouse unless you tell it to. No type
385 inference is performed, expressions are not typed, etc. etc. etc.
387 A type constraint is at heart a small "check if a value is valid"
388 function. A constraint can be associated with an attribute. This
389 simplifies parameter validation, and makes your code clearer to read,
390 because you can refer to constraints by name.
392 =head2 Slightly Less Important Caveat
394 It is B<always> a good idea to quote your type names.
396 This prevents Perl from trying to execute the call as an indirect
397 object call. This can be an issue when you have a subtype with the
398 same name as a valid class.
402 subtype DateTime => as Object => where { $_->isa('DateTime') };
404 will I<just work>, while this:
407 subtype DateTime => as Object => where { $_->isa('DateTime') };
409 will fail silently and cause many headaches. The simple way to solve
410 this, as well as future proof your subtypes from classes which have
411 yet to have been created, is to quote the type name:
414 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
416 =head2 Default Type Constraints
418 This module also provides a simple hierarchy for Perl 5 types, here is
419 that hierarchy represented visually.
444 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
445 parameterized, this means you can say:
447 ArrayRef[Int] # an array of integers
448 HashRef[CodeRef] # a hash of str to CODE ref mappings
449 Maybe[Str] # value may be a string, may be undefined
451 If Mouse finds a name in brackets that it does not recognize as an
452 existing type, it assumes that this is a class name, for example
453 C<ArrayRef[DateTime]>.
455 B<NOTE:> Unless you parameterize a type, then it is invalid to include
456 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
457 name, I<not> as a parameterization of C<ArrayRef>.
459 B<NOTE:> The C<Undef> type constraint for the most part works
460 correctly now, but edge cases may still exist, please use it
463 B<NOTE:> The C<ClassName> type constraint does a complex package
464 existence check. This means that your class B<must> be loaded for this
465 type constraint to pass.
467 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
468 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
469 constraint checks that an I<object does> the named role.
471 =head2 Type Constraint Naming
473 Type name declared via this module can only contain alphanumeric
474 characters, colons (:), and periods (.).
476 Since the types created by this module are global, it is suggested
477 that you namespace your types just as you would namespace your
478 modules. So instead of creating a I<Color> type for your
479 B<My::Graphics> module, you would call the type
480 I<My::Graphics::Types::Color> instead.
482 =head2 Use with Other Constraint Modules
484 This module can play nicely with other constraint modules with some
485 slight tweaking. The C<where> clause in types is expected to be a
486 C<CODE> reference which checks it's first argument and returns a
487 boolean. Since most constraint modules work in a similar way, it
488 should be simple to adapt them to work with Mouse.
490 For instance, this is how you could use it with
491 L<Declare::Constraints::Simple> to declare a completely new type.
493 type 'HashOfArrayOfObjects',
497 -values => IsArrayRef(IsObject)
501 Here is an example of using L<Test::Deep> and it's non-test
502 related C<eq_deeply> function.
504 type 'ArrayOfHashOfBarsAndRandomNumbers'
507 array_each(subhashof({
509 random_number => ignore()
515 =head2 optimized_constraints -> HashRef[CODE]
517 Returns the simple type constraints that Mouse understands.
523 =item B<subtype 'Name' => as 'Parent' => where { } ...>
525 =item B<subtype as 'Parent' => where { } ...>
527 =item B<class_type ($class, ?$options)>
529 =item B<role_type ($role, ?$options)>
531 =item B<enum (\@values)>
537 Much of this documentation was taken from L<Moose::Util::TypeConstraints>