← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:27 2014

Filename/usr/share/perl/5.14/overload.pm
StatementsExecuted 844 statements in 2.71ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
12111.42ms1.43msoverload::::OVERLOADoverload::OVERLOAD
2732449µs576µsoverload::::constantoverload::constant
4821139µs139µsoverload::::CORE:matchoverload::CORE:match (opcode)
121212128µs1.56msoverload::::importoverload::import
11134µs201µsoverload::::BEGIN@147overload::BEGIN@147
22129µs34µsoverload::::AddrRefoverload::AddrRef
0000s0soverload::::Methodoverload::Method
0000s0soverload::::Overloadedoverload::Overloaded
0000s0soverload::::OverloadedStringifyoverload::OverloadedStringify
0000s0soverload::::mycanoverload::mycan
0000s0soverload::::niloverload::nil
0000s0soverload::::ov_methodoverload::ov_method
0000s0soverload::::remove_constantoverload::remove_constant
0000s0soverload::::unimportoverload::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package overload;
2
311µsour $VERSION = '1.13';
4
5sub nil {}
6
7
# spent 1.43ms (1.42+12µs) within overload::OVERLOAD which was called 12 times, avg 119µs/call: # 12 times (1.42ms+12µs) by overload::import at line 34, avg 119µs/call
sub OVERLOAD {
8124µs $package = shift;
912682µs my %arg = @_;
10124µs my ($sub, $fb);
112477µs $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
122429µs $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
132432µs *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
141244µs for (keys %arg) {
157772µs if ($_ eq 'fallback') {
1684µs $fb = $arg{$_};
17 } else {
186935µs $sub = $arg{$_};
196984µs1212µs if (not ref $sub and $sub !~ /::/) {
# spent 12µs making 12 calls to overload::CORE:match, avg 1µs/call
202468µs $ {$package . "::(" . $_} = $sub;
211211µs $sub = \&nil;
22 }
23 #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
24207228µs *{$package . "::(" . $_} = \&{ $sub };
25 }
26 }
272482µs ${$package . "::()"} = $fb; # Make it findable too (fallback only).
28}
29
30
# spent 1.56ms (128µs+1.43) within overload::import which was called 12 times, avg 130µs/call: # once (21µs+925µs) by Math::BigInt::BEGIN@44 at line 153 of Math/BigInt.pm # once (13µs+161µs) by DateTime::BEGIN@58 at line 59 of DateTime.pm # once (17µs+136µs) by DateTime::Duration::BEGIN@14 at line 15 of DateTime/Duration.pm # once (15µs+31µs) by bigint::BEGIN@11 at line 11 of bigint.pm # once (8µs+27µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 17 of Moose/Meta/TypeConstraint.pm # once (10µs+22µs) by JSON::XS::Boolean::BEGIN@1478 at line 1481 of JSON/XS.pm # once (8µs+24µs) by Moose::Meta::Role::Method::Required::BEGIN@14 at line 15 of Moose/Meta/Role/Method/Required.pm # once (7µs+23µs) by boolean::BEGIN@10 at line 12 of boolean.pm # once (9µs+20µs) by JSON::PP::Boolean::BEGIN@3 at line 14 of (eval 50)[JSON.pm:353] # once (7µs+22µs) by JSON::XS::Boolean::BEGIN@3 at line 14 of (eval 49)[JSON.pm:353] # once (7µs+21µs) by MongoDB::OID::BEGIN@72 at line 72 of MongoDB/OID.pm # once (6µs+19µs) by Class::MOP::Method::BEGIN@21 at line 21 of Class/MOP/Method.pm
sub import {
311226µs $package = (caller())[0];
32 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
33123µs shift;
341298µs121.43ms $package->overload::OVERLOAD(@_);
# spent 1.43ms making 12 calls to overload::OVERLOAD, avg 119µs/call
35}
36
37sub unimport {
38 $package = (caller())[0];
39 ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
40 shift;
41 for (@_) {
42 if ($_ eq 'fallback') {
43 undef $ {$package . "::()"};
44 } else {
45 delete $ {$package . "::"}{"(" . $_};
46 }
47 }
48}
49
50sub Overloaded {
51 my $package = shift;
52 $package = ref $package if ref $package;
53 $package->can('()');
54}
55
56sub ov_method {
57 my $globref = shift;
58 return undef unless $globref;
59 my $sub = \&{*$globref};
60 require Scalar::Util;
61 return $sub
62 if Scalar::Util::refaddr($sub) != Scalar::Util::refaddr(\&nil);
63 return shift->can($ {*$globref});
64}
65
66sub OverloadedStringify {
67 my $package = shift;
68 $package = ref $package if ref $package;
69 #$package->can('(""')
70 ov_method mycan($package, '(""'), $package
71 or ov_method mycan($package, '(0+'), $package
72 or ov_method mycan($package, '(bool'), $package
73 or ov_method mycan($package, '(nomethod'), $package;
74}
75
76sub Method {
77 my $package = shift;
78 if(ref $package) {
79 local $@;
80 local $!;
81 require Scalar::Util;
82 $package = Scalar::Util::blessed($package);
83 return undef if !defined $package;
84 }
85 #my $meth = $package->can('(' . shift);
86 ov_method mycan($package, '(' . shift), $package;
87 #return $meth if $meth ne \&nil;
88 #return $ {*{$meth}};
89}
90
91
# spent 34µs (29+5) within overload::AddrRef which was called 2 times, avg 17µs/call: # once (20µs+4µs) by boolean::BEGIN@31 at line 44 of boolean.pm # once (9µs+2µs) by boolean::BEGIN@31 at line 45 of boolean.pm
sub AddrRef {
9221µs my $package = ref $_[0];
932400ns return "$_[0]" unless $package;
94
952400ns local $@;
9622µs local $!;
9721µs require Scalar::Util;
9826µs22µs my $class = Scalar::Util::blessed($_[0]);
# spent 2µs making 2 calls to Scalar::Util::blessed, avg 750ns/call
9922µs my $class_prefix = defined($class) ? "$class=" : "";
10025µs22µs my $type = Scalar::Util::reftype($_[0]);
# spent 2µs making 2 calls to Scalar::Util::reftype, avg 750ns/call
10127µs22µs my $addr = Scalar::Util::refaddr($_[0]);
# spent 2µs making 2 calls to Scalar::Util::refaddr, avg 1µs/call
102210µs return sprintf("%s%s(0x%x)", $class_prefix, $type, $addr);
103}
104
10513µs*StrVal = *AddrRef;
106
107sub mycan { # Real can would leave stubs.
108 my ($package, $meth) = @_;
109
110 local $@;
111 local $!;
112 require mro;
113
114 my $mro = mro::get_linear_isa($package);
115 foreach my $p (@$mro) {
116 my $fqmeth = $p . q{::} . $meth;
117 return \*{$fqmeth} if defined &{$fqmeth};
118 }
119
120 return undef;
121}
122
12315µs%constants = (
124 'integer' => 0x1000, # HINT_NEW_INTEGER
125 'float' => 0x2000, # HINT_NEW_FLOAT
126 'binary' => 0x4000, # HINT_NEW_BINARY
127 'q' => 0x8000, # HINT_NEW_STRING
128 'qr' => 0x10000, # HINT_NEW_RE
129 );
130
131112µs%ops = ( with_assign => "+ - * / % ** << >> x .",
132 assign => "+= -= *= /= %= **= <<= >>= x= .=",
133 num_comparison => "< <= > >= == !=",
134 '3way_comparison'=> "<=> cmp",
135 str_comparison => "lt le gt ge eq ne",
136 binary => '& &= | |= ^ ^=',
137 unary => "neg ! ~",
138 mutators => '++ --',
139 func => "atan2 cos sin exp abs log sqrt int",
140 conversion => 'bool "" 0+ qr',
141 iterators => '<>',
142 filetest => "-X",
143 dereferencing => '${} @{} %{} &{} *{}',
144 matching => '~~',
145 special => 'nomethod fallback =');
146
1472445µs2369µs
# spent 201µs (34+167) within overload::BEGIN@147 which was called: # once (34µs+167µs) by Value::Convertor::BEGIN@55 at line 147
use warnings::register;
# spent 201µs making 1 call to overload::BEGIN@147 # spent 167µs making 1 call to warnings::register::import
148
# spent 576µs (449+127) within overload::constant which was called 27 times, avg 21µs/call: # 9 times (235µs+74µs) by Math::BigInt::import at line 2703 of Math/BigInt.pm, avg 34µs/call # 9 times (121µs+36µs) by bigint::import at line 262 of bigint.pm, avg 17µs/call # 9 times (94µs+18µs) by bigint::import at line 264 of bigint.pm, avg 12µs/call
sub constant {
149 # Arguments: what, sub
1502786µs while (@_) {
15136304µs36127µs if (@_ == 1) {
# spent 127µs making 36 calls to overload::CORE:match, avg 4µs/call
152 warnings::warnif ("Odd number of arguments for overload::constant");
153 last;
154 }
155 elsif (!exists $constants {$_ [0]}) {
156 warnings::warnif ("`$_[0]' is not an overloadable type");
157 }
158 elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
159 # Can't use C<ref $_[1] eq "CODE"> above as code references can be
160 # blessed, and C<ref> would return the package the ref is blessed into.
161 if (warnings::enabled) {
162 $_ [1] = "undef" unless defined $_ [1];
163 warnings::warn ("`$_[1]' is not a code reference");
164 }
165 }
166 else {
16736124µs $^H{$_[0]} = $_[1];
1683659µs $^H |= $constants{$_[0]};
169 }
1703632µs shift, shift;
171 }
172}
173
174sub remove_constant {
175 # Arguments: what, sub
176 while (@_) {
177 delete $^H{$_[0]};
178 $^H &= ~ $constants{$_[0]};
179 shift, shift;
180 }
181}
182
183115µs1;
184
185__END__
 
# spent 139µs within overload::CORE:match which was called 48 times, avg 3µs/call: # 36 times (127µs+0s) by overload::constant at line 151, avg 4µs/call # 12 times (12µs+0s) by overload::OVERLOAD at line 19, avg 1µs/call
sub overload::CORE:match; # opcode