File | /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Union.pm |
Statements Executed | 23 |
Total Time | 0.0012873 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:123] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:20] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:34] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:74] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | _actually_compile_type_constraint | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | coercion | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | create_child_type | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | equals | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | find_type_for | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | has_coercion | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | is_a_type_of | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | is_subtype_of | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | new | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | parents | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | validate | Moose::Meta::TypeConstraint::Union::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Moose::Meta::TypeConstraint::Union; | |||
3 | ||||
4 | 3 | 22µs | 7µs | use strict; # spent 7µs making 1 call to strict::import |
5 | 3 | 26µs | 9µs | use warnings; # spent 23µs making 1 call to warnings::import |
6 | 3 | 51µs | 17µs | use metaclass; # spent 791µs making 1 call to metaclass::import |
7 | ||||
8 | 3 | 134µs | 45µs | use Moose::Meta::TypeCoercion::Union; # spent 9µs making 1 call to import |
9 | ||||
10 | 3 | 62µs | 21µs | use List::Util qw(first); # spent 42µs making 1 call to Exporter::import |
11 | ||||
12 | 1 | 700ns | 700ns | our $VERSION = '1.15'; |
13 | 1 | 21µs | 21µs | $VERSION = eval $VERSION; |
14 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
15 | ||||
16 | 3 | 935µs | 312µs | use base 'Moose::Meta::TypeConstraint'; # spent 88µs making 1 call to base::import |
17 | ||||
18 | __PACKAGE__->meta->add_attribute('type_constraints' => ( | |||
19 | accessor => 'type_constraints', | |||
20 | default => sub { [] } | |||
21 | 1 | 25µs | 25µs | )); # spent 597µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
# spent 35µs making 1 call to Moose::Meta::TypeConstraint::Union::meta |
22 | ||||
23 | sub new { | |||
24 | my ($class, %options) = @_; | |||
25 | ||||
26 | my $name = join '|' => sort { $a cmp $b } | |||
27 | map { $_->name } @{ $options{type_constraints} }; | |||
28 | ||||
29 | my $self = $class->SUPER::new( | |||
30 | name => $name, | |||
31 | %options, | |||
32 | ); | |||
33 | ||||
34 | $self->_set_constraint(sub { $self->check($_[0]) }); | |||
35 | ||||
36 | return $self; | |||
37 | } | |||
38 | ||||
39 | # XXX - this is a rather gross implementation of laziness for the benefit of | |||
40 | # MX::Types. If we try to call ->has_coercion on the objects during object | |||
41 | # construction, this does not work when defining a recursive constraint with | |||
42 | # MX::Types. | |||
43 | sub coercion { | |||
44 | my $self = shift; | |||
45 | ||||
46 | return $self->{coercion} if exists $self->{coercion}; | |||
47 | ||||
48 | # Using any instead of grep here causes a weird error with some corner | |||
49 | # cases when MX::Types is in use. See RT #61001. | |||
50 | if ( grep { $_->has_coercion } @{ $self->type_constraints } ) { | |||
51 | return $self->{coercion} = Moose::Meta::TypeCoercion::Union->new( | |||
52 | type_constraint => $self ); | |||
53 | } | |||
54 | else { | |||
55 | return $self->{coercion} = undef; | |||
56 | } | |||
57 | } | |||
58 | ||||
59 | sub has_coercion { | |||
60 | return defined $_[0]->coercion; | |||
61 | } | |||
62 | ||||
63 | sub _actually_compile_type_constraint { | |||
64 | my $self = shift; | |||
65 | ||||
66 | my @constraints = @{ $self->type_constraints }; | |||
67 | ||||
68 | return sub { | |||
69 | my $value = shift; | |||
70 | foreach my $type (@constraints) { | |||
71 | return 1 if $type->check($value); | |||
72 | } | |||
73 | return undef; | |||
74 | }; | |||
75 | } | |||
76 | ||||
77 | ||||
78 | sub equals { | |||
79 | my ( $self, $type_or_name ) = @_; | |||
80 | ||||
81 | my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); | |||
82 | ||||
83 | return unless $other->isa(__PACKAGE__); | |||
84 | ||||
85 | my @self_constraints = @{ $self->type_constraints }; | |||
86 | my @other_constraints = @{ $other->type_constraints }; | |||
87 | ||||
88 | return unless @self_constraints == @other_constraints; | |||
89 | ||||
90 | # FIXME presort type constraints for efficiency? | |||
91 | constraint: foreach my $constraint ( @self_constraints ) { | |||
92 | for ( my $i = 0; $i < @other_constraints; $i++ ) { | |||
93 | if ( $constraint->equals($other_constraints[$i]) ) { | |||
94 | splice @other_constraints, $i, 1; | |||
95 | next constraint; | |||
96 | } | |||
97 | } | |||
98 | } | |||
99 | ||||
100 | return @other_constraints == 0; | |||
101 | } | |||
102 | ||||
103 | sub parents { | |||
104 | my $self = shift; | |||
105 | $self->type_constraints; | |||
106 | } | |||
107 | ||||
108 | sub validate { | |||
109 | my ($self, $value) = @_; | |||
110 | my $message; | |||
111 | foreach my $type (@{$self->type_constraints}) { | |||
112 | my $err = $type->validate($value); | |||
113 | return unless defined $err; | |||
114 | $message .= ($message ? ' and ' : '') . $err | |||
115 | if defined $err; | |||
116 | } | |||
117 | return ($message . ' in (' . $self->name . ')') ; | |||
118 | } | |||
119 | ||||
120 | sub find_type_for { | |||
121 | my ($self, $value) = @_; | |||
122 | ||||
123 | return first { $_->check($value) } @{ $self->type_constraints }; | |||
124 | } | |||
125 | ||||
126 | sub is_a_type_of { | |||
127 | my ($self, $type_name) = @_; | |||
128 | foreach my $type (@{$self->type_constraints}) { | |||
129 | return 1 if $type->is_a_type_of($type_name); | |||
130 | } | |||
131 | return 0; | |||
132 | } | |||
133 | ||||
134 | sub is_subtype_of { | |||
135 | my ($self, $type_name) = @_; | |||
136 | foreach my $type (@{$self->type_constraints}) { | |||
137 | return 1 if $type->is_subtype_of($type_name); | |||
138 | } | |||
139 | return 0; | |||
140 | } | |||
141 | ||||
142 | sub create_child_type { | |||
143 | my ( $self, %opts ) = @_; | |||
144 | ||||
145 | my $constraint | |||
146 | = Moose::Meta::TypeConstraint->new( %opts, parent => $self ); | |||
147 | ||||
148 | # if we have a type constraint union, and no | |||
149 | # type check, this means we are just aliasing | |||
150 | # the union constraint, which means we need to | |||
151 | # handle this differently. | |||
152 | # - SL | |||
153 | if ( not( defined $opts{constraint} ) | |||
154 | && $self->has_coercion ) { | |||
155 | $constraint->coercion( | |||
156 | Moose::Meta::TypeCoercion::Union->new( | |||
157 | type_constraint => $self, | |||
158 | ) | |||
159 | ); | |||
160 | } | |||
161 | ||||
162 | return $constraint; | |||
163 | } | |||
164 | ||||
165 | 1 | 10µs | 10µs | 1; |
166 | ||||
167 | __END__ | |||
168 | ||||
169 | =pod | |||
170 | ||||
171 | =head1 NAME | |||
172 | ||||
173 | Moose::Meta::TypeConstraint::Union - A union of Moose type constraints | |||
174 | ||||
175 | =head1 DESCRIPTION | |||
176 | ||||
177 | This metaclass represents a union of type constraints. A union takes | |||
178 | multiple type constraints, and is true if any one of its member | |||
179 | constraints is true. | |||
180 | ||||
181 | =head1 INHERITANCE | |||
182 | ||||
183 | C<Moose::Meta::TypeConstraint::Union> is a subclass of | |||
184 | L<Moose::Meta::TypeConstraint>. | |||
185 | ||||
186 | =over 4 | |||
187 | ||||
188 | =item B<< Moose::Meta::TypeConstraint::Union->new(%options) >> | |||
189 | ||||
190 | This creates a new class type constraint based on the given | |||
191 | C<%options>. | |||
192 | ||||
193 | It takes the same options as its parent. It also requires an | |||
194 | additional option, C<type_constraints>. This is an array reference | |||
195 | containing the L<Moose::Meta::TypeConstraint> objects that are the | |||
196 | members of the union type. The C<name> option defaults to the names | |||
197 | all of these member types sorted and then joined by a pipe (|). | |||
198 | ||||
199 | The constructor sets the implementation of the constraint so that is | |||
200 | simply calls C<check> on the newly created object. | |||
201 | ||||
202 | Finally, the constructor also makes sure that the object's C<coercion> | |||
203 | attribute is a L<Moose::Meta::TypeCoercion::Union> object. | |||
204 | ||||
205 | =item B<< $constraint->type_constraints >> | |||
206 | ||||
207 | This returns the array reference of C<type_constraints> provided to | |||
208 | the constructor. | |||
209 | ||||
210 | =item B<< $constraint->parents >> | |||
211 | ||||
212 | This returns the same constraint as the C<type_constraints> method. | |||
213 | ||||
214 | =item B<< $constraint->check($value) >> | |||
215 | ||||
216 | =item B<< $constraint->validate($value) >> | |||
217 | ||||
218 | These two methods simply call the relevant method on each of the | |||
219 | member type constraints in the union. If any type accepts the value, | |||
220 | the value is valid. | |||
221 | ||||
222 | With C<validate> the error message returned includes all of the error | |||
223 | messages returned by the member type constraints. | |||
224 | ||||
225 | =item B<< $constraint->equals($type_name_or_object) >> | |||
226 | ||||
227 | A type is considered equal if it is also a union type, and the two | |||
228 | unions have the same member types. | |||
229 | ||||
230 | =item B<< $constraint->find_type_for($value) >> | |||
231 | ||||
232 | This returns the first member type constraint for which C<check($value)> is | |||
233 | true, allowing you to determine which of the Union's member type constraints | |||
234 | a given value matches. | |||
235 | ||||
236 | =item B<< $constraint->is_a_type_of($type_name_or_object) >> | |||
237 | ||||
238 | This returns true if any of the member type constraints return true | |||
239 | for the C<is_a_type_of> method. | |||
240 | ||||
241 | =item B<< $constraint->is_subtype_of >> | |||
242 | ||||
243 | This returns true if any of the member type constraints return true | |||
244 | for the C<is_a_subtype_of> method. | |||
245 | ||||
246 | =item B<< $constraint->create_child_type(%options) >> | |||
247 | ||||
248 | This returns a new L<Moose::Meta::TypeConstraint> object with the type | |||
249 | as its parent. | |||
250 | ||||
251 | =back | |||
252 | ||||
253 | =head1 BUGS | |||
254 | ||||
255 | See L<Moose/BUGS> for details on reporting bugs. | |||
256 | ||||
257 | =head1 AUTHOR | |||
258 | ||||
259 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
260 | ||||
261 | =head1 COPYRIGHT AND LICENSE | |||
262 | ||||
263 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
264 | ||||
265 | L<http://www.iinteractive.com> | |||
266 | ||||
267 | This library is free software; you can redistribute it and/or modify | |||
268 | it under the same terms as Perl itself. | |||
269 | ||||
270 | =cut |