← Index
NYTProf Performance Profile   « line view »
For fastest.pl
  Run on Fri Jan 31 20:48:16 2014
Reported on Fri Jan 31 20:49:41 2014

Filename/opt/perl-5.18.1/lib/site_perl/5.18.1/Types/TypeTiny.pm
StatementsExecuted 51 statements in 2.85ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
31123µs65µsTypes::TypeTiny::::TypeTinyTypes::TypeTiny::TypeTiny
31122µs61µsTypes::TypeTiny::::StringLikeTypes::TypeTiny::StringLike
11119µs230µsTypes::TypeTiny::::importTypes::TypeTiny::import
11117µs29µsTypes::TypeTiny::::BEGIN@222Types::TypeTiny::BEGIN@222
31116µs22µsTypes::TypeTiny::::to_TypeTinyTypes::TypeTiny::to_TypeTiny
11115µs32µsTypes::TypeTiny::::BEGIN@3Types::TypeTiny::BEGIN@3
11112µs24µsTypes::TypeTiny::::BEGIN@18Types::TypeTiny::BEGIN@18
11111µs22µsTypes::TypeTiny::::BEGIN@229Types::TypeTiny::BEGIN@229
1119µs54µsTypes::TypeTiny::::BEGIN@9Types::TypeTiny::BEGIN@9
1119µs14µsTypes::TypeTiny::::BEGIN@4Types::TypeTiny::BEGIN@4
3116µs6µsTypes::TypeTiny::::CORE:matchTypes::TypeTiny::CORE:match (opcode)
1114µs4µsTypes::TypeTiny::::__ANON__[:118]Types::TypeTiny::__ANON__[:118]
1114µs4µsTypes::TypeTiny::::__ANON__[:74]Types::TypeTiny::__ANON__[:74]
1113µs3µsTypes::TypeTiny::::type_namesTypes::TypeTiny::type_names
0000s0sTypes::TypeTiny::::ArrayLikeTypes::TypeTiny::ArrayLike
0000s0sTypes::TypeTiny::::CodeLikeTypes::TypeTiny::CodeLike
0000s0sTypes::TypeTiny::::HashLikeTypes::TypeTiny::HashLike
0000s0sTypes::TypeTiny::::_TypeTinyFromCodeRefTypes::TypeTiny::_TypeTinyFromCodeRef
0000s0sTypes::TypeTiny::::_TypeTinyFromGenericTypes::TypeTiny::_TypeTinyFromGeneric
0000s0sTypes::TypeTiny::::_TypeTinyFromMooseTypes::TypeTiny::_TypeTinyFromMoose
0000s0sTypes::TypeTiny::::_TypeTinyFromValidationClassTypes::TypeTiny::_TypeTinyFromValidationClass
0000s0sTypes::TypeTiny::::__ANON__[:106]Types::TypeTiny::__ANON__[:106]
0000s0sTypes::TypeTiny::::__ANON__[:107]Types::TypeTiny::__ANON__[:107]
0000s0sTypes::TypeTiny::::__ANON__[:117]Types::TypeTiny::__ANON__[:117]
0000s0sTypes::TypeTiny::::__ANON__[:169]Types::TypeTiny::__ANON__[:169]
0000s0sTypes::TypeTiny::::__ANON__[:170]Types::TypeTiny::__ANON__[:170]
0000s0sTypes::TypeTiny::::__ANON__[:207]Types::TypeTiny::__ANON__[:207]
0000s0sTypes::TypeTiny::::__ANON__[:215]Types::TypeTiny::__ANON__[:215]
0000s0sTypes::TypeTiny::::__ANON__[:223]Types::TypeTiny::__ANON__[:223]
0000s0sTypes::TypeTiny::::__ANON__[:225]Types::TypeTiny::__ANON__[:225]
0000s0sTypes::TypeTiny::::__ANON__[:230]Types::TypeTiny::__ANON__[:230]
0000s0sTypes::TypeTiny::::__ANON__[:232]Types::TypeTiny::__ANON__[:232]
0000s0sTypes::TypeTiny::::__ANON__[:247]Types::TypeTiny::__ANON__[:247]
0000s0sTypes::TypeTiny::::__ANON__[:262]Types::TypeTiny::__ANON__[:262]
0000s0sTypes::TypeTiny::::__ANON__[:263]Types::TypeTiny::__ANON__[:263]
0000s0sTypes::TypeTiny::::__ANON__[:268]Types::TypeTiny::__ANON__[:268]
0000s0sTypes::TypeTiny::::__ANON__[:285]Types::TypeTiny::__ANON__[:285]
0000s0sTypes::TypeTiny::::__ANON__[:290]Types::TypeTiny::__ANON__[:290]
0000s0sTypes::TypeTiny::::__ANON__[:73]Types::TypeTiny::__ANON__[:73]
0000s0sTypes::TypeTiny::::__ANON__[:84]Types::TypeTiny::__ANON__[:84]
0000s0sTypes::TypeTiny::::__ANON__[:85]Types::TypeTiny::__ANON__[:85]
0000s0sTypes::TypeTiny::::__ANON__[:95]Types::TypeTiny::__ANON__[:95]
0000s0sTypes::TypeTiny::::__ANON__[:96]Types::TypeTiny::__ANON__[:96]
0000s0sTypes::TypeTiny::::coercion_namesTypes::TypeTiny::coercion_names
0000s0sTypes::TypeTiny::::get_coercionTypes::TypeTiny::get_coercion
0000s0sTypes::TypeTiny::::get_typeTypes::TypeTiny::get_type
0000s0sTypes::TypeTiny::::has_coercionTypes::TypeTiny::has_coercion
0000s0sTypes::TypeTiny::::has_typeTypes::TypeTiny::has_type
0000s0sTypes::TypeTiny::::metaTypes::TypeTiny::meta
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Types::TypeTiny;
2
3232µs248µs
# spent 32µs (15+16) within Types::TypeTiny::BEGIN@3 which was called: # once (15µs+16µs) by Type::Tiny::BEGIN@18 at line 3
use strict;
# spent 32µs making 1 call to Types::TypeTiny::BEGIN@3 # spent 16µs making 1 call to strict::import
4260µs218µs
# spent 14µs (9+5) within Types::TypeTiny::BEGIN@4 which was called: # once (9µs+5µs) by Type::Tiny::BEGIN@18 at line 4
use warnings;
# spent 14µs making 1 call to Types::TypeTiny::BEGIN@4 # spent 4µs making 1 call to warnings::import
5
61800nsour $AUTHORITY = 'cpan:TOBYINK';
71200nsour $VERSION = '0.038';
8
9271µs299µs
# spent 54µs (9+45) within Types::TypeTiny::BEGIN@9 which was called: # once (9µs+45µs) by Type::Tiny::BEGIN@18 at line 9
use Scalar::Util qw< blessed refaddr weaken >;
# spent 54µs making 1 call to Types::TypeTiny::BEGIN@9 # spent 45µs making 1 call to Exporter::import
10
1115µs13µsour @EXPORT_OK = ( __PACKAGE__->type_names, qw/to_TypeTiny/ );
# spent 3µs making 1 call to Types::TypeTiny::type_names
12
131200nsmy %cache;
14
15sub import
16
# spent 230µs (19+211) within Types::TypeTiny::import which was called: # once (19µs+211µs) by Type::Library::BEGIN@15 at line 15 of Type/Library.pm
{
17 # do the shuffle!
1821.75ms235µs
# spent 24µs (12+11) within Types::TypeTiny::BEGIN@18 which was called: # once (12µs+11µs) by Type::Tiny::BEGIN@18 at line 18
no warnings "redefine";
# spent 24µs making 1 call to Types::TypeTiny::BEGIN@18 # spent 11µs making 1 call to warnings::unimport
1917µs our @ISA = qw( Exporter::Tiny );
201300ns require Exporter::Tiny;
211900ns my $next = \&Exporter::Tiny::import;
2211µs *import = $next;
231500ns my $class = shift;
241800ns my $opts = { ref($_[0]) ? %{+shift} : () };
2511µs $opts->{into} ||= scalar(caller);
26115µs1211µs return $class->$next($opts, @_);
# spent 211µs making 1 call to Exporter::Tiny::import
27}
28
29sub meta
30{
31 return $_[0];
32}
33
34sub has_type
35{
36 defined(shift->get_coercion(@_))
37}
38
39sub get_type
40{
41 my $self = shift;
42 my $func = $self->can(@_) or return;
43 my $type = $func->();
44 return $type if blessed($type) && $type->isa("Type::Tiny");
45 return;
46}
47
48sub type_names
49
# spent 3µs within Types::TypeTiny::type_names which was called: # once (3µs+0s) by Type::Tiny::BEGIN@18 at line 11
{
5018µs qw( CodeLike StringLike TypeTiny HashLike ArrayLike );
51}
52
53sub has_coercion
54{
55 defined(shift->get_coercion(@_))
56}
57
58sub get_coercion
59{
60 ();
61}
62
63sub coercion_names
64{
65 ();
66}
67
68sub StringLike ()
69
# spent 61µs (22+40) within Types::TypeTiny::StringLike which was called 3 times, avg 20µs/call: # 3 times (22µs+40µs) by Type::Coercion::add_type_coercions at line 215 of Type/Coercion.pm, avg 20µs/call
{
7031µs require Type::Tiny;
71 $cache{StringLike} ||= "Type::Tiny"->new(
72 name => "StringLike",
73 constraint => sub { !ref($_ ) or Scalar::Util::blessed($_ ) && overload::Method($_ , q[""]) },
7417µs
# spent 4µs within Types::TypeTiny::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Types/TypeTiny.pm:74] which was called: # once (4µs+0s) by Type::Tiny::inline_check at line 605 of Type/Tiny.pm
inlined => sub { qq/!ref($_[1]) or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[""])/ },
75317µs340µs library => __PACKAGE__,
# spent 38µs making 1 call to Type::Tiny::new # spent 2µs making 2 calls to Type::Tiny::__ANON__[Type/Tiny.pm:32], avg 800ns/call
76 );
77}
78
79sub HashLike ()
80{
81 require Type::Tiny;
82 $cache{HashLike} ||= "Type::Tiny"->new(
83 name => "HashLike",
84 constraint => sub { ref($_ ) eq q[HASH] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[%{}]) },
85 inlined => sub { qq/ref($_[1]) eq q[HASH] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\%{}])/ },
86 library => __PACKAGE__,
87 );
88}
89
90sub ArrayLike ()
91{
92 require Type::Tiny;
93 $cache{ArrayLike} ||= "Type::Tiny"->new(
94 name => "ArrayLike",
95 constraint => sub { ref($_ ) eq q[ARRAY] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[@{}]) },
96 inlined => sub { qq/ref($_[1]) eq q[ARRAY] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\@{}])/ },
97 library => __PACKAGE__,
98 );
99}
100
101sub CodeLike ()
102{
103 require Type::Tiny;
104 $cache{CodeLike} ||= "Type::Tiny"->new(
105 name => "CodeLike",
106 constraint => sub { ref($_ ) eq q[CODE] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[&{}]) },
107 inlined => sub { qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\&{}])/ },
108 library => __PACKAGE__,
109 );
110}
111
112sub TypeTiny ()
113
# spent 65µs (23+42) within Types::TypeTiny::TypeTiny which was called 3 times, avg 22µs/call: # 3 times (23µs+42µs) by Type::Coercion::add_type_coercions at line 213 of Type/Coercion.pm, avg 22µs/call
{
11432µs require Type::Tiny;
115 $cache{TypeTiny} ||= "Type::Tiny"->new(
116 name => "TypeTiny",
117 constraint => sub { Scalar::Util::blessed($_ ) && $_ ->isa(q[Type::Tiny]) },
11826µs
# spent 4µs within Types::TypeTiny::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Types/TypeTiny.pm:118] which was called: # once (4µs+0s) by Type::Tiny::inline_check at line 605 of Type/Tiny.pm
inlined => sub { my $var = $_[1]; "Scalar::Util::blessed($var) && $var\->isa(q[Type::Tiny])" },
119319µs342µs library => __PACKAGE__,
# spent 40µs making 1 call to Type::Tiny::new # spent 2µs making 2 calls to Type::Tiny::__ANON__[Type/Tiny.pm:32], avg 1µs/call
120 );
121}
122
12310smy %ttt_cache;
124
125sub to_TypeTiny
126
# spent 22µs (16+6) within Types::TypeTiny::to_TypeTiny which was called 3 times, avg 7µs/call: # 3 times (16µs+6µs) by Type::Coercion::add_type_coercions at line 210 of Type/Coercion.pm, avg 7µs/call
{
1273800ns my $t = $_[0];
128
12931µs return $t unless ref $t;
130322µs36µs return $t if ref($t) =~ /^Type::Tiny\b/;
# spent 6µs making 3 calls to Types::TypeTiny::CORE:match, avg 2µs/call
131
132 return $ttt_cache{ refaddr($t) } if $ttt_cache{ refaddr($t) };
133
134 if (my $class = blessed $t)
135 {
136 return $t if $class->isa("Type::Tiny");
137 goto \&_TypeTinyFromMoose if $class->isa("Moose::Meta::TypeConstraint");
138 goto \&_TypeTinyFromMoose if $class->isa("MooseX::Types::TypeDecorator");
139 goto \&_TypeTinyFromValidationClass if $class->isa("Validation::Class::Simple");
140 goto \&_TypeTinyFromValidationClass if $class->isa("Validation::Class");
141 goto \&_TypeTinyFromGeneric if $t->can("check") && $t->can("get_message"); # i.e. Type::API::Constraint
142 }
143
144 goto \&_TypeTinyFromCodeRef if ref($t) eq q(CODE);
145
146 $t;
147}
148
149sub _TypeTinyFromMoose
150{
151 my $t = $_[0];
152
153 if (ref $t->{"Types::TypeTiny::to_TypeTiny"})
154 {
155 return $t->{"Types::TypeTiny::to_TypeTiny"};
156 }
157
158 if ($t->name ne '__ANON__')
159 {
160 require Types::Standard;
161 my $ts = 'Types::Standard'->get_type($t->name);
162 return $ts if $ts->{_is_core};
163 }
164
165 my %opts;
166 $opts{display_name} = $t->name;
167 $opts{constraint} = $t->constraint;
168 $opts{parent} = to_TypeTiny($t->parent) if $t->has_parent;
169 $opts{inlined} = sub { shift; $t->_inline_check(@_) } if $t->can_be_inlined;
170 $opts{message} = sub { $t->get_message($_) } if $t->has_message;
171 $opts{moose_type} = $t;
172
173 require Type::Tiny;
174 my $new = 'Type::Tiny'->new(%opts);
175 $ttt_cache{ refaddr($t) } = $new;
176 weaken($ttt_cache{ refaddr($t) });
177
178 $new->{coercion} = do {
179 require Type::Coercion::FromMoose;
180 'Type::Coercion::FromMoose'->new(type_constraint => $new);
181 } if $t->has_coercion;
182
183 return $new;
184}
185
186sub _TypeTinyFromValidationClass
187{
188 my $t = $_[0];
189
190 require Type::Tiny;
191 require Types::Standard;
192
193 my %opts = (
194 parent => Types::Standard::HashRef(),
195 _validation_class => $t,
196 );
197
198 if ($t->VERSION >= "7.900048")
199 {
200 $opts{constraint} = sub {
201 $t->params->clear;
202 $t->params->add(%$_);
203 my $f = $t->filtering; $t->filtering('off');
204 my $r = eval { $t->validate };
205 $t->filtering($f || 'pre');
206 return $r;
207 };
208 $opts{message} = sub {
209 $t->params->clear;
210 $t->params->add(%$_);
211 my $f = $t->filtering; $t->filtering('off');
212 my $r = (eval { $t->validate } ? "OK" : $t->errors_to_string);
213 $t->filtering($f || 'pre');
214 return $r;
215 };
216 }
217 else # need to use hackish method
218 {
219 $opts{constraint} = sub {
220 $t->params->clear;
221 $t->params->add(%$_);
2222129µs241µs
# spent 29µs (17+12) within Types::TypeTiny::BEGIN@222 which was called: # once (17µs+12µs) by Type::Tiny::BEGIN@18 at line 222
no warnings "redefine";
# spent 29µs making 1 call to Types::TypeTiny::BEGIN@222 # spent 12µs making 1 call to warnings::unimport
223 local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] };
224 eval { $t->validate };
225 };
226 $opts{message} = sub {
227 $t->params->clear;
228 $t->params->add(%$_);
2292694µs232µs
# spent 22µs (11+11) within Types::TypeTiny::BEGIN@229 which was called: # once (11µs+11µs) by Type::Tiny::BEGIN@18 at line 229
no warnings "redefine";
# spent 22µs making 1 call to Types::TypeTiny::BEGIN@229 # spent 11µs making 1 call to warnings::unimport
230 local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] };
231 eval { $t->validate } ? "OK" : $t->errors_to_string;
232 };
233 }
234
235 require Type::Tiny;
236 my $new = "Type::Tiny"->new(%opts);
237
238 $new->coercion->add_type_coercions(
239 Types::Standard::HashRef() => sub {
240 my %params = %$_;
241 for my $k (keys %params)
242 { delete $params{$_} unless $t->get_fields($k) };
243 $t->params->clear;
244 $t->params->add(%params);
245 eval { $t->validate };
246 $t->get_hash;
247 },
248 );
249
250 $ttt_cache{ refaddr($t) } = $new;
251 weaken($ttt_cache{ refaddr($t) });
252 return $new;
253}
254
255sub _TypeTinyFromGeneric
256{
257 my $t = $_[0];
258
259 # XXX - handle inlining??
260
261 my %opts = (
262 constraint => sub { $t->check(@_ ? @_ : $_) },
263 message => sub { $t->get_message(@_ ? @_ : $_) },
264 );
265
266 $opts{display_name} = $t->name if $t->can("name");
267
268 $opts{coercion} = sub { $t->coerce(@_ ? @_ : $_) }
269 if $t->can("has_coercion") && $t->has_coercion && $t->can("coerce");
270
271 require Type::Tiny;
272 my $new = "Type::Tiny"->new(%opts);
273 $ttt_cache{ refaddr($t) } = $new;
274 weaken($ttt_cache{ refaddr($t) });
275 return $new;
276}
277
278sub _TypeTinyFromCodeRef
279{
280 my $t = $_[0];
281
282 my %opts = (
283 constraint => sub {
284 return !!eval { $t->($_) };
285 },
286 message => sub {
287 local $@;
288 eval { $t->($_); 1 } or do { chomp $@; return $@ if $@ };
289 return sprintf('%s did not pass type constraint', Type::Tiny::_dd($_));
290 },
291 );
292
293 require Type::Tiny;
294 my $new = "Type::Tiny"->new(%opts);
295 $ttt_cache{ refaddr($t) } = $new;
296 weaken($ttt_cache{ refaddr($t) });
297 return $new;
298}
299
30016µs1;
301
302__END__
 
# spent 6µs within Types::TypeTiny::CORE:match which was called 3 times, avg 2µs/call: # 3 times (6µs+0s) by Types::TypeTiny::to_TypeTiny at line 130, avg 2µs/call
sub Types::TypeTiny::CORE:match; # opcode