Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/x86_64-linux/Moose/Meta/TypeConstraint/Union.pm |
Statements | Executed 26 statements in 1.08ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 383µs | 1.07ms | BEGIN@14 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 9µs | 33µs | BEGIN@16 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 8µs | 8µs | BEGIN@3 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 8µs | 632µs | BEGIN@12 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 8µs | 15µs | BEGIN@11 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 7µs | 26µs | BEGIN@17 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 7µs | 9µs | BEGIN@10 | Moose::Meta::TypeConstraint::Union::
1 | 1 | 1 | 6µs | 56µs | BEGIN@19 | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:143] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:164] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:170] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:176] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:23] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:38] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | __ANON__[:78] | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | _actually_compile_type_constraint | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | _inline_check | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | can_be_inlined | 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 | inline_environment | 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 | parent | Moose::Meta::TypeConstraint::Union::
0 | 0 | 0 | 0s | 0s | validate | Moose::Meta::TypeConstraint::Union::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | |||||
2 | package Moose::Meta::TypeConstraint::Union; | ||||
3 | # spent 8µs within Moose::Meta::TypeConstraint::Union::BEGIN@3 which was called:
# once (8µs+0s) by Moose::Util::TypeConstraints::BEGIN@33 at line 5 | ||||
4 | 1 | 8µs | $Moose::Meta::TypeConstraint::Union::AUTHORITY = 'cpan:STEVAN'; | ||
5 | 1 | 23µs | 1 | 8µs | } # spent 8µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@3 |
6 | { | ||||
7 | 2 | 1µs | $Moose::Meta::TypeConstraint::Union::VERSION = '2.0602'; | ||
8 | } | ||||
9 | |||||
10 | 3 | 20µs | 2 | 11µs | # spent 9µs (7+2) within Moose::Meta::TypeConstraint::Union::BEGIN@10 which was called:
# once (7µs+2µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 10 # spent 9µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@10
# spent 2µs making 1 call to strict::import |
11 | 3 | 16µs | 2 | 23µs | # spent 15µs (8+7) within Moose::Meta::TypeConstraint::Union::BEGIN@11 which was called:
# once (8µs+7µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 11 # spent 15µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@11
# spent 8µs making 1 call to warnings::import |
12 | 3 | 29µs | 2 | 1.26ms | # spent 632µs (8+624) within Moose::Meta::TypeConstraint::Union::BEGIN@12 which was called:
# once (8µs+624µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 12 # spent 632µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@12
# spent 624µs making 1 call to metaclass::import |
13 | |||||
14 | 3 | 123µs | 1 | 1.07ms | # spent 1.07ms (383µs+684µs) within Moose::Meta::TypeConstraint::Union::BEGIN@14 which was called:
# once (383µs+684µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 14 # spent 1.07ms making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@14 |
15 | |||||
16 | 3 | 20µs | 2 | 58µs | # spent 33µs (9+25) within Moose::Meta::TypeConstraint::Union::BEGIN@16 which was called:
# once (9µs+25µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 16 # spent 33µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@16
# spent 25µs making 1 call to Exporter::import |
17 | 3 | 20µs | 2 | 44µs | # spent 26µs (7+19) within Moose::Meta::TypeConstraint::Union::BEGIN@17 which was called:
# once (7µs+19µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 17 # spent 26µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@17
# spent 19µs making 1 call to Exporter::import |
18 | |||||
19 | 3 | 809µs | 2 | 107µs | # spent 56µs (6+51) within Moose::Meta::TypeConstraint::Union::BEGIN@19 which was called:
# once (6µs+51µs) by Moose::Util::TypeConstraints::BEGIN@33 at line 19 # spent 56µs making 1 call to Moose::Meta::TypeConstraint::Union::BEGIN@19
# spent 51µs making 1 call to base::import |
20 | |||||
21 | __PACKAGE__->meta->add_attribute('type_constraints' => ( | ||||
22 | accessor => 'type_constraints', | ||||
23 | default => sub { [] }, | ||||
24 | 1 | 8µs | 3 | 520µs | Class::MOP::_definition_context(), # spent 485µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
# spent 25µs making 1 call to Moose::Meta::TypeConstraint::Union::meta
# spent 10µs making 1 call to Class::MOP::_definition_context |
25 | )); | ||||
26 | |||||
27 | sub new { | ||||
28 | my ($class, %options) = @_; | ||||
29 | |||||
30 | my $name = join '|' => sort { $a cmp $b } | ||||
31 | map { $_->name } @{ $options{type_constraints} }; | ||||
32 | |||||
33 | my $self = $class->SUPER::new( | ||||
34 | name => $name, | ||||
35 | %options, | ||||
36 | ); | ||||
37 | |||||
38 | $self->_set_constraint(sub { $self->check($_[0]) }); | ||||
39 | |||||
40 | return $self; | ||||
41 | } | ||||
42 | |||||
43 | # XXX - this is a rather gross implementation of laziness for the benefit of | ||||
44 | # MX::Types. If we try to call ->has_coercion on the objects during object | ||||
45 | # construction, this does not work when defining a recursive constraint with | ||||
46 | # MX::Types. | ||||
47 | sub coercion { | ||||
48 | my $self = shift; | ||||
49 | |||||
50 | return $self->{coercion} if exists $self->{coercion}; | ||||
51 | |||||
52 | # Using any instead of grep here causes a weird error with some corner | ||||
53 | # cases when MX::Types is in use. See RT #61001. | ||||
54 | if ( grep { $_->has_coercion } @{ $self->type_constraints } ) { | ||||
55 | return $self->{coercion} = Moose::Meta::TypeCoercion::Union->new( | ||||
56 | type_constraint => $self ); | ||||
57 | } | ||||
58 | else { | ||||
59 | return $self->{coercion} = undef; | ||||
60 | } | ||||
61 | } | ||||
62 | |||||
63 | sub has_coercion { | ||||
64 | return defined $_[0]->coercion; | ||||
65 | } | ||||
66 | |||||
67 | sub _actually_compile_type_constraint { | ||||
68 | my $self = shift; | ||||
69 | |||||
70 | my @constraints = @{ $self->type_constraints }; | ||||
71 | |||||
72 | return sub { | ||||
73 | my $value = shift; | ||||
74 | foreach my $type (@constraints) { | ||||
75 | return 1 if $type->check($value); | ||||
76 | } | ||||
77 | return undef; | ||||
78 | }; | ||||
79 | } | ||||
80 | |||||
81 | sub can_be_inlined { | ||||
82 | my $self = shift; | ||||
83 | |||||
84 | # This was originally done with all() from List::MoreUtils, but that | ||||
85 | # caused some sort of bizarro parsing failure under 5.10. | ||||
86 | for my $tc ( @{ $self->type_constraints } ) { | ||||
87 | return 0 unless $tc->can_be_inlined; | ||||
88 | } | ||||
89 | |||||
90 | return 1; | ||||
91 | } | ||||
92 | |||||
93 | sub _inline_check { | ||||
94 | my $self = shift; | ||||
95 | my $val = shift; | ||||
96 | |||||
97 | return '(' | ||||
98 | . ( | ||||
99 | join ' || ', map { '(' . $_->_inline_check($val) . ')' } | ||||
100 | @{ $self->type_constraints } | ||||
101 | ) | ||||
102 | . ')'; | ||||
103 | } | ||||
104 | |||||
105 | sub inline_environment { | ||||
106 | my $self = shift; | ||||
107 | |||||
108 | return { map { %{ $_->inline_environment } } | ||||
109 | @{ $self->type_constraints } }; | ||||
110 | } | ||||
111 | |||||
112 | sub equals { | ||||
113 | my ( $self, $type_or_name ) = @_; | ||||
114 | |||||
115 | my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name); | ||||
116 | |||||
117 | return unless $other->isa(__PACKAGE__); | ||||
118 | |||||
119 | my @self_constraints = @{ $self->type_constraints }; | ||||
120 | my @other_constraints = @{ $other->type_constraints }; | ||||
121 | |||||
122 | return unless @self_constraints == @other_constraints; | ||||
123 | |||||
124 | # FIXME presort type constraints for efficiency? | ||||
125 | constraint: foreach my $constraint ( @self_constraints ) { | ||||
126 | for ( my $i = 0; $i < @other_constraints; $i++ ) { | ||||
127 | if ( $constraint->equals($other_constraints[$i]) ) { | ||||
128 | splice @other_constraints, $i, 1; | ||||
129 | next constraint; | ||||
130 | } | ||||
131 | } | ||||
132 | } | ||||
133 | |||||
134 | return @other_constraints == 0; | ||||
135 | } | ||||
136 | |||||
137 | sub parent { | ||||
138 | my $self = shift; | ||||
139 | |||||
140 | my ($first, @rest) = @{ $self->type_constraints }; | ||||
141 | |||||
142 | for my $parent ( $first->_collect_all_parents ) { | ||||
143 | return $parent if all { $_->is_a_type_of($parent) } @rest; | ||||
144 | } | ||||
145 | |||||
146 | return; | ||||
147 | } | ||||
148 | |||||
149 | sub validate { | ||||
150 | my ($self, $value) = @_; | ||||
151 | my $message; | ||||
152 | foreach my $type (@{$self->type_constraints}) { | ||||
153 | my $err = $type->validate($value); | ||||
154 | return unless defined $err; | ||||
155 | $message .= ($message ? ' and ' : '') . $err | ||||
156 | if defined $err; | ||||
157 | } | ||||
158 | return ($message . ' in (' . $self->name . ')') ; | ||||
159 | } | ||||
160 | |||||
161 | sub find_type_for { | ||||
162 | my ($self, $value) = @_; | ||||
163 | |||||
164 | return first { $_->check($value) } @{ $self->type_constraints }; | ||||
165 | } | ||||
166 | |||||
167 | sub is_a_type_of { | ||||
168 | my ($self, $type_name) = @_; | ||||
169 | |||||
170 | return all { $_->is_a_type_of($type_name) } @{ $self->type_constraints }; | ||||
171 | } | ||||
172 | |||||
173 | sub is_subtype_of { | ||||
174 | my ($self, $type_name) = @_; | ||||
175 | |||||
176 | return all { $_->is_subtype_of($type_name) } @{ $self->type_constraints }; | ||||
177 | } | ||||
178 | |||||
179 | sub create_child_type { | ||||
180 | my ( $self, %opts ) = @_; | ||||
181 | |||||
182 | my $constraint | ||||
183 | = Moose::Meta::TypeConstraint->new( %opts, parent => $self ); | ||||
184 | |||||
185 | # if we have a type constraint union, and no | ||||
186 | # type check, this means we are just aliasing | ||||
187 | # the union constraint, which means we need to | ||||
188 | # handle this differently. | ||||
189 | # - SL | ||||
190 | if ( not( defined $opts{constraint} ) | ||||
191 | && $self->has_coercion ) { | ||||
192 | $constraint->coercion( | ||||
193 | Moose::Meta::TypeCoercion::Union->new( | ||||
194 | type_constraint => $self, | ||||
195 | ) | ||||
196 | ); | ||||
197 | } | ||||
198 | |||||
199 | return $constraint; | ||||
200 | } | ||||
201 | |||||
202 | 1 | 7µs | 1; | ||
203 | |||||
204 | # ABSTRACT: A union of Moose type constraints | ||||
205 | |||||
- - | |||||
208 | =pod | ||||
209 | |||||
210 | =head1 NAME | ||||
211 | |||||
212 | Moose::Meta::TypeConstraint::Union - A union of Moose type constraints | ||||
213 | |||||
214 | =head1 VERSION | ||||
215 | |||||
216 | version 2.0602 | ||||
217 | |||||
218 | =head1 DESCRIPTION | ||||
219 | |||||
220 | This metaclass represents a union of type constraints. A union takes | ||||
221 | multiple type constraints, and is true if any one of its member | ||||
222 | constraints is true. | ||||
223 | |||||
224 | =head1 INHERITANCE | ||||
225 | |||||
226 | C<Moose::Meta::TypeConstraint::Union> is a subclass of | ||||
227 | L<Moose::Meta::TypeConstraint>. | ||||
228 | |||||
229 | =over 4 | ||||
230 | |||||
231 | =item B<< Moose::Meta::TypeConstraint::Union->new(%options) >> | ||||
232 | |||||
233 | This creates a new class type constraint based on the given | ||||
234 | C<%options>. | ||||
235 | |||||
236 | It takes the same options as its parent. It also requires an | ||||
237 | additional option, C<type_constraints>. This is an array reference | ||||
238 | containing the L<Moose::Meta::TypeConstraint> objects that are the | ||||
239 | members of the union type. The C<name> option defaults to the names | ||||
240 | all of these member types sorted and then joined by a pipe (|). | ||||
241 | |||||
242 | The constructor sets the implementation of the constraint so that is | ||||
243 | simply calls C<check> on the newly created object. | ||||
244 | |||||
245 | Finally, the constructor also makes sure that the object's C<coercion> | ||||
246 | attribute is a L<Moose::Meta::TypeCoercion::Union> object. | ||||
247 | |||||
248 | =item B<< $constraint->type_constraints >> | ||||
249 | |||||
250 | This returns the array reference of C<type_constraints> provided to | ||||
251 | the constructor. | ||||
252 | |||||
253 | =item B<< $constraint->parent >> | ||||
254 | |||||
255 | This returns the nearest common ancestor of all the components of the union. | ||||
256 | |||||
257 | =item B<< $constraint->check($value) >> | ||||
258 | |||||
259 | =item B<< $constraint->validate($value) >> | ||||
260 | |||||
261 | These two methods simply call the relevant method on each of the | ||||
262 | member type constraints in the union. If any type accepts the value, | ||||
263 | the value is valid. | ||||
264 | |||||
265 | With C<validate> the error message returned includes all of the error | ||||
266 | messages returned by the member type constraints. | ||||
267 | |||||
268 | =item B<< $constraint->equals($type_name_or_object) >> | ||||
269 | |||||
270 | A type is considered equal if it is also a union type, and the two | ||||
271 | unions have the same member types. | ||||
272 | |||||
273 | =item B<< $constraint->find_type_for($value) >> | ||||
274 | |||||
275 | This returns the first member type constraint for which C<check($value)> is | ||||
276 | true, allowing you to determine which of the Union's member type constraints | ||||
277 | a given value matches. | ||||
278 | |||||
279 | =item B<< $constraint->is_a_type_of($type_name_or_object) >> | ||||
280 | |||||
281 | This returns true if all of the member type constraints return true | ||||
282 | for the C<is_a_type_of> method. | ||||
283 | |||||
284 | =item B<< $constraint->is_subtype_of >> | ||||
285 | |||||
286 | This returns true if all of the member type constraints return true | ||||
287 | for the C<is_a_subtype_of> method. | ||||
288 | |||||
289 | =item B<< $constraint->create_child_type(%options) >> | ||||
290 | |||||
291 | This returns a new L<Moose::Meta::TypeConstraint> object with the type | ||||
292 | as its parent. | ||||
293 | |||||
294 | =back | ||||
295 | |||||
296 | =head1 BUGS | ||||
297 | |||||
298 | See L<Moose/BUGS> for details on reporting bugs. | ||||
299 | |||||
300 | =head1 AUTHOR | ||||
301 | |||||
302 | Moose is maintained by the Moose Cabal, along with the help of many contributors. See L<Moose/CABAL> and L<Moose/CONTRIBUTORS> for details. | ||||
303 | |||||
304 | =head1 COPYRIGHT AND LICENSE | ||||
305 | |||||
306 | This software is copyright (c) 2012 by Infinity Interactive, Inc.. | ||||
307 | |||||
308 | This is free software; you can redistribute it and/or modify it under | ||||
309 | the same terms as the Perl 5 programming language system itself. | ||||
310 | |||||
311 | =cut | ||||
312 | |||||
313 | |||||
314 | __END__ |