2 package Moose::Meta::TypeConstraint;
8 use overload '0+' => sub { refaddr(shift) }, # id an object
9 '""' => sub { shift->name }, # stringify to tc name
13 use Scalar::Util qw(blessed refaddr);
14 use Sub::Name qw(subname);
17 use base qw(Class::MOP::Object);
19 __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
20 __PACKAGE__->meta->add_attribute('parent' => (
22 predicate => 'has_parent',
25 my $null_constraint = sub { 1 };
26 __PACKAGE__->meta->add_attribute('constraint' => (
27 reader => 'constraint',
28 writer => '_set_constraint',
29 default => sub { $null_constraint }
31 __PACKAGE__->meta->add_attribute('message' => (
32 accessor => 'message',
33 predicate => 'has_message'
35 __PACKAGE__->meta->add_attribute('coercion' => (
36 accessor => 'coercion',
37 predicate => 'has_coercion'
40 __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
41 init_arg => 'optimized',
42 accessor => 'hand_optimized_type_constraint',
43 predicate => 'has_hand_optimized_type_constraint',
46 __PACKAGE__->meta->add_attribute('inlined' => (
47 accessor => 'inlined',
48 predicate => 'has_inlined_type_constraint',
58 __PACKAGE__->meta->add_attribute('compiled_type_constraint' => (
59 accessor => '_compiled_type_constraint',
60 predicate => '_has_compiled_type_constraint'
62 __PACKAGE__->meta->add_attribute('package_defined_in' => (
63 accessor => '_package_defined_in'
68 my ($first, @rest) = @_;
69 my %args = ref $first ? %$first : $first ? ($first, @rest) : ();
70 $args{name} = $args{name} ? "$args{name}" : "__ANON__";
72 my $self = $class->_new(%args);
73 $self->compile_type_constraint()
74 unless $self->_has_compiled_type_constraint;
83 my $coercion = $self->coercion;
87 Moose->throw_error("Cannot coerce without a type coercion");
90 return $_[0] if $self->check($_[0]);
92 return $coercion->coerce(@_);
98 my $coercion = $self->coercion;
102 Moose->throw_error("Cannot coerce without a type coercion");
105 return $_[0] if $self->check($_[0]);
107 my $result = $coercion->coerce(@_);
109 $self->assert_valid($result);
115 my ($self, @args) = @_;
116 my $constraint_subref = $self->_compiled_type_constraint;
117 return $constraint_subref->(@args) ? 1 : undef;
121 my ($self, $value) = @_;
122 if ($self->_compiled_type_constraint->($value)) {
126 $self->get_message($value);
133 unless ( $self->has_inlined_type_constraint ) {
135 Moose->throw_error( 'Cannot inline a type constraint check for ' . $self->name );
138 return $self->inlined->( $self, @_ );
142 my ($self, $value) = @_;
144 my $error = $self->validate($value);
145 return 1 if ! defined $error;
148 Moose->throw_error($error);
152 my ($self, $value) = @_;
153 if (my $msg = $self->message) {
155 return $msg->($value);
158 # have to load it late like this, since it uses Moose itself
159 my $can_partialdump = try {
160 # versions prior to 0.14 had a potential infinite loop bug
161 Class::MOP::load_class('Devel::PartialDump', { -version => 0.14 });
164 if ($can_partialdump) {
165 $value = Devel::PartialDump->new->dump($value);
168 $value = (defined $value ? overload::StrVal($value) : 'undef');
170 return "Validation failed for '" . $self->name . "' with value $value";
174 ## type predicates ...
177 my ( $self, $type_or_name ) = @_;
179 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
181 return 1 if $self == $other;
183 if ( $self->has_hand_optimized_type_constraint and $other->has_hand_optimized_type_constraint ) {
184 return 1 if $self->hand_optimized_type_constraint == $other->hand_optimized_type_constraint;
187 return unless $self->constraint == $other->constraint;
189 if ( $self->has_parent ) {
190 return unless $other->has_parent;
191 return unless $self->parent->equals( $other->parent );
193 return if $other->has_parent;
200 my ($self, $type_or_name) = @_;
202 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
204 ($self->equals($type) || $self->is_subtype_of($type));
208 my ($self, $type_or_name) = @_;
210 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
214 while (my $parent = $current->parent) {
215 return 1 if $parent->equals($type);
222 ## compiling the type constraint
224 sub compile_type_constraint {
226 $self->_compiled_type_constraint($self->_actually_compile_type_constraint);
229 ## type compilers ...
231 sub _actually_compile_type_constraint {
234 return $self->_compile_hand_optimized_type_constraint
235 if $self->has_hand_optimized_type_constraint;
237 if ( $self->has_inlined_type_constraint ) {
239 my $sub = eval 'sub { ' . $self->_inline_check('$_[0]') . '}';
245 my $check = $self->constraint;
246 unless ( defined $check ) {
248 Moose->throw_error( "Could not compile type constraint '"
250 . "' because no constraint check" );
253 return $self->_compile_subtype($check)
254 if $self->has_parent;
256 return $self->_compile_type($check);
259 sub _compile_hand_optimized_type_constraint {
262 my $type_constraint = $self->hand_optimized_type_constraint;
264 unless ( ref $type_constraint ) {
266 Moose->throw_error("Hand optimized type constraint is not a code reference");
269 return $type_constraint;
272 sub _compile_subtype {
273 my ($self, $check) = @_;
275 # gather all the parent constraintss in order
277 my $optimized_parent;
278 foreach my $parent ($self->_collect_all_parents) {
279 # if a parent is optimized, the optimized constraint already includes
280 # all of its parents tcs, so we can break the loop
281 if ($parent->has_hand_optimized_type_constraint) {
282 push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
286 push @parents => $parent->constraint;
290 @parents = grep { $_ != $null_constraint } reverse @parents;
292 unless ( @parents ) {
293 return $self->_compile_type($check);
294 } elsif( $optimized_parent and @parents == 1 ) {
295 # the case of just one optimized parent is optimized to prevent
296 # looping and the unnecessary localization
297 if ( $check == $null_constraint ) {
298 return $optimized_parent;
300 return subname($self->name, sub {
301 return undef unless $optimized_parent->($_[0]);
308 # general case, check all the constraints, from the first parent to ourselves
309 my @checks = @parents;
310 push @checks, $check if $check != $null_constraint;
311 return subname($self->name => sub {
314 foreach my $check (@checks) {
315 return undef unless $check->(@args);
323 my ($self, $check) = @_;
325 return $check if $check == $null_constraint; # Item, Any
327 return subname($self->name => sub {
336 sub _collect_all_parents {
339 my $current = $self->parent;
340 while (defined $current) {
341 push @parents => $current;
342 $current = $current->parent;
347 sub create_child_type {
348 my ($self, %opts) = @_;
349 my $class = ref $self;
350 return $class->new(%opts, parent => $self);
355 # ABSTRACT: The Moose Type Constraint metaclass
363 This class represents a single type constraint. Moose's built-in type
364 constraints, as well as constraints you define, are all stored in a
365 L<Moose::Meta::TypeConstraint::Registry> object as objects of this
370 C<Moose::Meta::TypeConstraint> is a subclass of L<Class::MOP::Object>.
376 =item B<< Moose::Meta::TypeConstraint->new(%options) >>
378 This creates a new type constraint based on the provided C<%options>:
384 The constraint name. If a name is not provided, it will be set to
389 A C<Moose::Meta::TypeConstraint> object which is the parent type for
390 the type being created. This is optional.
394 This is the subroutine reference that implements the actual constraint
395 check. This defaults to a subroutine which always returns true.
399 A subroutine reference which is used to generate an error message when
400 the constraint fails. This is optional.
404 A L<Moose::Meta::TypeCoercion> object representing the coercions to
405 the type. This is optional.
409 This is a variant of the C<constraint> parameter that is somehow
410 optimized. Typically, this means incorporating both the type's
411 constraint and all of its parents' constraints into a single
412 subroutine reference.
416 =item B<< $constraint->equals($type_name_or_object) >>
418 Returns true if the supplied name or type object is the same as the
421 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
423 Returns true if the supplied name or type object is a parent of the
426 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
428 Returns true if the given type is the same as the current type, or is
429 a parent of the current type. This is a shortcut for checking
430 C<equals> and C<is_subtype_of>.
432 =item B<< $constraint->coerce($value) >>
434 This will attempt to coerce the value to the type. If the type does not
435 have any defined coercions this will throw an error.
437 If no coercion can produce a value matching C<$constraint>, the original
440 =item B<< $constraint->assert_coerce($value) >>
442 This method behaves just like C<coerce>, but if the result is not valid
443 according to C<$constraint>, an error is thrown.
445 =item B<< $constraint->check($value) >>
447 Returns true if the given value passes the constraint for the type.
449 =item B<< $constraint->validate($value) >>
451 This is similar to C<check>. However, if the type I<is valid> then the
452 method returns an explicit C<undef>. If the type is not valid, we call
453 C<< $self->get_message($value) >> internally to generate an error
456 =item B<< $constraint->assert_valid($value) >>
458 Like C<check> and C<validate>, this method checks whether C<$value> is
459 valid under the constraint. If it is, it will return true. If it is not,
460 an exception will be thrown with the results of
461 C<< $self->get_message($value) >>.
463 =item B<< $constraint->name >>
465 Returns the type's name, as provided to the constructor.
467 =item B<< $constraint->parent >>
469 Returns the type's parent, as provided to the constructor, if any.
471 =item B<< $constraint->has_parent >>
473 Returns true if the type has a parent type.
475 =item B<< $constraint->parents >>
477 A synonym for C<parent>. This is useful for polymorphism with types
478 that can have more than one parent.
480 =item B<< $constraint->constraint >>
482 Returns the type's constraint, as provided to the constructor.
484 =item B<< $constraint->get_message($value) >>
486 This generates a method for the given value. If the type does not have
487 an explicit message, we generate a default message.
489 =item B<< $constraint->has_message >>
491 Returns true if the type has a message.
493 =item B<< $constraint->message >>
495 Returns the type's message as a subroutine reference.
497 =item B<< $constraint->coercion >>
499 Returns the type's L<Moose::Meta::TypeCoercion> object, if one
502 =item B<< $constraint->has_coercion >>
504 Returns true if the type has a coercion.
506 =item B<< $constraint->hand_optimized_type_constraint >>
508 Returns the type's hand optimized constraint, as provided to the
509 constructor via the C<optimized> option.
511 =item B<< $constraint->has_hand_optimized_type_constraint >>
513 Returns true if the type has an optimized constraint.
515 =item B<< $constraint->create_child_type(%options) >>
517 This returns a new type constraint of the same class using the
518 provided C<%options>. The C<parent> option will be the current type.
520 This method exists so that subclasses of this class can override this
521 behavior and change how child types are created.
527 See L<Moose/BUGS> for details on reporting bugs.