2 package Moose::Meta::TypeConstraint;
8 use Sub::Name 'subname';
11 our $VERSION = '0.01';
13 __PACKAGE__->meta->add_attribute('name' => (reader => 'name' ));
14 __PACKAGE__->meta->add_attribute('parent' => (reader => 'parent' ));
15 __PACKAGE__->meta->add_attribute('constraint' => (reader => 'constraint'));
16 __PACKAGE__->meta->add_attribute('coercion' => (
17 accessor => 'coercion',
18 predicate => 'has_coercion'
22 __PACKAGE__->meta->add_attribute('compiled_type_constraint' => (
23 accessor => '_compiled_type_constraint'
28 my $self = $class->meta->new_object(@_);
29 $self->compile_type_constraint();
33 sub compile_type_constraint () {
35 my $check = $self->constraint;
37 || confess "Could not compile type constraint '" . $self->name . "' because no constraint check";
38 my $parent = $self->parent;
39 if (defined $parent) {
40 # we have a subtype ...
41 $parent = $parent->_compiled_type_constraint;
42 $self->_compiled_type_constraint(subname $self->name => sub {
44 return undef unless defined $parent->($_[0]) && $check->($_[0]);
50 $self->_compiled_type_constraint(subname $self->name => sub {
52 return undef unless $check->($_[0]);
58 sub check { $_[0]->_compiled_type_constraint->($_[1]) }
68 Moose::Meta::TypeConstraint - The Moose Type Constraint metaobject
94 =item B<compile_type_constraint>
100 All complex software has bugs lurking in it, and this module is no
101 exception. If you find a bug please either email me, or add the bug
106 Stevan Little E<lt>stevan@iinteractive.comE<gt>
108 =head1 COPYRIGHT AND LICENSE
110 Copyright 2006 by Infinity Interactive, Inc.
112 L<http://www.iinteractive.com>
114 This library is free software; you can redistribute it and/or modify
115 it under the same terms as Perl itself.