2 package Moose::Meta::TypeConstraint;
8 use overload '0+' => sub { refaddr(shift) }, # id an object
9 '""' => sub { shift->name }, # stringify to tc name
14 use Scalar::Util qw(blessed refaddr);
15 use Sub::Name qw(subname);
18 use base qw(Class::MOP::Object);
20 __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
21 __PACKAGE__->meta->add_attribute('parent' => (
23 predicate => 'has_parent',
26 my $null_constraint = sub { 1 };
27 __PACKAGE__->meta->add_attribute('constraint' => (
28 reader => 'constraint',
29 writer => '_set_constraint',
30 default => sub { $null_constraint }
32 __PACKAGE__->meta->add_attribute('message' => (
33 accessor => 'message',
34 predicate => 'has_message'
36 __PACKAGE__->meta->add_attribute('coercion' => (
37 accessor => 'coercion',
38 predicate => 'has_coercion'
41 __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
42 init_arg => 'optimized',
43 accessor => 'hand_optimized_type_constraint',
44 predicate => 'has_hand_optimized_type_constraint',
47 __PACKAGE__->meta->add_attribute('inlined' => (
48 init_arg => 'inlined',
49 accessor => 'inlined',
50 predicate => '_has_inlined_type_constraint',
53 __PACKAGE__->meta->add_attribute('inline_environment' => (
54 init_arg => 'inline_environment',
55 accessor => 'inline_environment',
56 default => sub { {} },
66 __PACKAGE__->meta->add_attribute('compiled_type_constraint' => (
67 accessor => '_compiled_type_constraint',
68 predicate => '_has_compiled_type_constraint'
70 __PACKAGE__->meta->add_attribute('package_defined_in' => (
71 accessor => '_package_defined_in'
76 my ($first, @rest) = @_;
77 my %args = ref $first ? %$first : $first ? ($first, @rest) : ();
78 $args{name} = $args{name} ? "$args{name}" : "__ANON__";
80 my $self = $class->_new(%args);
81 $self->compile_type_constraint()
82 unless $self->_has_compiled_type_constraint;
91 my $coercion = $self->coercion;
95 Moose->throw_error("Cannot coerce without a type coercion");
98 return $_[0] if $self->check($_[0]);
100 return $coercion->coerce(@_);
106 my $coercion = $self->coercion;
110 Moose->throw_error("Cannot coerce without a type coercion");
113 return $_[0] if $self->check($_[0]);
115 my $result = $coercion->coerce(@_);
117 $self->assert_valid($result);
123 my ($self, @args) = @_;
124 my $constraint_subref = $self->_compiled_type_constraint;
125 return $constraint_subref->(@args) ? 1 : undef;
129 my ($self, $value) = @_;
130 if ($self->_compiled_type_constraint->($value)) {
134 $self->get_message($value);
138 sub has_inlined_type_constraint {
141 if ( $self->has_parent && $self->constraint == $null_constraint ) {
142 return $self->parent->has_inlined_type_constraint;
145 return $self->_has_inlined_type_constraint;
151 unless ( $self->has_inlined_type_constraint ) {
153 Moose->throw_error( 'Cannot inline a type constraint check for ' . $self->name );
156 if ( $self->has_parent && $self->constraint == $null_constraint ) {
157 return $self->parent->_inline_check(@_);
160 return $self->inlined->( $self, @_ );
164 my ($self, $value) = @_;
166 my $error = $self->validate($value);
167 return 1 if ! defined $error;
170 Moose->throw_error($error);
174 my ($self, $value) = @_;
175 if (my $msg = $self->message) {
177 return $msg->($value);
180 # have to load it late like this, since it uses Moose itself
181 my $can_partialdump = try {
182 # versions prior to 0.14 had a potential infinite loop bug
183 Class::MOP::load_class('Devel::PartialDump', { -version => 0.14 });
186 if ($can_partialdump) {
187 $value = Devel::PartialDump->new->dump($value);
190 $value = (defined $value ? overload::StrVal($value) : 'undef');
192 return "Validation failed for '" . $self->name . "' with value $value";
196 ## type predicates ...
199 my ( $self, $type_or_name ) = @_;
201 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
203 return 1 if $self == $other;
205 if ( $self->has_hand_optimized_type_constraint and $other->has_hand_optimized_type_constraint ) {
206 return 1 if $self->hand_optimized_type_constraint == $other->hand_optimized_type_constraint;
209 return unless $self->constraint == $other->constraint;
211 if ( $self->has_parent ) {
212 return unless $other->has_parent;
213 return unless $self->parent->equals( $other->parent );
215 return if $other->has_parent;
222 my ($self, $type_or_name) = @_;
224 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
226 ($self->equals($type) || $self->is_subtype_of($type));
230 my ($self, $type_or_name) = @_;
232 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
236 while (my $parent = $current->parent) {
237 return 1 if $parent->equals($type);
244 ## compiling the type constraint
246 sub compile_type_constraint {
248 $self->_compiled_type_constraint($self->_actually_compile_type_constraint);
251 ## type compilers ...
253 sub _actually_compile_type_constraint {
256 return $self->_compile_hand_optimized_type_constraint
257 if $self->has_hand_optimized_type_constraint;
259 if ( $self->has_inlined_type_constraint ) {
261 source => 'sub { ' . $self->_inline_check('$_[0]') . ' }',
262 environment => $self->inline_environment,
266 my $check = $self->constraint;
267 unless ( defined $check ) {
269 Moose->throw_error( "Could not compile type constraint '"
271 . "' because no constraint check" );
274 return $self->_compile_subtype($check)
275 if $self->has_parent;
277 return $self->_compile_type($check);
280 sub _compile_hand_optimized_type_constraint {
283 my $type_constraint = $self->hand_optimized_type_constraint;
285 unless ( ref $type_constraint ) {
287 Moose->throw_error("Hand optimized type constraint is not a code reference");
290 return $type_constraint;
293 sub _compile_subtype {
294 my ($self, $check) = @_;
296 # gather all the parent constraintss in order
298 my $optimized_parent;
299 foreach my $parent ($self->_collect_all_parents) {
300 # if a parent is optimized, the optimized constraint already includes
301 # all of its parents tcs, so we can break the loop
302 if ($parent->has_hand_optimized_type_constraint) {
303 push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
307 push @parents => $parent->constraint;
311 @parents = grep { $_ != $null_constraint } reverse @parents;
313 unless ( @parents ) {
314 return $self->_compile_type($check);
315 } elsif( $optimized_parent and @parents == 1 ) {
316 # the case of just one optimized parent is optimized to prevent
317 # looping and the unnecessary localization
318 if ( $check == $null_constraint ) {
319 return $optimized_parent;
321 return subname($self->name, sub {
322 return undef unless $optimized_parent->($_[0]);
329 # general case, check all the constraints, from the first parent to ourselves
330 my @checks = @parents;
331 push @checks, $check if $check != $null_constraint;
332 return subname($self->name => sub {
335 foreach my $check (@checks) {
336 return undef unless $check->(@args);
344 my ($self, $check) = @_;
346 return $check if $check == $null_constraint; # Item, Any
348 return subname($self->name => sub {
357 sub _collect_all_parents {
360 my $current = $self->parent;
361 while (defined $current) {
362 push @parents => $current;
363 $current = $current->parent;
368 sub create_child_type {
369 my ($self, %opts) = @_;
370 my $class = ref $self;
371 return $class->new(%opts, parent => $self);
376 # ABSTRACT: The Moose Type Constraint metaclass
384 This class represents a single type constraint. Moose's built-in type
385 constraints, as well as constraints you define, are all stored in a
386 L<Moose::Meta::TypeConstraint::Registry> object as objects of this
391 C<Moose::Meta::TypeConstraint> is a subclass of L<Class::MOP::Object>.
397 =item B<< Moose::Meta::TypeConstraint->new(%options) >>
399 This creates a new type constraint based on the provided C<%options>:
405 The constraint name. If a name is not provided, it will be set to
410 A C<Moose::Meta::TypeConstraint> object which is the parent type for
411 the type being created. This is optional.
415 This is the subroutine reference that implements the actual constraint
416 check. This defaults to a subroutine which always returns true.
420 A subroutine reference which is used to generate an error message when
421 the constraint fails. This is optional.
425 A L<Moose::Meta::TypeCoercion> object representing the coercions to
426 the type. This is optional.
430 This is a variant of the C<constraint> parameter that is somehow
431 optimized. Typically, this means incorporating both the type's
432 constraint and all of its parents' constraints into a single
433 subroutine reference.
437 =item B<< $constraint->equals($type_name_or_object) >>
439 Returns true if the supplied name or type object is the same as the
442 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
444 Returns true if the supplied name or type object is a parent of the
447 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
449 Returns true if the given type is the same as the current type, or is
450 a parent of the current type. This is a shortcut for checking
451 C<equals> and C<is_subtype_of>.
453 =item B<< $constraint->coerce($value) >>
455 This will attempt to coerce the value to the type. If the type does not
456 have any defined coercions this will throw an error.
458 If no coercion can produce a value matching C<$constraint>, the original
461 =item B<< $constraint->assert_coerce($value) >>
463 This method behaves just like C<coerce>, but if the result is not valid
464 according to C<$constraint>, an error is thrown.
466 =item B<< $constraint->check($value) >>
468 Returns true if the given value passes the constraint for the type.
470 =item B<< $constraint->validate($value) >>
472 This is similar to C<check>. However, if the type I<is valid> then the
473 method returns an explicit C<undef>. If the type is not valid, we call
474 C<< $self->get_message($value) >> internally to generate an error
477 =item B<< $constraint->assert_valid($value) >>
479 Like C<check> and C<validate>, this method checks whether C<$value> is
480 valid under the constraint. If it is, it will return true. If it is not,
481 an exception will be thrown with the results of
482 C<< $self->get_message($value) >>.
484 =item B<< $constraint->name >>
486 Returns the type's name, as provided to the constructor.
488 =item B<< $constraint->parent >>
490 Returns the type's parent, as provided to the constructor, if any.
492 =item B<< $constraint->has_parent >>
494 Returns true if the type has a parent type.
496 =item B<< $constraint->parents >>
498 A synonym for C<parent>. This is useful for polymorphism with types
499 that can have more than one parent.
501 =item B<< $constraint->constraint >>
503 Returns the type's constraint, as provided to the constructor.
505 =item B<< $constraint->get_message($value) >>
507 This generates a method for the given value. If the type does not have
508 an explicit message, we generate a default message.
510 =item B<< $constraint->has_message >>
512 Returns true if the type has a message.
514 =item B<< $constraint->message >>
516 Returns the type's message as a subroutine reference.
518 =item B<< $constraint->coercion >>
520 Returns the type's L<Moose::Meta::TypeCoercion> object, if one
523 =item B<< $constraint->has_coercion >>
525 Returns true if the type has a coercion.
527 =item B<< $constraint->hand_optimized_type_constraint >>
529 Returns the type's hand optimized constraint, as provided to the
530 constructor via the C<optimized> option.
532 =item B<< $constraint->has_hand_optimized_type_constraint >>
534 Returns true if the type has an optimized constraint.
536 =item B<< $constraint->create_child_type(%options) >>
538 This returns a new type constraint of the same class using the
539 provided C<%options>. The C<parent> option will be the current type.
541 This method exists so that subclasses of this class can override this
542 behavior and change how child types are created.
548 See L<Moose/BUGS> for details on reporting bugs.