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 if (try { Class::MOP::load_class('Devel::PartialDump'); 1 }) {
144 $value = Devel::PartialDump->new->dump($value);
147 $value = (defined $value ? overload::StrVal($value) : 'undef');
149 return "Validation failed for '" . $self->name . "' with value $value";
153 ## type predicates ...
156 my ( $self, $type_or_name ) = @_;
158 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
160 return 1 if $self == $other;
162 if ( $self->has_hand_optimized_type_constraint and $other->has_hand_optimized_type_constraint ) {
163 return 1 if $self->hand_optimized_type_constraint == $other->hand_optimized_type_constraint;
166 return unless $self->constraint == $other->constraint;
168 if ( $self->has_parent ) {
169 return unless $other->has_parent;
170 return unless $self->parent->equals( $other->parent );
172 return if $other->has_parent;
179 my ($self, $type_or_name) = @_;
181 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
183 ($self->equals($type) || $self->is_subtype_of($type));
187 my ($self, $type_or_name) = @_;
189 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name) or return;
193 while (my $parent = $current->parent) {
194 return 1 if $parent->equals($type);
201 ## compiling the type constraint
203 sub compile_type_constraint {
205 $self->_compiled_type_constraint($self->_actually_compile_type_constraint);
208 ## type compilers ...
210 sub _actually_compile_type_constraint {
213 return $self->_compile_hand_optimized_type_constraint
214 if $self->has_hand_optimized_type_constraint;
216 my $check = $self->constraint;
217 unless ( defined $check ) {
219 Moose->throw_error( "Could not compile type constraint '"
221 . "' because no constraint check" );
224 return $self->_compile_subtype($check)
225 if $self->has_parent;
227 return $self->_compile_type($check);
230 sub _compile_hand_optimized_type_constraint {
233 my $type_constraint = $self->hand_optimized_type_constraint;
235 unless ( ref $type_constraint ) {
237 Carp::confess ("Hand optimized type constraint for " . $self->name . " is not a code reference");
238 Moose->throw_error("Hand optimized type constraint is not a code reference");
241 return $type_constraint;
244 sub _compile_subtype {
245 my ($self, $check) = @_;
247 # gather all the parent constraintss in order
249 my $optimized_parent;
250 foreach my $parent ($self->_collect_all_parents) {
251 # if a parent is optimized, the optimized constraint already includes
252 # all of its parents tcs, so we can break the loop
253 if ($parent->has_hand_optimized_type_constraint) {
254 push @parents => $optimized_parent = $parent->hand_optimized_type_constraint;
258 push @parents => $parent->constraint;
262 @parents = grep { $_ != $null_constraint } reverse @parents;
264 unless ( @parents ) {
265 return $self->_compile_type($check);
266 } elsif( $optimized_parent and @parents == 1 ) {
267 # the case of just one optimized parent is optimized to prevent
268 # looping and the unnecessary localization
269 if ( $check == $null_constraint ) {
270 return $optimized_parent;
272 return subname($self->name, sub {
273 return undef unless $optimized_parent->($_[0]);
280 # general case, check all the constraints, from the first parent to ourselves
281 my @checks = @parents;
282 push @checks, $check if $check != $null_constraint;
283 return subname($self->name => sub {
286 foreach my $check (@checks) {
287 return undef unless $check->(@args);
295 my ($self, $check) = @_;
297 return $check if $check == $null_constraint; # Item, Any
299 return subname($self->name => sub {
308 sub _collect_all_parents {
311 my $current = $self->parent;
312 while (defined $current) {
313 push @parents => $current;
314 $current = $current->parent;
319 sub create_child_type {
320 my ($self, %opts) = @_;
321 my $class = ref $self;
322 return $class->new(%opts, parent => $self);
327 # ABSTRACT: The Moose Type Constraint metaclass
335 This class represents a single type constraint. Moose's built-in type
336 constraints, as well as constraints you define, are all stored in a
337 L<Moose::Meta::TypeConstraint::Registry> object as objects of this
342 C<Moose::Meta::TypeConstraint> is a subclass of L<Class::MOP::Object>.
348 =item B<< Moose::Meta::TypeConstraint->new(%options) >>
350 This creates a new type constraint based on the provided C<%options>:
356 The constraint name. If a name is not provided, it will be set to
361 A C<Moose::Meta::TypeConstraint> object which is the parent type for
362 the type being created. This is optional.
366 This is the subroutine reference that implements the actual constraint
367 check. This defaults to a subroutine which always returns true.
371 A subroutine reference which is used to generate an error message when
372 the constraint fails. This is optional.
376 A L<Moose::Meta::TypeCoercion> object representing the coercions to
377 the type. This is optional.
381 This is a variant of the C<constraint> parameter that is somehow
382 optimized. Typically, this means incorporating both the type's
383 constraint and all of its parents' constraints into a single
384 subroutine reference.
388 =item B<< $constraint->equals($type_name_or_object) >>
390 Returns true if the supplied name or type object is the same as the
393 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
395 Returns true if the supplied name or type object is a parent of the
398 =item B<< $constraint->is_a_type_of($type_name_or_object) >>
400 Returns true if the given type is the same as the current type, or is
401 a parent of the current type. This is a shortcut for checking
402 C<equals> and C<is_subtype_of>.
404 =item B<< $constraint->coerce($value) >>
406 This will attempt to coerce the value to the type. If the type does not
407 have any defined coercions this will throw an error.
409 If no coercion can produce a value matching C<$constraint>, the original
412 =item B<< $constraint->assert_coerce($value) >>
414 This method behaves just like C<coerce>, but if the result is not valid
415 according to C<$constraint>, an error is thrown.
417 =item B<< $constraint->check($value) >>
419 Returns true if the given value passes the constraint for the type.
421 =item B<< $constraint->validate($value) >>
423 This is similar to C<check>. However, if the type I<is valid> then the
424 method returns an explicit C<undef>. If the type is not valid, we call
425 C<< $self->get_message($value) >> internally to generate an error
428 =item B<< $constraint->assert_valid($value) >>
430 Like C<check> and C<validate>, this method checks whether C<$value> is
431 valid under the constraint. If it is, it will return true. If it is not,
432 an exception will be thrown with the results of
433 C<< $self->get_message($value) >>.
435 =item B<< $constraint->name >>
437 Returns the type's name, as provided to the constructor.
439 =item B<< $constraint->parent >>
441 Returns the type's parent, as provided to the constructor, if any.
443 =item B<< $constraint->has_parent >>
445 Returns true if the type has a parent type.
447 =item B<< $constraint->parents >>
449 A synonym for C<parent>. This is useful for polymorphism with types
450 that can have more than one parent.
452 =item B<< $constraint->constraint >>
454 Returns the type's constraint, as provided to the constructor.
456 =item B<< $constraint->get_message($value) >>
458 This generates a method for the given value. If the type does not have
459 an explicit message, we generate a default message.
461 =item B<< $constraint->has_message >>
463 Returns true if the type has a message.
465 =item B<< $constraint->message >>
467 Returns the type's message as a subroutine reference.
469 =item B<< $constraint->coercion >>
471 Returns the type's L<Moose::Meta::TypeCoercion> object, if one
474 =item B<< $constraint->has_coercion >>
476 Returns true if the type has a coercion.
478 =item B<< $constraint->hand_optimized_type_constraint >>
480 Returns the type's hand optimized constraint, as provided to the
481 constructor via the C<optimized> option.
483 =item B<< $constraint->has_hand_optimized_type_constraint >>
485 Returns true if the type has an optimized constraint.
487 =item B<< $constraint->create_child_type(%options) >>
489 This returns a new type constraint of the same class using the
490 provided C<%options>. The C<parent> option will be the current type.
492 This method exists so that subclasses of this class can override this
493 behavior and change how child types are created.
499 See L<Moose/BUGS> for details on reporting bugs.