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);
16 use base qw(Class::MOP::Object);
18 __PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
19 __PACKAGE__->meta->add_attribute('parent' => (
21 predicate => 'has_parent',
24 my $null_constraint = sub { 1 };
25 __PACKAGE__->meta->add_attribute('constraint' => (
26 reader => 'constraint',
27 writer => '_set_constraint',
28 default => sub { $null_constraint }
30 __PACKAGE__->meta->add_attribute('message' => (
31 accessor => 'message',
32 predicate => 'has_message'
34 __PACKAGE__->meta->add_attribute('coercion' => (
35 accessor => 'coercion',
36 predicate => 'has_coercion'
39 __PACKAGE__->meta->add_attribute('hand_optimized_type_constraint' => (
40 init_arg => 'optimized',
41 accessor => 'hand_optimized_type_constraint',
42 predicate => 'has_hand_optimized_type_constraint',
52 __PACKAGE__->meta->add_attribute('compiled_type_constraint' => (
53 accessor => '_compiled_type_constraint',
54 predicate => '_has_compiled_type_constraint'
56 __PACKAGE__->meta->add_attribute('package_defined_in' => (
57 accessor => '_package_defined_in'
62 my ($first, @rest) = @_;
63 my %args = ref $first ? %$first : $first ? ($first, @rest) : ();
64 $args{name} = $args{name} ? "$args{name}" : "__ANON__";
66 my $self = $class->_new(%args);
67 $self->compile_type_constraint()
68 unless $self->_has_compiled_type_constraint;
77 my $coercion = $self->coercion;
81 Moose->throw_error("Cannot coerce without a type coercion");
84 return $_[0] if $self->check($_[0]);
86 return $coercion->coerce(@_);
92 my $coercion = $self->coercion;
96 Moose->throw_error("Cannot coerce without a type coercion");
99 return $_[0] if $self->check($_[0]);
101 my $result = $coercion->coerce(@_);
103 $self->assert_valid($result);
109 my ($self, @args) = @_;
110 my $constraint_subref = $self->_compiled_type_constraint;
111 return $constraint_subref->(@args) ? 1 : undef;
115 my ($self, $value) = @_;
116 if ($self->_compiled_type_constraint->($value)) {
120 $self->get_message($value);
125 my ($self, $value) = @_;
127 my $error = $self->validate($value);
128 return 1 if ! defined $error;
131 Moose->throw_error($error);
135 my ($self, $value) = @_;
136 if (my $msg = $self->message) {
138 return $msg->($value);
141 $value = (defined $value ? overload::StrVal($value) : 'undef');
142 return "Validation failed for '" . $self->name . "' with value $value";
146 ## type predicates ...
149 my ( $self, $type_or_name ) = @_;
151 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
153 return 1 if $self == $other;
155 if ( $self->has_hand_optimized_type_constraint and $other->has_hand_optimized_type_constraint ) {
156 return 1 if $self->hand_optimized_type_constraint == $other->hand_optimized_type_constraint;
159 return unless $self->constraint == $other->constraint;
161 if ( $self->has_parent ) {
162 return unless $other->has_parent;
163 return unless $self->parent->equals( $other->parent );
165 return if $other->has_parent;
172 my ($self, $type_or_name) = @_;
174 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
176 ($self->equals($type) || $self->is_subtype_of($type));
180 my ($self, $type_or_name) = @_;
182 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
186 while (my $parent = $current->parent) {
187 return 1 if $parent->equals($type);
194 ## compiling the type constraint
196 sub compile_type_constraint {
198 $self->_compiled_type_constraint($self->_actually_compile_type_constraint);
201 ## type compilers ...
203 sub _actually_compile_type_constraint {
206 return $self->_compile_hand_optimized_type_constraint
207 if $self->has_hand_optimized_type_constraint;
209 my $check = $self->constraint;
210 unless ( defined $check ) {
212 Moose->throw_error( "Could not compile type constraint '"
214 . "' because no constraint check" );
217 return $self->_compile_subtype($check)
218 if $self->has_parent;
220 return $self->_compile_type($check);
223 sub _compile_hand_optimized_type_constraint {
226 my $type_constraint = $self->hand_optimized_type_constraint;
228 unless ( ref $type_constraint ) {
230 Carp::confess ("Hand optimized type constraint for " . $self->name . " is not a code reference");
231 Moose->throw_error("Hand optimized type constraint is not a code reference");
234 return $type_constraint;
237 sub _compile_subtype {
238 my ($self, $check) = @_;
240 # gather all the parent constraintss in order
242 my $optimized_parent;
243 foreach my $parent ($self->_collect_all_parents) {
244 # if a parent is optimized, the optimized constraint already includes
245 # all of its parents tcs, so we can break the loop
246 if ($parent->has_hand_optimized_type_constraint) {
247 push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
251 push @parents => $parent->constraint;
255 @parents = grep { $_ != $null_constraint } reverse @parents;
257 unless ( @parents ) {
258 return $self->_compile_type($check);
259 } elsif( $optimized_parent and @parents == 1 ) {
260 # the case of just one optimized parent is optimized to prevent
261 # looping and the unnecessary localization
262 if ( $check == $null_constraint ) {
263 return $optimized_parent;
265 return subname($self->name, sub {
266 return undef unless $optimized_parent->($_[0]);
273 # general case, check all the constraints, from the first parent to ourselves
274 my @checks = @parents;
275 push @checks, $check if $check != $null_constraint;
276 return subname($self->name => sub {
279 foreach my $check (@checks) {
280 return undef unless $check->(@args);
288 my ($self, $check) = @_;
290 return $check if $check == $null_constraint; # Item, Any
292 return subname($self->name => sub {
301 sub _collect_all_parents {
304 my $current = $self->parent;
305 while (defined $current) {
306 push @parents => $current;
307 $current = $current->parent;
312 sub create_child_type {
313 my ($self, %opts) = @_;
314 my $class = ref $self;
315 return $class->new(%opts, parent => $self);
320 # ABSTRACT: The Moose Type Constraint metaclass
328 This class represents a single type constraint. Moose's built-in type
329 constraints, as well as constraints you define, are all stored in a
330 L<Moose::Meta::TypeConstraint::Registry> object as objects of this
335 C<Moose::Meta::TypeConstraint> is a subclass of L<Class::MOP::Object>.
341 =item B<< Moose::Meta::TypeConstraint->new(%options) >>
343 This creates a new type constraint based on the provided C<%options>:
349 The constraint name. If a name is not provided, it will be set to
354 A C<Moose::Meta::TypeConstraint> object which is the parent type for
355 the type being created. This is optional.
359 This is the subroutine reference that implements the actual constraint
360 check. This defaults to a subroutine which always returns true.
364 A subroutine reference which is used to generate an error message when
365 the constraint fails. This is optional.
369 A L<Moose::Meta::TypeCoercion> object representing the coercions to
370 the type. This is optional.
374 This is a variant of the C<constraint> parameter that is somehow
375 optimized. Typically, this means incorporating both the type's
376 constraint and all of its parents' constraints into a single
377 subroutine reference.
381 =item B<< $constraint->equals($type_name_or_object) >>
383 Returns true if the supplied name or type object is the same as the
386 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
388 Returns true if the supplied name or type object is a parent of the
391 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
393 Returns true if the given type is the same as the current type, or is
394 a parent of the current type. This is a shortcut for checking
395 C<equals> and C<is_subtype_of>.
397 =item B<< $constraint->coerce($value) >>
399 This will attempt to coerce the value to the type. If the type does not
400 have any defined coercions this will throw an error.
402 If no coercion can produce a value matching C<$constraint>, the original
405 =item B<< $constraint->assert_coerce($value) >>
407 This method behaves just like C<coerce>, but if the result is not valid
408 according to C<$constraint>, an error is thrown.
410 =item B<< $constraint->check($value) >>
412 Returns true if the given value passes the constraint for the type.
414 =item B<< $constraint->validate($value) >>
416 This is similar to C<check>. However, if the type I<is valid> then the
417 method returns an explicit C<undef>. If the type is not valid, we call
418 C<< $self->get_message($value) >> internally to generate an error
421 =item B<< $constraint->assert_valid($value) >>
423 Like C<check> and C<validate>, this method checks whether C<$value> is
424 valid under the constraint. If it is, it will return true. If it is not,
425 an exception will be thrown with the results of
426 C<< $self->get_message($value) >>.
428 =item B<< $constraint->name >>
430 Returns the type's name, as provided to the constructor.
432 =item B<< $constraint->parent >>
434 Returns the type's parent, as provided to the constructor, if any.
436 =item B<< $constraint->has_parent >>
438 Returns true if the type has a parent type.
440 =item B<< $constraint->parents >>
442 A synonym for C<parent>. This is useful for polymorphism with types
443 that can have more than one parent.
445 =item B<< $constraint->constraint >>
447 Returns the type's constraint, as provided to the constructor.
449 =item B<< $constraint->get_message($value) >>
451 This generates a method for the given value. If the type does not have
452 an explicit message, we generate a default message.
454 =item B<< $constraint->has_message >>
456 Returns true if the type has a message.
458 =item B<< $constraint->message >>
460 Returns the type's message as a subroutine reference.
462 =item B<< $constraint->coercion >>
464 Returns the type's L<Moose::Meta::TypeCoercion> object, if one
467 =item B<< $constraint->has_coercion >>
469 Returns true if the type has a coercion.
471 =item B<< $constraint->hand_optimized_type_constraint >>
473 Returns the type's hand optimized constraint, as provided to the
474 constructor via the C<optimized> option.
476 =item B<< $constraint->has_hand_optimized_type_constraint >>
478 Returns true if the type has an optimized constraint.
480 =item B<< $constraint->create_child_type(%options) >>
482 This returns a new type constraint of the same class using the
483 provided C<%options>. The C<parent> option will be the current type.
485 This method exists so that subclasses of this class can override this
486 behavior and change how child types are created.
492 See L<Moose/BUGS> for details on reporting bugs.