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',
53 __PACKAGE__->meta->add_attribute('compiled_type_constraint' => (
54 accessor => '_compiled_type_constraint',
55 predicate => '_has_compiled_type_constraint'
57 __PACKAGE__->meta->add_attribute('package_defined_in' => (
58 accessor => '_package_defined_in'
63 my ($first, @rest) = @_;
64 my %args = ref $first ? %$first : $first ? ($first, @rest) : ();
65 $args{name} = $args{name} ? "$args{name}" : "__ANON__";
67 my $self = $class->_new(%args);
68 $self->compile_type_constraint()
69 unless $self->_has_compiled_type_constraint;
78 my $coercion = $self->coercion;
82 Moose->throw_error("Cannot coerce without a type coercion");
85 return $_[0] if $self->check($_[0]);
87 return $coercion->coerce(@_);
93 my $coercion = $self->coercion;
97 Moose->throw_error("Cannot coerce without a type coercion");
100 return $_[0] if $self->check($_[0]);
102 my $result = $coercion->coerce(@_);
104 $self->assert_valid($result);
110 my ($self, @args) = @_;
111 my $constraint_subref = $self->_compiled_type_constraint;
112 return $constraint_subref->(@args) ? 1 : undef;
116 my ($self, $value) = @_;
117 if ($self->_compiled_type_constraint->($value)) {
121 $self->get_message($value);
126 my ($self, $value) = @_;
128 my $error = $self->validate($value);
129 return 1 if ! defined $error;
132 Moose->throw_error($error);
136 my ($self, $value) = @_;
137 if (my $msg = $self->message) {
139 return $msg->($value);
142 # have to load it late like this, since it uses Moose itself
143 my $can_partialdump = try {
144 # versions prior to 0.14 had a potential infinite loop bug
145 Class::MOP::load_class('Devel::PartialDump', { -version => 0.14 });
148 if ($can_partialdump) {
149 $value = Devel::PartialDump->new->dump($value);
152 $value = (defined $value ? overload::StrVal($value) : 'undef');
154 return "Validation failed for '" . $self->name . "' with value $value";
158 ## type predicates ...
161 my ( $self, $type_or_name ) = @_;
163 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
165 return 1 if $self == $other;
167 if ( $self->has_hand_optimized_type_constraint and $other->has_hand_optimized_type_constraint ) {
168 return 1 if $self->hand_optimized_type_constraint == $other->hand_optimized_type_constraint;
171 return unless $self->constraint == $other->constraint;
173 if ( $self->has_parent ) {
174 return unless $other->has_parent;
175 return unless $self->parent->equals( $other->parent );
177 return if $other->has_parent;
184 my ($self, $type_or_name) = @_;
186 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
188 ($self->equals($type) || $self->is_subtype_of($type));
192 my ($self, $type_or_name) = @_;
194 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
198 while (my $parent = $current->parent) {
199 return 1 if $parent->equals($type);
206 ## compiling the type constraint
208 sub compile_type_constraint {
210 $self->_compiled_type_constraint($self->_actually_compile_type_constraint);
213 ## type compilers ...
215 sub _actually_compile_type_constraint {
218 return $self->_compile_hand_optimized_type_constraint
219 if $self->has_hand_optimized_type_constraint;
221 my $check = $self->constraint;
222 unless ( defined $check ) {
224 Moose->throw_error( "Could not compile type constraint '"
226 . "' because no constraint check" );
229 return $self->_compile_subtype($check)
230 if $self->has_parent;
232 return $self->_compile_type($check);
235 sub _compile_hand_optimized_type_constraint {
238 my $type_constraint = $self->hand_optimized_type_constraint;
240 unless ( ref $type_constraint ) {
242 Carp::confess ("Hand optimized type constraint for " . $self->name . " is not a code reference");
243 Moose->throw_error("Hand optimized type constraint is not a code reference");
246 return $type_constraint;
249 sub _compile_subtype {
250 my ($self, $check) = @_;
252 # gather all the parent constraintss in order
254 my $optimized_parent;
255 foreach my $parent ($self->_collect_all_parents) {
256 # if a parent is optimized, the optimized constraint already includes
257 # all of its parents tcs, so we can break the loop
258 if ($parent->has_hand_optimized_type_constraint) {
259 push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
263 push @parents => $parent->constraint;
267 @parents = grep { $_ != $null_constraint } reverse @parents;
269 unless ( @parents ) {
270 return $self->_compile_type($check);
271 } elsif( $optimized_parent and @parents == 1 ) {
272 # the case of just one optimized parent is optimized to prevent
273 # looping and the unnecessary localization
274 if ( $check == $null_constraint ) {
275 return $optimized_parent;
277 return subname($self->name, sub {
278 return undef unless $optimized_parent->($_[0]);
285 # general case, check all the constraints, from the first parent to ourselves
286 my @checks = @parents;
287 push @checks, $check if $check != $null_constraint;
288 return subname($self->name => sub {
291 foreach my $check (@checks) {
292 return undef unless $check->(@args);
300 my ($self, $check) = @_;
302 return $check if $check == $null_constraint; # Item, Any
304 return subname($self->name => sub {
313 sub _collect_all_parents {
316 my $current = $self->parent;
317 while (defined $current) {
318 push @parents => $current;
319 $current = $current->parent;
324 sub create_child_type {
325 my ($self, %opts) = @_;
326 my $class = ref $self;
327 return $class->new(%opts, parent => $self);
332 # ABSTRACT: The Moose Type Constraint metaclass
340 This class represents a single type constraint. Moose's built-in type
341 constraints, as well as constraints you define, are all stored in a
342 L<Moose::Meta::TypeConstraint::Registry> object as objects of this
347 C<Moose::Meta::TypeConstraint> is a subclass of L<Class::MOP::Object>.
353 =item B<< Moose::Meta::TypeConstraint->new(%options) >>
355 This creates a new type constraint based on the provided C<%options>:
361 The constraint name. If a name is not provided, it will be set to
366 A C<Moose::Meta::TypeConstraint> object which is the parent type for
367 the type being created. This is optional.
371 This is the subroutine reference that implements the actual constraint
372 check. This defaults to a subroutine which always returns true.
376 A subroutine reference which is used to generate an error message when
377 the constraint fails. This is optional.
381 A L<Moose::Meta::TypeCoercion> object representing the coercions to
382 the type. This is optional.
386 This is a variant of the C<constraint> parameter that is somehow
387 optimized. Typically, this means incorporating both the type's
388 constraint and all of its parents' constraints into a single
389 subroutine reference.
393 =item B<< $constraint->equals($type_name_or_object) >>
395 Returns true if the supplied name or type object is the same as the
398 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
400 Returns true if the supplied name or type object is a parent of the
403 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
405 Returns true if the given type is the same as the current type, or is
406 a parent of the current type. This is a shortcut for checking
407 C<equals> and C<is_subtype_of>.
409 =item B<< $constraint->coerce($value) >>
411 This will attempt to coerce the value to the type. If the type does not
412 have any defined coercions this will throw an error.
414 If no coercion can produce a value matching C<$constraint>, the original
417 =item B<< $constraint->assert_coerce($value) >>
419 This method behaves just like C<coerce>, but if the result is not valid
420 according to C<$constraint>, an error is thrown.
422 =item B<< $constraint->check($value) >>
424 Returns true if the given value passes the constraint for the type.
426 =item B<< $constraint->validate($value) >>
428 This is similar to C<check>. However, if the type I<is valid> then the
429 method returns an explicit C<undef>. If the type is not valid, we call
430 C<< $self->get_message($value) >> internally to generate an error
433 =item B<< $constraint->assert_valid($value) >>
435 Like C<check> and C<validate>, this method checks whether C<$value> is
436 valid under the constraint. If it is, it will return true. If it is not,
437 an exception will be thrown with the results of
438 C<< $self->get_message($value) >>.
440 =item B<< $constraint->name >>
442 Returns the type's name, as provided to the constructor.
444 =item B<< $constraint->parent >>
446 Returns the type's parent, as provided to the constructor, if any.
448 =item B<< $constraint->has_parent >>
450 Returns true if the type has a parent type.
452 =item B<< $constraint->parents >>
454 A synonym for C<parent>. This is useful for polymorphism with types
455 that can have more than one parent.
457 =item B<< $constraint->constraint >>
459 Returns the type's constraint, as provided to the constructor.
461 =item B<< $constraint->get_message($value) >>
463 This generates a method for the given value. If the type does not have
464 an explicit message, we generate a default message.
466 =item B<< $constraint->has_message >>
468 Returns true if the type has a message.
470 =item B<< $constraint->message >>
472 Returns the type's message as a subroutine reference.
474 =item B<< $constraint->coercion >>
476 Returns the type's L<Moose::Meta::TypeCoercion> object, if one
479 =item B<< $constraint->has_coercion >>
481 Returns true if the type has a coercion.
483 =item B<< $constraint->hand_optimized_type_constraint >>
485 Returns the type's hand optimized constraint, as provided to the
486 constructor via the C<optimized> option.
488 =item B<< $constraint->has_hand_optimized_type_constraint >>
490 Returns true if the type has an optimized constraint.
492 =item B<< $constraint->create_child_type(%options) >>
494 This returns a new type constraint of the same class using the
495 provided C<%options>. The C<parent> option will be the current type.
497 This method exists so that subclasses of this class can override this
498 behavior and change how child types are created.
504 See L<Moose/BUGS> for details on reporting bugs.