2 package Moose::Meta::TypeConstraint::Union;
8 use Moose::Meta::TypeCoercion::Union;
10 our $VERSION = '0.59';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Moose::Meta::TypeConstraint';
16 __PACKAGE__->meta->add_attribute('type_constraints' => (
17 accessor => 'type_constraints',
22 my ($class, %options) = @_;
23 my $self = $class->SUPER::new(
24 name => (join '|' => sort {$a cmp $b}
25 map { $_->name } @{$options{type_constraints}}),
28 hand_optimized_type_constraint => undef,
29 compiled_type_constraint => sub {
31 foreach my $type (@{$options{type_constraints}}) {
32 return 1 if $type->check($value);
38 $self->_set_constraint(sub { $self->check($_[0]) });
39 $self->coercion(Moose::Meta::TypeCoercion::Union->new(
40 type_constraint => $self
46 my ( $self, $type_or_name ) = @_;
48 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
50 return unless $other->isa(__PACKAGE__);
52 my @self_constraints = @{ $self->type_constraints };
53 my @other_constraints = @{ $other->type_constraints };
55 return unless @self_constraints == @other_constraints;
57 # FIXME presort type constraints for efficiency?
58 constraint: foreach my $constraint ( @self_constraints ) {
59 for ( my $i = 0; $i < @other_constraints; $i++ ) {
60 if ( $constraint->equals($other_constraints[$i]) ) {
61 splice @other_constraints, $i, 1;
67 return @other_constraints == 0;
72 $self->type_constraints;
76 my ($self, $value) = @_;
78 foreach my $type (@{$self->type_constraints}) {
79 my $err = $type->validate($value);
80 return unless defined $err;
81 $message .= ($message ? ' and ' : '') . $err
84 return ($message . ' in (' . $self->name . ')') ;
88 my ($self, $type_name) = @_;
89 foreach my $type (@{$self->type_constraints}) {
90 return 1 if $type->is_a_type_of($type_name);
96 my ($self, $type_name) = @_;
97 foreach my $type (@{$self->type_constraints}) {
98 return 1 if $type->is_subtype_of($type_name);
103 sub create_child_type {
104 my ($self, %opts) = @_;
105 my $class = ref $self;
106 my $constraint = Moose::Meta::TypeConstraint->new(%opts, parent => $self);
108 # if we have a type constraint union, and no
109 # type check, this means we are just aliasing
110 # the union constraint, which means we need to
111 # handle this differently.
114 not(defined $opts{constraint})
115 && $self->has_coercion
117 $constraint->coercion(Moose::Meta::TypeCoercion::Union->new(
118 type_constraint => $self,
133 Moose::Meta::TypeConstraint::Union - A union of Moose type constraints
137 This metaclass represents a union of Moose type constraints. More
138 details to be explained later (possibly in a Cookbook recipe).
140 This actually used to be part of Moose::Meta::TypeConstraint, but it
141 is now better off in it's own file.
145 This class is not a subclass of Moose::Meta::TypeConstraint,
146 but it does provide the same API
156 =item B<type_constraints>
162 =item B<includes_type>
168 =head2 Overriden methods
178 =item B<is_a_type_of>
180 =item B<is_subtype_of>
184 =head2 Empty or Stub methods
186 These methods tend to not be very relevant in
187 the context of a union. Either that or they are
188 just difficult to specify and not very useful
189 anyway. They are here for completeness.
197 =item B<has_coercion>
203 =item B<hand_optimized_type_constraint>
205 =item B<has_hand_optimized_type_constraint>
207 =item B<create_child_type>
213 All complex software has bugs lurking in it, and this module is no
214 exception. If you find a bug please either email me, or add the bug
219 Stevan Little E<lt>stevan@iinteractive.comE<gt>
221 =head1 COPYRIGHT AND LICENSE
223 Copyright 2006-2008 by Infinity Interactive, Inc.
225 L<http://www.iinteractive.com>
227 This library is free software; you can redistribute it and/or modify
228 it under the same terms as Perl itself.