Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Type/Utils.pm |
Statements | Executed 38 statements in 3.47ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 20µs | 20µs | BEGIN@3 | Type::Utils::
1 | 1 | 1 | 13µs | 29µs | BEGIN@172 | Type::Utils::
1 | 1 | 1 | 12µs | 23µs | BEGIN@189 | Type::Utils::
1 | 1 | 1 | 12µs | 27µs | BEGIN@219 | Type::Utils::
1 | 1 | 1 | 11µs | 22µs | BEGIN@204 | Type::Utils::
1 | 1 | 1 | 11µs | 22µs | BEGIN@249 | Type::Utils::
1 | 1 | 1 | 11µs | 22µs | BEGIN@234 | Type::Utils::
1 | 1 | 1 | 10µs | 43µs | BEGIN@14 | Type::Utils::
1 | 1 | 1 | 9µs | 14µs | BEGIN@5 | Type::Utils::
1 | 1 | 1 | 9µs | 348µs | BEGIN@17 | Type::Utils::
1 | 1 | 1 | 8µs | 115µs | BEGIN@15 | Type::Utils::
1 | 1 | 1 | 8µs | 24µs | BEGIN@4 | Type::Utils::
1 | 1 | 1 | 5µs | 5µs | BEGIN@16 | Type::Utils::
1 | 1 | 1 | 5µs | 5µs | BEGIN@7 | Type::Utils::
0 | 0 | 0 | 0s | 0s | simple_lookup | Type::Registry::DWIM::
0 | 0 | 0 | 0s | 0s | _croak | Type::Utils::
0 | 0 | 0 | 0s | 0s | as | Type::Utils::
0 | 0 | 0 | 0s | 0s | class_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | coerce | Type::Utils::
0 | 0 | 0 | 0s | 0s | compile_match_on_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | declare | Type::Utils::
0 | 0 | 0 | 0s | 0s | declare_coercion | Type::Utils::
0 | 0 | 0 | 0s | 0s | duck_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | dwim_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | english_list | Type::Utils::
0 | 0 | 0 | 0s | 0s | enum | Type::Utils::
0 | 0 | 0 | 0s | 0s | extends | Type::Utils::
0 | 0 | 0 | 0s | 0s | from | Type::Utils::
0 | 0 | 0 | 0s | 0s | inline_as | Type::Utils::
0 | 0 | 0 | 0s | 0s | intersection | Type::Utils::
0 | 0 | 0 | 0s | 0s | match_on_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | message | Type::Utils::
0 | 0 | 0 | 0s | 0s | role_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | to_type | Type::Utils::
0 | 0 | 0 | 0s | 0s | union | Type::Utils::
0 | 0 | 0 | 0s | 0s | via | Type::Utils::
0 | 0 | 0 | 0s | 0s | where | Type::Utils::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Type::Utils; | ||||
2 | |||||
3 | 2 | 58µs | 1 | 20µs | # spent 20µs within Type::Utils::BEGIN@3 which was called:
# once (20µs+0s) by Typed::BEGIN@11 at line 3 # spent 20µs making 1 call to Type::Utils::BEGIN@3 |
4 | 2 | 30µs | 2 | 41µs | # spent 24µs (8+16) within Type::Utils::BEGIN@4 which was called:
# once (8µs+16µs) by Typed::BEGIN@11 at line 4 # spent 24µs making 1 call to Type::Utils::BEGIN@4
# spent 16µs making 1 call to strict::import |
5 | 2 | 46µs | 2 | 20µs | # spent 14µs (9+5) within Type::Utils::BEGIN@5 which was called:
# once (9µs+5µs) by Typed::BEGIN@11 at line 5 # spent 14µs making 1 call to Type::Utils::BEGIN@5
# spent 5µs making 1 call to warnings::import |
6 | |||||
7 | # spent 5µs within Type::Utils::BEGIN@7 which was called:
# once (5µs+0s) by Typed::BEGIN@11 at line 10 | ||||
8 | 1 | 500ns | $Type::Utils::AUTHORITY = 'cpan:TOBYINK'; | ||
9 | 1 | 5µs | $Type::Utils::VERSION = '0.038'; | ||
10 | 1 | 60µs | 1 | 5µs | } # spent 5µs making 1 call to Type::Utils::BEGIN@7 |
11 | |||||
12 | sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } | ||||
13 | |||||
14 | 2 | 32µs | 2 | 75µs | # spent 43µs (10+33) within Type::Utils::BEGIN@14 which was called:
# once (10µs+33µs) by Typed::BEGIN@11 at line 14 # spent 43µs making 1 call to Type::Utils::BEGIN@14
# spent 33µs making 1 call to Exporter::import |
15 | 2 | 34µs | 2 | 222µs | # spent 115µs (8+106) within Type::Utils::BEGIN@15 which was called:
# once (8µs+106µs) by Typed::BEGIN@11 at line 15 # spent 115µs making 1 call to Type::Utils::BEGIN@15
# spent 106µs making 1 call to Exporter::Tiny::import |
16 | 2 | 34µs | 1 | 5µs | # spent 5µs within Type::Utils::BEGIN@16 which was called:
# once (5µs+0s) by Typed::BEGIN@11 at line 16 # spent 5µs making 1 call to Type::Utils::BEGIN@16 |
17 | 2 | 805µs | 2 | 687µs | # spent 348µs (9+339) within Type::Utils::BEGIN@17 which was called:
# once (9µs+339µs) by Typed::BEGIN@11 at line 17 # spent 348µs making 1 call to Type::Utils::BEGIN@17
# spent 339µs making 1 call to Exporter::Tiny::import |
18 | |||||
19 | 1 | 4µs | our @EXPORT = qw< | ||
20 | declare as where message inline_as | ||||
21 | class_type role_type duck_type union intersection enum | ||||
22 | coerce from via | ||||
23 | declare_coercion to_type | ||||
24 | >; | ||||
25 | 1 | 4µs | our @EXPORT_OK = ( | ||
26 | @EXPORT, | ||||
27 | qw< | ||||
28 | extends type subtype | ||||
29 | match_on_type compile_match_on_type | ||||
30 | dwim_type english_list | ||||
31 | >, | ||||
32 | ); | ||||
33 | |||||
34 | 1 | 600ns | require Exporter::Tiny; | ||
35 | 1 | 10µs | our @ISA = 'Exporter::Tiny'; | ||
36 | |||||
37 | sub extends | ||||
38 | { | ||||
39 | _croak "Not a type library" unless caller->isa("Type::Library"); | ||||
40 | my $caller = caller->meta; | ||||
41 | |||||
42 | foreach my $lib (@_) | ||||
43 | { | ||||
44 | eval "use $lib; 1" or _croak "Could not load library '$lib': $@"; | ||||
45 | |||||
46 | if ($lib->isa("Type::Library") or $lib eq 'Types::TypeTiny') | ||||
47 | { | ||||
48 | $caller->add_type( $lib->get_type($_) ) | ||||
49 | for sort $lib->meta->type_names; | ||||
50 | $caller->add_coercion( $lib->get_coercion($_) ) | ||||
51 | for sort $lib->meta->coercion_names; | ||||
52 | } | ||||
53 | elsif ($lib->isa('MooseX::Types::Base')) | ||||
54 | { | ||||
55 | require Moose::Util::TypeConstraints; | ||||
56 | my $types = $lib->type_storage; | ||||
57 | for my $name (sort keys %$types) | ||||
58 | { | ||||
59 | my $moose = Moose::Util::TypeConstraints::find_type_constraint($types->{$name}); | ||||
60 | my $tt = Types::TypeTiny::to_TypeTiny($moose); | ||||
61 | $caller->add_type( | ||||
62 | $tt->create_child_type(library => $caller, name => $name, coercion => $moose->has_coercion ? 1 : 0) | ||||
63 | ); | ||||
64 | } | ||||
65 | } | ||||
66 | elsif ($lib->isa('MouseX::Types::Base')) | ||||
67 | { | ||||
68 | require Mouse::Util::TypeConstraints; | ||||
69 | my $types = $lib->type_storage; | ||||
70 | for my $name (sort keys %$types) | ||||
71 | { | ||||
72 | my $mouse = Mouse::Util::TypeConstraints::find_type_constraint($types->{$name}); | ||||
73 | my $tt = Types::TypeTiny::to_TypeTiny($mouse); | ||||
74 | $caller->add_type( | ||||
75 | $tt->create_child_type(library => $caller, name => $name, coercion => $mouse->has_coercion ? 1 : 0) | ||||
76 | ); | ||||
77 | } | ||||
78 | } | ||||
79 | else | ||||
80 | { | ||||
81 | _croak("'$lib' is not a type constraint library"); | ||||
82 | } | ||||
83 | } | ||||
84 | } | ||||
85 | |||||
86 | sub declare | ||||
87 | { | ||||
88 | my %opts; | ||||
89 | if (@_ % 2 == 0) | ||||
90 | { | ||||
91 | %opts = @_; | ||||
92 | } | ||||
93 | else | ||||
94 | { | ||||
95 | (my($name), %opts) = @_; | ||||
96 | _croak "Cannot provide two names for type" if exists $opts{name}; | ||||
97 | $opts{name} = $name; | ||||
98 | } | ||||
99 | |||||
100 | my $caller = caller($opts{_caller_level} || 0); | ||||
101 | $opts{library} = $caller; | ||||
102 | |||||
103 | if (defined $opts{parent}) | ||||
104 | { | ||||
105 | $opts{parent} = to_TypeTiny($opts{parent}); | ||||
106 | |||||
107 | unless (TypeTiny->check($opts{parent})) | ||||
108 | { | ||||
109 | $caller->isa("Type::Library") | ||||
110 | or _croak("Parent type cannot be a %s", ref($opts{parent})||'non-reference scalar'); | ||||
111 | $opts{parent} = $caller->meta->get_type($opts{parent}) | ||||
112 | or _croak("Could not find parent type"); | ||||
113 | } | ||||
114 | } | ||||
115 | |||||
116 | my $type; | ||||
117 | if (defined $opts{parent}) | ||||
118 | { | ||||
119 | $type = delete($opts{parent})->create_child_type(%opts); | ||||
120 | } | ||||
121 | else | ||||
122 | { | ||||
123 | my $bless = delete($opts{bless}) || "Type::Tiny"; | ||||
124 | eval "require $bless"; | ||||
125 | $type = $bless->new(%opts); | ||||
126 | } | ||||
127 | |||||
128 | if ($caller->isa("Type::Library")) | ||||
129 | { | ||||
130 | $caller->meta->add_type($type) unless $type->is_anon; | ||||
131 | } | ||||
132 | |||||
133 | return $type; | ||||
134 | } | ||||
135 | |||||
136 | 1 | 1µs | *subtype = \&declare; | ||
137 | 1 | 400ns | *type = \&declare; | ||
138 | |||||
139 | sub as (@) | ||||
140 | { | ||||
141 | parent => @_; | ||||
142 | } | ||||
143 | |||||
144 | sub where (&;@) | ||||
145 | { | ||||
146 | constraint => @_; | ||||
147 | } | ||||
148 | |||||
149 | sub message (&;@) | ||||
150 | { | ||||
151 | message => @_; | ||||
152 | } | ||||
153 | |||||
154 | sub inline_as (&;@) | ||||
155 | { | ||||
156 | inlined => @_; | ||||
157 | } | ||||
158 | |||||
159 | sub class_type | ||||
160 | { | ||||
161 | my $name = ref($_[0]) ? undef : shift; | ||||
162 | my %opts = %{ +shift }; | ||||
163 | |||||
164 | if (defined $name) | ||||
165 | { | ||||
166 | $opts{name} = $name unless exists $opts{name}; | ||||
167 | $opts{class} = $name unless exists $opts{class}; | ||||
168 | } | ||||
169 | |||||
170 | $opts{bless} = "Type::Tiny::Class"; | ||||
171 | |||||
172 | 2 | 128µs | 2 | 45µs | # spent 29µs (13+16) within Type::Utils::BEGIN@172 which was called:
# once (13µs+16µs) by Typed::BEGIN@11 at line 172 # spent 29µs making 1 call to Type::Utils::BEGIN@172
# spent 16µs making 1 call to warnings::unimport |
173 | declare(%opts); | ||||
174 | } | ||||
175 | |||||
176 | sub role_type | ||||
177 | { | ||||
178 | my $name = ref($_[0]) ? undef : shift; | ||||
179 | my %opts = %{ +shift }; | ||||
180 | |||||
181 | if (defined $name) | ||||
182 | { | ||||
183 | $opts{name} = $name unless exists $opts{name}; | ||||
184 | $opts{role} = $name unless exists $opts{role}; | ||||
185 | } | ||||
186 | |||||
187 | $opts{bless} = "Type::Tiny::Role"; | ||||
188 | |||||
189 | 2 | 132µs | 2 | 35µs | # spent 23µs (12+12) within Type::Utils::BEGIN@189 which was called:
# once (12µs+12µs) by Typed::BEGIN@11 at line 189 # spent 23µs making 1 call to Type::Utils::BEGIN@189
# spent 12µs making 1 call to warnings::unimport |
190 | declare(%opts); | ||||
191 | } | ||||
192 | |||||
193 | sub duck_type | ||||
194 | { | ||||
195 | my $name = ref($_[0]) ? undef : shift; | ||||
196 | my @methods = @{ +shift }; | ||||
197 | |||||
198 | my %opts; | ||||
199 | $opts{name} = $name if defined $name; | ||||
200 | $opts{methods} = \@methods; | ||||
201 | |||||
202 | $opts{bless} = "Type::Tiny::Duck"; | ||||
203 | |||||
204 | 2 | 120µs | 2 | 34µs | # spent 22µs (11+11) within Type::Utils::BEGIN@204 which was called:
# once (11µs+11µs) by Typed::BEGIN@11 at line 204 # spent 22µs making 1 call to Type::Utils::BEGIN@204
# spent 11µs making 1 call to warnings::unimport |
205 | declare(%opts); | ||||
206 | } | ||||
207 | |||||
208 | sub enum | ||||
209 | { | ||||
210 | my $name = ref($_[0]) ? undef : shift; | ||||
211 | my @values = @{ +shift }; | ||||
212 | |||||
213 | my %opts; | ||||
214 | $opts{name} = $name if defined $name; | ||||
215 | $opts{values} = \@values; | ||||
216 | |||||
217 | $opts{bless} = "Type::Tiny::Enum"; | ||||
218 | |||||
219 | 2 | 129µs | 2 | 42µs | # spent 27µs (12+15) within Type::Utils::BEGIN@219 which was called:
# once (12µs+15µs) by Typed::BEGIN@11 at line 219 # spent 27µs making 1 call to Type::Utils::BEGIN@219
# spent 15µs making 1 call to warnings::unimport |
220 | declare(%opts); | ||||
221 | } | ||||
222 | |||||
223 | sub union | ||||
224 | { | ||||
225 | my $name = ref($_[0]) ? undef : shift; | ||||
226 | my @tcs = @{ +shift }; | ||||
227 | |||||
228 | my %opts; | ||||
229 | $opts{name} = $name if defined $name; | ||||
230 | $opts{type_constraints} = \@tcs; | ||||
231 | |||||
232 | $opts{bless} = "Type::Tiny::Union"; | ||||
233 | |||||
234 | 2 | 124µs | 2 | 32µs | # spent 22µs (11+11) within Type::Utils::BEGIN@234 which was called:
# once (11µs+11µs) by Typed::BEGIN@11 at line 234 # spent 22µs making 1 call to Type::Utils::BEGIN@234
# spent 11µs making 1 call to warnings::unimport |
235 | declare(%opts); | ||||
236 | } | ||||
237 | |||||
238 | sub intersection | ||||
239 | { | ||||
240 | my $name = ref($_[0]) ? undef : shift; | ||||
241 | my @tcs = @{ +shift }; | ||||
242 | |||||
243 | my %opts; | ||||
244 | $opts{name} = $name if defined $name; | ||||
245 | $opts{type_constraints} = \@tcs; | ||||
246 | |||||
247 | $opts{bless} = "Type::Tiny::Intersection"; | ||||
248 | |||||
249 | 2 | 1.69ms | 2 | 33µs | # spent 22µs (11+11) within Type::Utils::BEGIN@249 which was called:
# once (11µs+11µs) by Typed::BEGIN@11 at line 249 # spent 22µs making 1 call to Type::Utils::BEGIN@249
# spent 11µs making 1 call to warnings::unimport |
250 | declare(%opts); | ||||
251 | } | ||||
252 | |||||
253 | sub declare_coercion | ||||
254 | { | ||||
255 | my %opts; | ||||
256 | $opts{name} = shift if !ref($_[0]); | ||||
257 | |||||
258 | while (HashLike->check($_[0]) and not TypeTiny->check($_[0])) | ||||
259 | { | ||||
260 | %opts = (%opts, %{+shift}); | ||||
261 | } | ||||
262 | |||||
263 | my $caller = caller($opts{_caller_level} || 0); | ||||
264 | $opts{library} = $caller; | ||||
265 | |||||
266 | my $bless = delete($opts{bless}) || "Type::Coercion"; | ||||
267 | eval "require $bless"; | ||||
268 | my $c = $bless->new(%opts); | ||||
269 | |||||
270 | my @C; | ||||
271 | |||||
272 | if ($caller->isa("Type::Library")) | ||||
273 | { | ||||
274 | my $meta = $caller->meta; | ||||
275 | $meta->add_coercion($c) unless $c->is_anon; | ||||
276 | while (@_) | ||||
277 | { | ||||
278 | push @C, map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; | ||||
279 | push @C, shift; | ||||
280 | } | ||||
281 | } | ||||
282 | |||||
283 | $c->add_type_coercions(@C); | ||||
284 | |||||
285 | return $c->freeze; | ||||
286 | } | ||||
287 | |||||
288 | sub coerce | ||||
289 | { | ||||
290 | if ((scalar caller)->isa("Type::Library")) | ||||
291 | { | ||||
292 | my $meta = (scalar caller)->meta; | ||||
293 | my ($type) = map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; | ||||
294 | my @opts; | ||||
295 | while (@_) | ||||
296 | { | ||||
297 | push @opts, map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; | ||||
298 | push @opts, shift; | ||||
299 | } | ||||
300 | return $type->coercion->add_type_coercions(@opts); | ||||
301 | } | ||||
302 | |||||
303 | my ($type, @opts) = @_; | ||||
304 | $type = to_TypeTiny($type); | ||||
305 | return $type->coercion->add_type_coercions(@opts); | ||||
306 | } | ||||
307 | |||||
308 | sub from (@) | ||||
309 | { | ||||
310 | return @_; | ||||
311 | } | ||||
312 | |||||
313 | sub to_type (@) | ||||
314 | { | ||||
315 | my $type = shift; | ||||
316 | unless (TypeTiny->check($type)) | ||||
317 | { | ||||
318 | caller->isa("Type::Library") | ||||
319 | or _croak "Target type cannot be a string"; | ||||
320 | $type = caller->meta->get_type($type) | ||||
321 | or _croak "Could not find target type"; | ||||
322 | } | ||||
323 | return +{ type_constraint => $type }, @_; | ||||
324 | } | ||||
325 | |||||
326 | sub via (&;@) | ||||
327 | { | ||||
328 | return @_; | ||||
329 | } | ||||
330 | |||||
331 | sub match_on_type | ||||
332 | { | ||||
333 | my $value = shift; | ||||
334 | |||||
335 | while (@_) | ||||
336 | { | ||||
337 | my ($type, $code); | ||||
338 | if (@_ == 1) | ||||
339 | { | ||||
340 | require Types::Standard; | ||||
341 | ($type, $code) = (Types::Standard::Any(), shift); | ||||
342 | } | ||||
343 | else | ||||
344 | { | ||||
345 | ($type, $code) = splice(@_, 0, 2); | ||||
346 | TypeTiny->($type); | ||||
347 | } | ||||
348 | |||||
349 | $type->check($value) or next; | ||||
350 | |||||
351 | if (StringLike->check($code)) | ||||
352 | { | ||||
353 | local $_ = $value; | ||||
354 | if (wantarray) { | ||||
355 | my @r = eval "$code"; | ||||
356 | die $@ if $@; | ||||
357 | return @r; | ||||
358 | } | ||||
359 | if (defined wantarray) { | ||||
360 | my $r = eval "$code"; | ||||
361 | die $@ if $@; | ||||
362 | return $r; | ||||
363 | } | ||||
364 | eval "$code"; | ||||
365 | die $@ if $@; | ||||
366 | return; | ||||
367 | } | ||||
368 | else | ||||
369 | { | ||||
370 | CodeLike->($code); | ||||
371 | local $_ = $value; | ||||
372 | return $code->($value); | ||||
373 | } | ||||
374 | } | ||||
375 | |||||
376 | _croak("No cases matched for %s", Type::Tiny::_dd($value)); | ||||
377 | } | ||||
378 | |||||
379 | sub compile_match_on_type | ||||
380 | { | ||||
381 | my @code = 'sub { local $_ = $_[0]; '; | ||||
382 | my @checks; | ||||
383 | my @actions; | ||||
384 | |||||
385 | my $els = ''; | ||||
386 | |||||
387 | while (@_) | ||||
388 | { | ||||
389 | my ($type, $code); | ||||
390 | if (@_ == 1) | ||||
391 | { | ||||
392 | require Types::Standard; | ||||
393 | ($type, $code) = (Types::Standard::Any(), shift); | ||||
394 | } | ||||
395 | else | ||||
396 | { | ||||
397 | ($type, $code) = splice(@_, 0, 2); | ||||
398 | TypeTiny->($type); | ||||
399 | } | ||||
400 | |||||
401 | if ($type->can_be_inlined) | ||||
402 | { | ||||
403 | push @code, sprintf('%sif (%s)', $els, $type->inline_check('$_')); | ||||
404 | } | ||||
405 | else | ||||
406 | { | ||||
407 | push @checks, $type; | ||||
408 | push @code, sprintf('%sif ($checks[%d]->check($_))', $els, $#checks); | ||||
409 | } | ||||
410 | |||||
411 | $els = 'els'; | ||||
412 | |||||
413 | if (StringLike->check($code)) | ||||
414 | { | ||||
415 | push @code, sprintf(' { %s }', $code); | ||||
416 | } | ||||
417 | else | ||||
418 | { | ||||
419 | CodeLike->($code); | ||||
420 | push @actions, $code; | ||||
421 | push @code, sprintf(' { $actions[%d]->(@_) }', $#actions); | ||||
422 | } | ||||
423 | } | ||||
424 | |||||
425 | push @code, 'else', ' { Type::Util::_croak("No cases matched for %s", Type::Tiny::_dd($_[0])) }'; | ||||
426 | |||||
427 | push @code, '}'; # /sub | ||||
428 | |||||
429 | require Eval::TypeTiny; | ||||
430 | return Eval::TypeTiny::eval_closure( | ||||
431 | source => \@code, | ||||
432 | environment => { | ||||
433 | '@actions' => \@actions, | ||||
434 | '@checks' => \@checks, | ||||
435 | }, | ||||
436 | ); | ||||
437 | } | ||||
438 | |||||
439 | { | ||||
440 | 1 | 400ns | package #hide | ||
441 | Type::Registry::DWIM; | ||||
442 | |||||
443 | 1 | 6µs | our @ISA = qw(Type::Registry); | ||
444 | |||||
445 | sub simple_lookup | ||||
446 | { | ||||
447 | my $self = shift; | ||||
448 | my $r; | ||||
449 | |||||
450 | # If the lookup is chained to a class, then the class' own | ||||
451 | # type registry gets first refusal. | ||||
452 | # | ||||
453 | if (defined $self->{"~~chained"}) | ||||
454 | { | ||||
455 | my $chained = "Type::Registry"->for_class($self->{"~~chained"}); | ||||
456 | $r = eval { $chained->simple_lookup(@_) } unless $self == $chained; | ||||
457 | return $r if defined $r; | ||||
458 | } | ||||
459 | |||||
460 | # Fall back to types in Types::Standard. | ||||
461 | require Types::Standard; | ||||
462 | return 'Types::Standard'->get_type($_[0]) if 'Types::Standard'->has_type($_[0]); | ||||
463 | |||||
464 | # Only continue any further if we've been called from Type::Parser. | ||||
465 | return unless $_[1]; | ||||
466 | |||||
467 | # If Moose is loaded... | ||||
468 | if ($INC{'Moose.pm'}) | ||||
469 | { | ||||
470 | require Moose::Util::TypeConstraints; | ||||
471 | require Types::TypeTiny; | ||||
472 | $r = Moose::Util::TypeConstraints::find_type_constraint($_[0]); | ||||
473 | return Types::TypeTiny::to_TypeTiny($r) if defined $r; | ||||
474 | } | ||||
475 | |||||
476 | # If Mouse is loaded... | ||||
477 | if ($INC{'Mouse.pm'}) | ||||
478 | { | ||||
479 | require Mouse::Util::TypeConstraints; | ||||
480 | require Types::TypeTiny; | ||||
481 | $r = Mouse::Util::TypeConstraints::find_type_constraint($_[0]); | ||||
482 | return Types::TypeTiny::to_TypeTiny($r) if defined $r; | ||||
483 | } | ||||
484 | |||||
485 | return unless $_[0] =~ /^\s*(\w+(::\w+)*)\s*$/sm; | ||||
486 | return unless defined $self->{"~~assume"}; | ||||
487 | |||||
488 | # Lastly, if it looks like a class/role name, assume it's | ||||
489 | # supposed to be a class/role type. | ||||
490 | # | ||||
491 | |||||
492 | if ($self->{"~~assume"} eq "Type::Tiny::Class") | ||||
493 | { | ||||
494 | require Type::Tiny::Class; | ||||
495 | return "Type::Tiny::Class"->new(class => $_[0]); | ||||
496 | } | ||||
497 | |||||
498 | if ($self->{"~~assume"} eq "Type::Tiny::Role") | ||||
499 | { | ||||
500 | require Type::Tiny::Role; | ||||
501 | return "Type::Tiny::Role"->new(role => $_[0]); | ||||
502 | } | ||||
503 | |||||
504 | die; | ||||
505 | } | ||||
506 | } | ||||
507 | |||||
508 | 1 | 100ns | our $dwimmer; | ||
509 | sub dwim_type | ||||
510 | { | ||||
511 | my ($string, %opts) = @_; | ||||
512 | $opts{for} = caller unless defined $opts{for}; | ||||
513 | |||||
514 | $dwimmer ||= do { | ||||
515 | require Type::Registry; | ||||
516 | 'Type::Registry::DWIM'->new; | ||||
517 | }; | ||||
518 | |||||
519 | local $dwimmer->{'~~chained'} = $opts{for}; | ||||
520 | local $dwimmer->{'~~assume'} = $opts{does} ? 'Type::Tiny::Role' : 'Type::Tiny::Class'; | ||||
521 | |||||
522 | $dwimmer->lookup($string); | ||||
523 | } | ||||
524 | |||||
525 | sub english_list | ||||
526 | { | ||||
527 | my $conjunction = ref($_[0]) eq 'SCALAR' ? ${+shift} : 'and'; | ||||
528 | my @items = sort @_; | ||||
529 | |||||
530 | return $items[0] if @items == 1; | ||||
531 | return "$items[0] $conjunction $items[1]" if @items == 2; | ||||
532 | |||||
533 | my $tail = pop @items; | ||||
534 | join(', ', @items, "$conjunction $tail"); | ||||
535 | } | ||||
536 | |||||
537 | 1 | 11µs | 1; | ||
538 | |||||
539 | __END__ |